diff options
| author |  Samuel Mimram <smimram@debian.org> | 2006-11-21 21:38:49 +0000 |
|---|---|---|
| committer | Samuel Mimram <smimram@debian.org> | 2006-11-21 21:38:49 +0000 |
| commit | 208a0f7bfa5249f9795e6e225f309cbe715c0fad (patch) | |
| tree | 591e9e512063e34099782e2518573f15ffeac003 /theories | |
| parent | de0085539583f59dc7c4bf4e272e18711d565466 (diff) | |
Imported Upstream version 8.1~gammaupstream/8.1.gamma
Diffstat (limited to 'theories')
160 files changed, 38700 insertions, 37561 deletions
diff --git a/theories/Arith/Arith.v b/theories/Arith/Arith.v index 59d9b2b1..be065f1d 100644 --- a/theories/Arith/Arith.v +++ b/theories/Arith/Arith.v @@ -6,15 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Arith.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Arith.v 9302 2006-10-27 21:21:17Z barras $ i*) -Require Export Le. -Require Export Lt. -Require Export Plus. -Require Export Gt. -Require Export Minus. -Require Export Mult. -Require Export Between. -Require Export Peano_dec. -Require Export Compare_dec. -Require Export Factorial. +Require Export Arith_base. +Require Export ArithRing. diff --git a/theories/Arith/Arith_base.v b/theories/Arith/Arith_base.v new file mode 100644 index 00000000..b076de2a --- /dev/null +++ b/theories/Arith/Arith_base.v @@ -0,0 +1,20 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id$ i*) + +Require Export Le. +Require Export Lt. +Require Export Plus. +Require Export Gt. +Require Export Minus. +Require Export Mult. +Require Export Between. +Require Export Peano_dec. +Require Export Compare_dec. +Require Export Factorial. diff --git a/theories/Arith/Between.v b/theories/Arith/Between.v index 7680997d..2e9472c4 100644 --- a/theories/Arith/Between.v +++ b/theories/Arith/Between.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Between.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Between.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Le. Require Import Lt. @@ -16,174 +16,174 @@ Open Local Scope nat_scope. Implicit Types k l p q r : nat. Section Between. -Variables P Q : nat -> Prop. - -Inductive between k : nat -> Prop := - | bet_emp : between k k - | bet_S : forall l, between k l -> P l -> between k (S l). - -Hint Constructors between: arith v62. - -Lemma bet_eq : forall k l, l = k -> between k l. -Proof. -induction 1; auto with arith. -Qed. - -Hint Resolve bet_eq: arith v62. - -Lemma between_le : forall k l, between k l -> k <= l. -Proof. -induction 1; auto with arith. -Qed. -Hint Immediate between_le: arith v62. - -Lemma between_Sk_l : forall k l, between k l -> S k <= l -> between (S k) l. -Proof. -induction 1. -intros; absurd (S k <= k); auto with arith. -destruct H; auto with arith. -Qed. -Hint Resolve between_Sk_l: arith v62. - -Lemma between_restr : - forall k l (m:nat), k <= l -> l <= m -> between k m -> between l m. -Proof. -induction 1; auto with arith. -Qed. - -Inductive exists_between k : nat -> Prop := - | exists_S : forall l, exists_between k l -> exists_between k (S l) - | exists_le : forall l, k <= l -> Q l -> exists_between k (S l). - -Hint Constructors exists_between: arith v62. - -Lemma exists_le_S : forall k l, exists_between k l -> S k <= l. -Proof. -induction 1; auto with arith. -Qed. - -Lemma exists_lt : forall k l, exists_between k l -> k < l. -Proof exists_le_S. -Hint Immediate exists_le_S exists_lt: arith v62. - -Lemma exists_S_le : forall k l, exists_between k (S l) -> k <= l. -Proof. -intros; apply le_S_n; auto with arith. -Qed. -Hint Immediate exists_S_le: arith v62. - -Definition in_int p q r := p <= r /\ r < q. - -Lemma in_int_intro : forall p q r, p <= r -> r < q -> in_int p q r. -Proof. -red in |- *; auto with arith. -Qed. -Hint Resolve in_int_intro: arith v62. - -Lemma in_int_lt : forall p q r, in_int p q r -> p < q. -Proof. -induction 1; intros. -apply le_lt_trans with r; auto with arith. -Qed. - -Lemma in_int_p_Sq : - forall p q r, in_int p (S q) r -> in_int p q r \/ r = q :>nat. -Proof. -induction 1; intros. -elim (le_lt_or_eq r q); auto with arith. -Qed. - -Lemma in_int_S : forall p q r, in_int p q r -> in_int p (S q) r. -Proof. -induction 1; auto with arith. -Qed. -Hint Resolve in_int_S: arith v62. - -Lemma in_int_Sp_q : forall p q r, in_int (S p) q r -> in_int p q r. -Proof. -induction 1; auto with arith. -Qed. -Hint Immediate in_int_Sp_q: arith v62. - -Lemma between_in_int : - forall k l, between k l -> forall r, in_int k l r -> P r. -Proof. -induction 1; intros. -absurd (k < k); auto with arith. -apply in_int_lt with r; auto with arith. -elim (in_int_p_Sq k l r); intros; auto with arith. -rewrite H2; trivial with arith. -Qed. - -Lemma in_int_between : - forall k l, k <= l -> (forall r, in_int k l r -> P r) -> between k l. -Proof. -induction 1; auto with arith. -Qed. - -Lemma exists_in_int : - forall k l, exists_between k l -> exists2 m : nat, in_int k l m & Q m. -Proof. -induction 1. -case IHexists_between; intros p inp Qp; exists p; auto with arith. -exists l; auto with arith. -Qed. - -Lemma in_int_exists : forall k l r, in_int k l r -> Q r -> exists_between k l. -Proof. -destruct 1; intros. -elim H0; auto with arith. -Qed. - -Lemma between_or_exists : - forall k l, - k <= l -> - (forall n:nat, in_int k l n -> P n \/ Q n) -> - between k l \/ exists_between k l. -Proof. -induction 1; intros; auto with arith. -elim IHle; intro; auto with arith. -elim (H0 m); auto with arith. -Qed. - -Lemma between_not_exists : - forall k l, - between k l -> - (forall n:nat, in_int k l n -> P n -> ~ Q n) -> ~ exists_between k l. -Proof. -induction 1; red in |- *; intros. -absurd (k < k); auto with arith. -absurd (Q l); auto with arith. -elim (exists_in_int k (S l)); auto with arith; intros l' inl' Ql'. -replace l with l'; auto with arith. -elim inl'; intros. -elim (le_lt_or_eq l' l); auto with arith; intros. -absurd (exists_between k l); auto with arith. -apply in_int_exists with l'; auto with arith. -Qed. - -Inductive P_nth (init:nat) : nat -> nat -> Prop := - | nth_O : P_nth init init 0 - | nth_S : + Variables P Q : nat -> Prop. + + Inductive between k : nat -> Prop := + | bet_emp : between k k + | bet_S : forall l, between k l -> P l -> between k (S l). + + Hint Constructors between: arith v62. + + Lemma bet_eq : forall k l, l = k -> between k l. + Proof. + induction 1; auto with arith. + Qed. + + Hint Resolve bet_eq: arith v62. + + Lemma between_le : forall k l, between k l -> k <= l. + Proof. + induction 1; auto with arith. + Qed. + Hint Immediate between_le: arith v62. + + Lemma between_Sk_l : forall k l, between k l -> S k <= l -> between (S k) l. + Proof. + intros k l H; induction H as [|l H]. + intros; absurd (S k <= k); auto with arith. + destruct H; auto with arith. + Qed. + Hint Resolve between_Sk_l: arith v62. + + Lemma between_restr : + forall k l (m:nat), k <= l -> l <= m -> between k m -> between l m. + Proof. + induction 1; auto with arith. + Qed. + + Inductive exists_between k : nat -> Prop := + | exists_S : forall l, exists_between k l -> exists_between k (S l) + | exists_le : forall l, k <= l -> Q l -> exists_between k (S l). + + Hint Constructors exists_between: arith v62. + + Lemma exists_le_S : forall k l, exists_between k l -> S k <= l. + Proof. + induction 1; auto with arith. + Qed. + + Lemma exists_lt : forall k l, exists_between k l -> k < l. + Proof exists_le_S. + Hint Immediate exists_le_S exists_lt: arith v62. + + Lemma exists_S_le : forall k l, exists_between k (S l) -> k <= l. + Proof. + intros; apply le_S_n; auto with arith. + Qed. + Hint Immediate exists_S_le: arith v62. + + Definition in_int p q r := p <= r /\ r < q. + + Lemma in_int_intro : forall p q r, p <= r -> r < q -> in_int p q r. + Proof. + red in |- *; auto with arith. + Qed. + Hint Resolve in_int_intro: arith v62. + + Lemma in_int_lt : forall p q r, in_int p q r -> p < q. + Proof. + induction 1; intros. + apply le_lt_trans with r; auto with arith. + Qed. + + Lemma in_int_p_Sq : + forall p q r, in_int p (S q) r -> in_int p q r \/ r = q :>nat. + Proof. + induction 1; intros. + elim (le_lt_or_eq r q); auto with arith. + Qed. + + Lemma in_int_S : forall p q r, in_int p q r -> in_int p (S q) r. + Proof. + induction 1; auto with arith. + Qed. + Hint Resolve in_int_S: arith v62. + + Lemma in_int_Sp_q : forall p q r, in_int (S p) q r -> in_int p q r. + Proof. + induction 1; auto with arith. + Qed. + Hint Immediate in_int_Sp_q: arith v62. + + Lemma between_in_int : + forall k l, between k l -> forall r, in_int k l r -> P r. + Proof. + induction 1; intros. + absurd (k < k); auto with arith. + apply in_int_lt with r; auto with arith. + elim (in_int_p_Sq k l r); intros; auto with arith. + rewrite H2; trivial with arith. + Qed. + + Lemma in_int_between : + forall k l, k <= l -> (forall r, in_int k l r -> P r) -> between k l. + Proof. + induction 1; auto with arith. + Qed. + + Lemma exists_in_int : + forall k l, exists_between k l -> exists2 m : nat, in_int k l m & Q m. + Proof. + induction 1. + case IHexists_between; intros p inp Qp; exists p; auto with arith. + exists l; auto with arith. + Qed. + + Lemma in_int_exists : forall k l r, in_int k l r -> Q r -> exists_between k l. + Proof. + destruct 1; intros. + elim H0; auto with arith. + Qed. + + Lemma between_or_exists : + forall k l, + k <= l -> + (forall n:nat, in_int k l n -> P n \/ Q n) -> + between k l \/ exists_between k l. + Proof. + induction 1; intros; auto with arith. + elim IHle; intro; auto with arith. + elim (H0 m); auto with arith. + Qed. + + Lemma between_not_exists : + forall k l, + between k l -> + (forall n:nat, in_int k l n -> P n -> ~ Q n) -> ~ exists_between k l. + Proof. + induction 1; red in |- *; intros. + absurd (k < k); auto with arith. + absurd (Q l); auto with arith. + elim (exists_in_int k (S l)); auto with arith; intros l' inl' Ql'. + replace l with l'; auto with arith. + elim inl'; intros. + elim (le_lt_or_eq l' l); auto with arith; intros. + absurd (exists_between k l); auto with arith. + apply in_int_exists with l'; auto with arith. + Qed. + + Inductive P_nth (init:nat) : nat -> nat -> Prop := + | nth_O : P_nth init init 0 + | nth_S : forall k l (n:nat), - P_nth init k n -> between (S k) l -> Q l -> P_nth init l (S n). + P_nth init k n -> between (S k) l -> Q l -> P_nth init l (S n). -Lemma nth_le : forall (init:nat) l (n:nat), P_nth init l n -> init <= l. -Proof. -induction 1; intros; auto with arith. -apply le_trans with (S k); auto with arith. -Qed. + Lemma nth_le : forall (init:nat) l (n:nat), P_nth init l n -> init <= l. + Proof. + induction 1; intros; auto with arith. + apply le_trans with (S k); auto with arith. + Qed. -Definition eventually (n:nat) := exists2 k : nat, k <= n & Q k. + Definition eventually (n:nat) := exists2 k : nat, k <= n & Q k. -Lemma event_O : eventually 0 -> Q 0. -Proof. -induction 1; intros. -replace 0 with x; auto with arith. -Qed. + Lemma event_O : eventually 0 -> Q 0. + Proof. + induction 1; intros. + replace 0 with x; auto with arith. + Qed. End Between. Hint Resolve nth_O bet_S bet_emp bet_eq between_Sk_l exists_S exists_le in_int_S in_int_intro: arith v62. -Hint Immediate in_int_Sp_q exists_le_S exists_S_le: arith v62.
\ No newline at end of file +Hint Immediate in_int_Sp_q exists_le_S exists_S_le: arith v62. diff --git a/theories/Arith/Compare.v b/theories/Arith/Compare.v index b11f0517..06898658 100644 --- a/theories/Arith/Compare.v +++ b/theories/Arith/Compare.v @@ -6,21 +6,17 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Compare.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Compare.v 9302 2006-10-27 21:21:17Z barras $ i*) (** Equality is decidable on [nat] *) + Open Local Scope nat_scope. -(* -Lemma not_eq_sym : (A:Set)(p,q:A)(~p=q) -> ~(q=p). -Proof sym_not_eq. -Hints Immediate not_eq_sym : arith. -*) Notation not_eq_sym := sym_not_eq. Implicit Types m n p q : nat. -Require Import Arith. +Require Import Arith_base. Require Import Peano_dec. Require Import Compare_dec. @@ -41,17 +37,17 @@ Proof le_lt_or_eq. (* By special request of G. Kahn - Used in Group Theory *) Lemma discrete_nat : - forall n m, n < m -> S n = m \/ (exists r : nat, m = S (S (n + r))). + forall n m, n < m -> S n = m \/ (exists r : nat, m = S (S (n + r))). Proof. -intros m n H. -lapply (lt_le_S m n); auto with arith. -intro H'; lapply (le_lt_or_eq (S m) n); auto with arith. -induction 1; auto with arith. -right; exists (n - S (S m)); simpl in |- *. -rewrite (plus_comm m (n - S (S m))). -rewrite (plus_n_Sm (n - S (S m)) m). -rewrite (plus_n_Sm (n - S (S m)) (S m)). -rewrite (plus_comm (n - S (S m)) (S (S m))); auto with arith. + intros m n H. + lapply (lt_le_S m n); auto with arith. + intro H'; lapply (le_lt_or_eq (S m) n); auto with arith. + induction 1; auto with arith. + right; exists (n - S (S m)); simpl in |- *. + rewrite (plus_comm m (n - S (S m))). + rewrite (plus_n_Sm (n - S (S m)) m). + rewrite (plus_n_Sm (n - S (S m)) (S m)). + rewrite (plus_comm (n - S (S m)) (S (S m))); auto with arith. Qed. Require Export Wf_nat. diff --git a/theories/Arith/Compare_dec.v b/theories/Arith/Compare_dec.v index d2eead86..e6dc7c46 100644 --- a/theories/Arith/Compare_dec.v +++ b/theories/Arith/Compare_dec.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Compare_dec.v 8733 2006-04-25 22:52:18Z letouzey $ i*) +(*i $Id: Compare_dec.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Le. Require Import Lt. @@ -17,109 +17,113 @@ Open Local Scope nat_scope. Implicit Types m n x y : nat. -Definition zerop : forall n, {n = 0} + {0 < n}. -destruct n; auto with arith. +Definition zerop n : {n = 0} + {0 < n}. + destruct n; auto with arith. Defined. -Definition lt_eq_lt_dec : forall n m, {n < m} + {n = m} + {m < n}. -Proof. -induction n; simple destruct m; auto with arith. -intros m0; elim (IHn m0); auto with arith. -induction 1; auto with arith. +Definition lt_eq_lt_dec n m : {n < m} + {n = m} + {m < n}. + induction n; simple destruct m; auto with arith. + intros m0; elim (IHn m0); auto with arith. + induction 1; auto with arith. Defined. -Lemma gt_eq_gt_dec : forall n m, {m > n} + {n = m} + {n > m}. -Proof lt_eq_lt_dec. +Definition gt_eq_gt_dec n m : {m > n} + {n = m} + {n > m}. + exact lt_eq_lt_dec. +Defined. -Lemma le_lt_dec : forall n m, {n <= m} + {m < n}. -Proof. -induction n. -auto with arith. -induction m. -auto with arith. -elim (IHn m); auto with arith. +Definition le_lt_dec n m : {n <= m} + {m < n}. + induction n. + auto with arith. + induction m. + auto with arith. + elim (IHn m); auto with arith. Defined. -Definition le_le_S_dec : forall n m, {n <= m} + {S m <= n}. -Proof. -exact le_lt_dec. +Definition le_le_S_dec n m : {n <= m} + {S m <= n}. + exact le_lt_dec. Defined. -Definition le_ge_dec : forall n m, {n <= m} + {n >= m}. -Proof. -intros; elim (le_lt_dec n m); auto with arith. +Definition le_ge_dec n m : {n <= m} + {n >= m}. + intros; elim (le_lt_dec n m); auto with arith. Defined. -Definition le_gt_dec : forall n m, {n <= m} + {n > m}. -Proof. -exact le_lt_dec. +Definition le_gt_dec n m : {n <= m} + {n > m}. + exact le_lt_dec. Defined. -Definition le_lt_eq_dec : forall n m, n <= m -> {n < m} + {n = m}. -Proof. -intros; elim (lt_eq_lt_dec n m); auto with arith. -intros; absurd (m < n); auto with arith. +Definition le_lt_eq_dec n m : n <= m -> {n < m} + {n = m}. + intros; elim (lt_eq_lt_dec n m); auto with arith. + intros; absurd (m < n); auto with arith. Defined. (** Proofs of decidability *) Theorem dec_le : forall n m, decidable (n <= m). -intros x y; unfold decidable in |- *; elim (le_gt_dec x y); - [ auto with arith | intro; right; apply gt_not_le; assumption ]. +Proof. + intros x y; unfold decidable in |- *; elim (le_gt_dec x y); + [ auto with arith | intro; right; apply gt_not_le; assumption ]. Qed. Theorem dec_lt : forall n m, decidable (n < m). -intros x y; unfold lt in |- *; apply dec_le. +Proof. + intros x y; unfold lt in |- *; apply dec_le. Qed. Theorem dec_gt : forall n m, decidable (n > m). -intros x y; unfold gt in |- *; apply dec_lt. +Proof. + intros x y; unfold gt in |- *; apply dec_lt. Qed. Theorem dec_ge : forall n m, decidable (n >= m). -intros x y; unfold ge in |- *; apply dec_le. +Proof. + intros x y; unfold ge in |- *; apply dec_le. Qed. Theorem not_eq : forall n m, n <> m -> n < m \/ m < n. -intros x y H; elim (lt_eq_lt_dec x y); - [ intros H1; elim H1; - [ auto with arith | intros H2; absurd (x = y); assumption ] - | auto with arith ]. +Proof. + intros x y H; elim (lt_eq_lt_dec x y); + [ intros H1; elim H1; + [ auto with arith | intros H2; absurd (x = y); assumption ] + | auto with arith ]. Qed. Theorem not_le : forall n m, ~ n <= m -> n > m. -intros x y H; elim (le_gt_dec x y); - [ intros H1; absurd (x <= y); assumption | trivial with arith ]. +Proof. + intros x y H; elim (le_gt_dec x y); + [ intros H1; absurd (x <= y); assumption | trivial with arith ]. Qed. Theorem not_gt : forall n m, ~ n > m -> n <= m. -intros x y H; elim (le_gt_dec x y); - [ trivial with arith | intros H1; absurd (x > y); assumption ]. +Proof. + intros x y H; elim (le_gt_dec x y); + [ trivial with arith | intros H1; absurd (x > y); assumption ]. Qed. Theorem not_ge : forall n m, ~ n >= m -> n < m. -intros x y H; exact (not_le y x H). +Proof. + intros x y H; exact (not_le y x H). Qed. Theorem not_lt : forall n m, ~ n < m -> n >= m. -intros x y H; exact (not_gt y x H). +Proof. + intros x y H; exact (not_gt y x H). Qed. (** A ternary comparison function in the spirit of [Zcompare]. *) Definition nat_compare (n m:nat) := - match lt_eq_lt_dec n m with - | inleft (left _) => Lt - | inleft (right _) => Eq - | inright _ => Gt - end. + match lt_eq_lt_dec n m with + | inleft (left _) => Lt + | inleft (right _) => Eq + | inright _ => Gt + end. Lemma nat_compare_S : forall n m, nat_compare (S n) (S m) = nat_compare n m. Proof. - unfold nat_compare; intros. - simpl; destruct (lt_eq_lt_dec n m) as [[H|H]|H]; simpl; auto. + unfold nat_compare; intros. + simpl; destruct (lt_eq_lt_dec n m) as [[H|H]|H]; simpl; auto. Qed. Lemma nat_compare_eq : forall n m, nat_compare n m = Eq -> n = m. @@ -188,11 +192,11 @@ Qed. Fixpoint leb (m:nat) : nat -> bool := match m with - | O => fun _:nat => true - | S m' => + | O => fun _:nat => true + | S m' => fun n:nat => match n with - | O => false - | S n' => leb m' n' + | O => false + | S n' => leb m' n' end end. diff --git a/theories/Arith/Div.v b/theories/Arith/Div.v index 9011cee3..1dec34e2 100644 --- a/theories/Arith/Div.v +++ b/theories/Arith/Div.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Div.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Div.v 9245 2006-10-17 12:53:34Z notin $ i*) (** Euclidean division *) @@ -20,45 +20,45 @@ Require Compare_dec. Implicit Variables Type n,a,b,q,r:nat. Fixpoint inf_dec [n:nat] : nat->bool := - [m:nat] Cases n m of - O _ => true - | (S n') O => false - | (S n') (S m') => (inf_dec n' m') - end. + [m:nat] Cases n m of + O _ => true + | (S n') O => false + | (S n') (S m') => (inf_dec n' m') + end. Theorem div1 : (b:nat)(gt b O)->(a:nat)(diveucl a b). -Realizer Fix div1 {div1/2: nat->nat->diveucl := - [b,a]Cases a of - O => (O,O) - | (S n) => - let (q,r) = (div1 b n) in - if (le_gt_dec b (S r)) then ((S q),O) - else (q,(S r)) - end}. -Program_all. -Rewrite e. -Replace b with (S r). -Simpl. -Elim plus_n_O; Auto with arith. -Apply le_antisym; Auto with arith. -Elim plus_n_Sm; Auto with arith. + Realizer Fix div1 {div1/2: nat->nat->diveucl := + [b,a]Cases a of + O => (O,O) + | (S n) => + let (q,r) = (div1 b n) in + if (le_gt_dec b (S r)) then ((S q),O) + else (q,(S r)) + end}. + Program_all. + Rewrite e. + Replace b with (S r). + Simpl. + Elim plus_n_O; Auto with arith. + Apply le_antisym; Auto with arith. + Elim plus_n_Sm; Auto with arith. Qed. Theorem div2 : (b:nat)(gt b O)->(a:nat)(diveucl a b). -Realizer Fix div1 {div1/2: nat->nat->diveucl := - [b,a]Cases a of - O => (O,O) - | (S n) => - let (q,r) = (div1 b n) in - if (inf_dec b (S r)) :: :: { {(le b (S r))}+{(gt b (S r))} } - then ((S q),O) - else (q,(S r)) - end}. -Program_all. -Rewrite e. -Replace b with (S r). -Simpl. -Elim plus_n_O; Auto with arith. -Apply le_antisym; Auto with arith. -Elim plus_n_Sm; Auto with arith. + Realizer Fix div1 {div1/2: nat->nat->diveucl := + [b,a]Cases a of + O => (O,O) + | (S n) => + let (q,r) = (div1 b n) in + if (inf_dec b (S r)) :: :: { {(le b (S r))}+{(gt b (S r))} } + then ((S q),O) + else (q,(S r)) + end}. + Program_all. + Rewrite e. + Replace b with (S r). + Simpl. + Elim plus_n_O; Auto with arith. + Apply le_antisym; Auto with arith. + Elim plus_n_Sm; Auto with arith. Qed. diff --git a/theories/Arith/Div2.v b/theories/Arith/Div2.v index ca1f39af..c32759b2 100644 --- a/theories/Arith/Div2.v +++ b/theories/Arith/Div2.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Div2.v 8733 2006-04-25 22:52:18Z letouzey $ i*) +(*i $Id: Div2.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Lt. Require Import Plus. @@ -30,28 +30,30 @@ Fixpoint div2 n : nat := useful to prove the corresponding induction principle *) Lemma ind_0_1_SS : - forall P:nat -> Prop, - P 0 -> P 1 -> (forall n, P n -> P (S (S n))) -> forall n, P n. + forall P:nat -> Prop, + P 0 -> P 1 -> (forall n, P n -> P (S (S n))) -> forall n, P n. Proof. -intros. -cut (forall n, P n /\ P (S n)). -intros. elim (H2 n). auto with arith. - -induction n0. auto with arith. -intros. elim IHn0; auto with arith. + intros P H0 H1 Hn. + cut (forall n, P n /\ P (S n)). + intros H'n n. elim (H'n n). auto with arith. + + induction n. auto with arith. + intros. elim IHn; auto with arith. Qed. (** [0 <n => n/2 < n] *) Lemma lt_div2 : forall n, 0 < n -> div2 n < n. Proof. -intro n. pattern n in |- *. apply ind_0_1_SS. -intro. inversion H. -auto with arith. -intros. simpl in |- *. -case (zerop n0). -intro. rewrite e. auto with arith. -auto with arith. + intro n. pattern n in |- *. apply ind_0_1_SS. + (* n = 0 *) + inversion 1. + (* n=1 *) + simpl; trivial. + (* n=S S n' *) + intro n'; case (zerop n'). + intro n'_eq_0. rewrite n'_eq_0. auto with arith. + auto with arith. Qed. Hint Resolve lt_div2: arith. @@ -59,27 +61,27 @@ Hint Resolve lt_div2: arith. (** Properties related to the parity *) Lemma even_odd_div2 : - forall n, - (even n <-> div2 n = div2 (S n)) /\ (odd n <-> S (div2 n) = div2 (S n)). + forall n, + (even n <-> div2 n = div2 (S n)) /\ (odd n <-> S (div2 n) = div2 (S n)). Proof. -intro n. pattern n in |- *. apply ind_0_1_SS. -(* n = 0 *) -split. split; auto with arith. -split. intro H. inversion H. -intro H. absurd (S (div2 0) = div2 1); auto with arith. -(* n = 1 *) -split. split. intro. inversion H. inversion H1. -intro H. absurd (div2 1 = div2 2). -simpl in |- *. discriminate. assumption. -split; auto with arith. -(* n = (S (S n')) *) -intros. decompose [and] H. unfold iff in H0, H1. -decompose [and] H0. decompose [and] H1. clear H H0 H1. -split; split; auto with arith. -intro H. inversion H. inversion H1. -change (S (div2 n0) = S (div2 (S n0))) in |- *. auto with arith. -intro H. inversion H. inversion H1. -change (S (S (div2 n0)) = S (div2 (S n0))) in |- *. auto with arith. + intro n. pattern n in |- *. apply ind_0_1_SS. + (* n = 0 *) + split. split; auto with arith. + split. intro H. inversion H. + intro H. absurd (S (div2 0) = div2 1); auto with arith. + (* n = 1 *) + split. split. intro. inversion H. inversion H1. + intro H. absurd (div2 1 = div2 2). + simpl in |- *. discriminate. assumption. + split; auto with arith. + (* n = (S (S n')) *) + intros. decompose [and] H. unfold iff in H0, H1. + decompose [and] H0. decompose [and] H1. clear H H0 H1. + split; split; auto with arith. + intro H. inversion H. inversion H1. + change (S (div2 n0) = S (div2 (S n0))) in |- *. auto with arith. + intro H. inversion H. inversion H1. + change (S (S (div2 n0)) = S (div2 (S n0))) in |- *. auto with arith. Qed. (** Specializations *) @@ -106,39 +108,39 @@ Hint Unfold double: arith. Lemma double_S : forall n, double (S n) = S (S (double n)). Proof. -intro. unfold double in |- *. simpl in |- *. auto with arith. + intro. unfold double in |- *. simpl in |- *. auto with arith. Qed. Lemma double_plus : forall n (m:nat), double (n + m) = double n + double m. Proof. -intros m n. unfold double in |- *. -do 2 rewrite plus_assoc_reverse. rewrite (plus_permute n). -reflexivity. + intros m n. unfold double in |- *. + do 2 rewrite plus_assoc_reverse. rewrite (plus_permute n). + reflexivity. Qed. Hint Resolve double_S: arith. Lemma even_odd_double : - forall n, - (even n <-> n = double (div2 n)) /\ (odd n <-> n = S (double (div2 n))). + forall n, + (even n <-> n = double (div2 n)) /\ (odd n <-> n = S (double (div2 n))). Proof. -intro n. pattern n in |- *. apply ind_0_1_SS. -(* n = 0 *) -split; split; auto with arith. -intro H. inversion H. -(* n = 1 *) -split; split; auto with arith. -intro H. inversion H. inversion H1. -(* n = (S (S n')) *) -intros. decompose [and] H. unfold iff in H0, H1. -decompose [and] H0. decompose [and] H1. clear H H0 H1. -split; split. -intro H. inversion H. inversion H1. -simpl in |- *. rewrite (double_S (div2 n0)). auto with arith. -simpl in |- *. rewrite (double_S (div2 n0)). intro H. injection H. auto with arith. -intro H. inversion H. inversion H1. -simpl in |- *. rewrite (double_S (div2 n0)). auto with arith. -simpl in |- *. rewrite (double_S (div2 n0)). intro H. injection H. auto with arith. + intro n. pattern n in |- *. apply ind_0_1_SS. + (* n = 0 *) + split; split; auto with arith. + intro H. inversion H. + (* n = 1 *) + split; split; auto with arith. + intro H. inversion H. inversion H1. + (* n = (S (S n')) *) + intros. decompose [and] H. unfold iff in H0, H1. + decompose [and] H0. decompose [and] H1. clear H H0 H1. + split; split. + intro H. inversion H. inversion H1. + simpl in |- *. rewrite (double_S (div2 n0)). auto with arith. + simpl in |- *. rewrite (double_S (div2 n0)). intro H. injection H. auto with arith. + intro H. inversion H. inversion H1. + simpl in |- *. rewrite (double_S (div2 n0)). auto with arith. + simpl in |- *. rewrite (double_S (div2 n0)). intro H. injection H. auto with arith. Qed. @@ -166,32 +168,32 @@ Hint Resolve even_double double_even odd_double double_odd: arith. Lemma even_2n : forall n, even n -> {p : nat | n = double p}. Proof. -intros n H. exists (div2 n). auto with arith. + intros n H. exists (div2 n). auto with arith. Qed. Lemma odd_S2n : forall n, odd n -> {p : nat | n = S (double p)}. Proof. -intros n H. exists (div2 n). auto with arith. + intros n H. exists (div2 n). auto with arith. Qed. (** Doubling before dividing by two brings back to the initial number. *) Lemma div2_double : forall n:nat, div2 (2*n) = n. Proof. - induction n. - simpl; auto. - simpl. - replace (n+S(n+0)) with (S (2*n)). - f_equal; auto. - simpl; auto with arith. + induction n. + simpl; auto. + simpl. + replace (n+S(n+0)) with (S (2*n)). + f_equal; auto. + simpl; auto with arith. Qed. Lemma div2_double_plus_one : forall n:nat, div2 (S (2*n)) = n. Proof. - induction n. - simpl; auto. - simpl. - replace (n+S(n+0)) with (S (2*n)). - f_equal; auto. - simpl; auto with arith. + induction n. + simpl; auto. + simpl. + replace (n+S(n+0)) with (S (2*n)). + f_equal; auto. + simpl; auto with arith. Qed. diff --git a/theories/Arith/EqNat.v b/theories/Arith/EqNat.v index 09df9464..82d05e2c 100644 --- a/theories/Arith/EqNat.v +++ b/theories/Arith/EqNat.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: EqNat.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: EqNat.v 9245 2006-10-17 12:53:34Z notin $ i*) (** Equality on natural numbers *) @@ -14,52 +14,66 @@ Open Local Scope nat_scope. Implicit Types m n x y : nat. +(** * Propositional equality *) + Fixpoint eq_nat n m {struct n} : Prop := match n, m with - | O, O => True - | O, S _ => False - | S _, O => False - | S n1, S m1 => eq_nat n1 m1 + | O, O => True + | O, S _ => False + | S _, O => False + | S n1, S m1 => eq_nat n1 m1 end. Theorem eq_nat_refl : forall n, eq_nat n n. -induction n; simpl in |- *; auto. + induction n; simpl in |- *; auto. Qed. Hint Resolve eq_nat_refl: arith v62. -Theorem eq_eq_nat : forall n m, n = m -> eq_nat n m. -induction 1; trivial with arith. +(** [eq] restricted to [nat] and [eq_nat] are equivalent *) + +Lemma eq_eq_nat : forall n m, n = m -> eq_nat n m. + induction 1; trivial with arith. Qed. Hint Immediate eq_eq_nat: arith v62. -Theorem eq_nat_eq : forall n m, eq_nat n m -> n = m. -induction n; induction m; simpl in |- *; contradiction || auto with arith. +Lemma eq_nat_eq : forall n m, eq_nat n m -> n = m. + induction n; induction m; simpl in |- *; contradiction || auto with arith. Qed. Hint Immediate eq_nat_eq: arith v62. +Theorem eq_nat_is_eq : forall n m, eq_nat n m <-> n = m. +Proof. + split; auto with arith. +Qed. + Theorem eq_nat_elim : - forall n (P:nat -> Prop), P n -> forall m, eq_nat n m -> P m. -intros; replace m with n; auto with arith. + forall n (P:nat -> Prop), P n -> forall m, eq_nat n m -> P m. +Proof. + intros; replace m with n; auto with arith. Qed. Theorem eq_nat_decide : forall n m, {eq_nat n m} + {~ eq_nat n m}. -induction n. -destruct m as [| n]. -auto with arith. -intros; right; red in |- *; trivial with arith. -destruct m as [| n0]. -right; red in |- *; auto with arith. -intros. -simpl in |- *. -apply IHn. +Proof. + induction n. + destruct m as [| n]. + auto with arith. + intros; right; red in |- *; trivial with arith. + destruct m as [| n0]. + right; red in |- *; auto with arith. + intros. + simpl in |- *. + apply IHn. Defined. + +(** * Boolean equality on [nat] *) + Fixpoint beq_nat n m {struct n} : bool := match n, m with - | O, O => true - | O, S _ => false - | S _, O => false - | S n1, S m1 => beq_nat n1 m1 + | O, O => true + | O, S _ => false + | S _, O => false + | S n1, S m1 => beq_nat n1 m1 end. Lemma beq_nat_refl : forall n, true = beq_nat n n. @@ -71,7 +85,7 @@ Definition beq_nat_eq : forall x y, true = beq_nat x y -> x = y. Proof. double induction x y; simpl in |- *. reflexivity. - intros; discriminate H0. - intros; discriminate H0. - intros; case (H0 _ H1); reflexivity. + intros n H1 H2. discriminate H2. + intros n H1 H2. discriminate H2. + intros n H1 z H2 H3. case (H2 _ H3). reflexivity. Defined. diff --git a/theories/Arith/Euclid.v b/theories/Arith/Euclid.v index 23bc7cdb..3d6f1af5 100644 --- a/theories/Arith/Euclid.v +++ b/theories/Arith/Euclid.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Euclid.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Euclid.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Mult. Require Import Compare_dec. @@ -17,52 +17,55 @@ Open Local Scope nat_scope. Implicit Types a b n q r : nat. Inductive diveucl a b : Set := - divex : forall q r, b > r -> a = q * b + r -> diveucl a b. + divex : forall q r, b > r -> a = q * b + r -> diveucl a b. Lemma eucl_dev : forall n, n > 0 -> forall m:nat, diveucl m n. -intros b H a; pattern a in |- *; apply gt_wf_rec; intros n H0. -elim (le_gt_dec b n). -intro lebn. -elim (H0 (n - b)); auto with arith. -intros q r g e. -apply divex with (S q) r; simpl in |- *; auto with arith. -elim plus_assoc. -elim e; auto with arith. -intros gtbn. -apply divex with 0 n; simpl in |- *; auto with arith. +Proof. + intros b H a; pattern a in |- *; apply gt_wf_rec; intros n H0. + elim (le_gt_dec b n). + intro lebn. + elim (H0 (n - b)); auto with arith. + intros q r g e. + apply divex with (S q) r; simpl in |- *; auto with arith. + elim plus_assoc. + elim e; auto with arith. + intros gtbn. + apply divex with 0 n; simpl in |- *; auto with arith. Qed. Lemma quotient : - forall n, - n > 0 -> - forall m:nat, {q : nat | exists r : nat, m = q * n + r /\ n > r}. -intros b H a; pattern a in |- *; apply gt_wf_rec; intros n H0. -elim (le_gt_dec b n). -intro lebn. -elim (H0 (n - b)); auto with arith. -intros q Hq; exists (S q). -elim Hq; intros r Hr. -exists r; simpl in |- *; elim Hr; intros. -elim plus_assoc. -elim H1; auto with arith. -intros gtbn. -exists 0; exists n; simpl in |- *; auto with arith. + forall n, + n > 0 -> + forall m:nat, {q : nat | exists r : nat, m = q * n + r /\ n > r}. +Proof. + intros b H a; pattern a in |- *; apply gt_wf_rec; intros n H0. + elim (le_gt_dec b n). + intro lebn. + elim (H0 (n - b)); auto with arith. + intros q Hq; exists (S q). + elim Hq; intros r Hr. + exists r; simpl in |- *; elim Hr; intros. + elim plus_assoc. + elim H1; auto with arith. + intros gtbn. + exists 0; exists n; simpl in |- *; auto with arith. Qed. Lemma modulo : - forall n, - n > 0 -> - forall m:nat, {r : nat | exists q : nat, m = q * n + r /\ n > r}. -intros b H a; pattern a in |- *; apply gt_wf_rec; intros n H0. -elim (le_gt_dec b n). -intro lebn. -elim (H0 (n - b)); auto with arith. -intros r Hr; exists r. -elim Hr; intros q Hq. -elim Hq; intros; exists (S q); simpl in |- *. -elim plus_assoc. -elim H1; auto with arith. -intros gtbn. -exists n; exists 0; simpl in |- *; auto with arith. -Qed.
\ No newline at end of file + forall n, + n > 0 -> + forall m:nat, {r : nat | exists q : nat, m = q * n + r /\ n > r}. +Proof. + intros b H a; pattern a in |- *; apply gt_wf_rec; intros n H0. + elim (le_gt_dec b n). + intro lebn. + elim (H0 (n - b)); auto with arith. + intros r Hr; exists r. + elim Hr; intros q Hq. + elim Hq; intros; exists (S q); simpl in |- *. + elim plus_assoc. + elim H1; auto with arith. + intros gtbn. + exists n; exists 0; simpl in |- *; auto with arith. +Qed. diff --git a/theories/Arith/Even.v b/theories/Arith/Even.v index cdbc86df..83c0ce17 100644 --- a/theories/Arith/Even.v +++ b/theories/Arith/Even.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Even.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Even.v 9245 2006-10-17 12:53:34Z notin $ i*) (** Here we define the predicates [even] and [odd] by mutual induction and we prove the decidability and the exclusion of those predicates. @@ -16,6 +16,9 @@ Open Local Scope nat_scope. Implicit Types m n : nat. + +(** * Definition of [even] and [odd], and basic facts *) + Inductive even : nat -> Prop := | even_O : even 0 | even_S : forall n, odd n -> even (S n) @@ -27,279 +30,285 @@ Hint Constructors odd: arith. Lemma even_or_odd : forall n, even n \/ odd n. Proof. -induction n. -auto with arith. -elim IHn; auto with arith. + induction n. + auto with arith. + elim IHn; auto with arith. Qed. Lemma even_odd_dec : forall n, {even n} + {odd n}. Proof. -induction n. -auto with arith. -elim IHn; auto with arith. + induction n. + auto with arith. + elim IHn; auto with arith. Qed. Lemma not_even_and_odd : forall n, even n -> odd n -> False. Proof. -induction n. -intros. inversion H0. -intros. inversion H. inversion H0. auto with arith. + induction n. + intros even_0 odd_0. inversion odd_0. + intros even_Sn odd_Sn. inversion even_Sn. inversion odd_Sn. auto with arith. Qed. + +(** * Facts about [even] & [odd] wrt. [plus] *) + Lemma even_plus_aux : - forall n m, - (odd (n + m) <-> odd n /\ even m \/ even n /\ odd m) /\ - (even (n + m) <-> even n /\ even m \/ odd n /\ odd m). + forall n m, + (odd (n + m) <-> odd n /\ even m \/ even n /\ odd m) /\ + (even (n + m) <-> even n /\ even m \/ odd n /\ odd m). Proof. -intros n; elim n; simpl in |- *; auto with arith. -intros m; split; auto. -split. -intros H; right; split; auto with arith. -intros H'; case H'; auto with arith. -intros H'0; elim H'0; intros H'1 H'2; inversion H'1. -intros H; elim H; auto. -split; auto with arith. -intros H'; elim H'; auto with arith. -intros H; elim H; auto. -intros H'0; elim H'0; intros H'1 H'2; inversion H'1. -intros n0 H' m; elim (H' m); intros H'1 H'2; elim H'1; intros E1 E2; elim H'2; - intros E3 E4; clear H'1 H'2. -split; split. -intros H'0; case E3. -inversion H'0; auto. -intros H; elim H; intros H0 H1; clear H; auto with arith. -intros H; elim H; intros H0 H1; clear H; auto with arith. -intros H'0; case H'0; intros C0; case C0; intros C1 C2. -apply odd_S. -apply E4; left; split; auto with arith. -inversion C1; auto. -apply odd_S. -apply E4; right; split; auto with arith. -inversion C1; auto. -intros H'0. -case E1. -inversion H'0; auto. -intros H; elim H; intros H0 H1; clear H; auto with arith. -intros H; elim H; intros H0 H1; clear H; auto with arith. -intros H'0; case H'0; intros C0; case C0; intros C1 C2. -apply even_S. -apply E2; left; split; auto with arith. -inversion C1; auto. -apply even_S. -apply E2; right; split; auto with arith. -inversion C1; auto. + intros n; elim n; simpl in |- *; auto with arith. + intros m; split; auto. + split. + intros H; right; split; auto with arith. + intros H'; case H'; auto with arith. + intros H'0; elim H'0; intros H'1 H'2; inversion H'1. + intros H; elim H; auto. + split; auto with arith. + intros H'; elim H'; auto with arith. + intros H; elim H; auto. + intros H'0; elim H'0; intros H'1 H'2; inversion H'1. + intros n0 H' m; elim (H' m); intros H'1 H'2; elim H'1; intros E1 E2; elim H'2; + intros E3 E4; clear H'1 H'2. + split; split. + intros H'0; case E3. + inversion H'0; auto. + intros H; elim H; intros H0 H1; clear H; auto with arith. + intros H; elim H; intros H0 H1; clear H; auto with arith. + intros H'0; case H'0; intros C0; case C0; intros C1 C2. + apply odd_S. + apply E4; left; split; auto with arith. + inversion C1; auto. + apply odd_S. + apply E4; right; split; auto with arith. + inversion C1; auto. + intros H'0. + case E1. + inversion H'0; auto. + intros H; elim H; intros H0 H1; clear H; auto with arith. + intros H; elim H; intros H0 H1; clear H; auto with arith. + intros H'0; case H'0; intros C0; case C0; intros C1 C2. + apply even_S. + apply E2; left; split; auto with arith. + inversion C1; auto. + apply even_S. + apply E2; right; split; auto with arith. + inversion C1; auto. Qed. Lemma even_even_plus : forall n m, even n -> even m -> even (n + m). Proof. -intros n m; case (even_plus_aux n m). -intros H H0; case H0; auto. + intros n m; case (even_plus_aux n m). + intros H H0; case H0; auto. Qed. Lemma odd_even_plus : forall n m, odd n -> odd m -> even (n + m). Proof. -intros n m; case (even_plus_aux n m). -intros H H0; case H0; auto. + intros n m; case (even_plus_aux n m). + intros H H0; case H0; auto. Qed. - + Lemma even_plus_even_inv_r : forall n m, even (n + m) -> even n -> even m. Proof. -intros n m H; case (even_plus_aux n m). -intros H' H'0; elim H'0. -intros H'1; case H'1; auto. -intros H0; elim H0; auto. -intros H0 H1 H2; case (not_even_and_odd n); auto. -case H0; auto. + intros n m H; case (even_plus_aux n m). + intros H' H'0; elim H'0. + intros H'1; case H'1; auto. + intros H0; elim H0; auto. + intros H0 H1 H2; case (not_even_and_odd n); auto. + case H0; auto. Qed. Lemma even_plus_even_inv_l : forall n m, even (n + m) -> even m -> even n. Proof. -intros n m H; case (even_plus_aux n m). -intros H' H'0; elim H'0. -intros H'1; case H'1; auto. -intros H0; elim H0; auto. -intros H0 H1 H2; case (not_even_and_odd m); auto. -case H0; auto. + intros n m H; case (even_plus_aux n m). + intros H' H'0; elim H'0. + intros H'1; case H'1; auto. + intros H0; elim H0; auto. + intros H0 H1 H2; case (not_even_and_odd m); auto. + case H0; auto. Qed. - + Lemma even_plus_odd_inv_r : forall n m, even (n + m) -> odd n -> odd m. Proof. -intros n m H; case (even_plus_aux n m). -intros H' H'0; elim H'0. -intros H'1; case H'1; auto. -intros H0 H1 H2; case (not_even_and_odd n); auto. -case H0; auto. -intros H0; case H0; auto. + intros n m H; case (even_plus_aux n m). + intros H' H'0; elim H'0. + intros H'1; case H'1; auto. + intros H0 H1 H2; case (not_even_and_odd n); auto. + case H0; auto. + intros H0; case H0; auto. Qed. - + Lemma even_plus_odd_inv_l : forall n m, even (n + m) -> odd m -> odd n. Proof. -intros n m H; case (even_plus_aux n m). -intros H' H'0; elim H'0. -intros H'1; case H'1; auto. -intros H0 H1 H2; case (not_even_and_odd m); auto. -case H0; auto. -intros H0; case H0; auto. + intros n m H; case (even_plus_aux n m). + intros H' H'0; elim H'0. + intros H'1; case H'1; auto. + intros H0 H1 H2; case (not_even_and_odd m); auto. + case H0; auto. + intros H0; case H0; auto. Qed. Hint Resolve even_even_plus odd_even_plus: arith. - + Lemma odd_plus_l : forall n m, odd n -> even m -> odd (n + m). Proof. -intros n m; case (even_plus_aux n m). -intros H; case H; auto. + intros n m; case (even_plus_aux n m). + intros H; case H; auto. Qed. Lemma odd_plus_r : forall n m, even n -> odd m -> odd (n + m). Proof. -intros n m; case (even_plus_aux n m). -intros H; case H; auto. + intros n m; case (even_plus_aux n m). + intros H; case H; auto. Qed. Lemma odd_plus_even_inv_l : forall n m, odd (n + m) -> odd m -> even n. Proof. -intros n m H; case (even_plus_aux n m). -intros H' H'0; elim H'. -intros H'1; case H'1; auto. -intros H0 H1 H2; case (not_even_and_odd m); auto. -case H0; auto. -intros H0; case H0; auto. + intros n m H; case (even_plus_aux n m). + intros H' H'0; elim H'. + intros H'1; case H'1; auto. + intros H0 H1 H2; case (not_even_and_odd m); auto. + case H0; auto. + intros H0; case H0; auto. Qed. Lemma odd_plus_even_inv_r : forall n m, odd (n + m) -> odd n -> even m. Proof. -intros n m H; case (even_plus_aux n m). -intros H' H'0; elim H'. -intros H'1; case H'1; auto. -intros H0; case H0; auto. -intros H0 H1 H2; case (not_even_and_odd n); auto. -case H0; auto. + intros n m H; case (even_plus_aux n m). + intros H' H'0; elim H'. + intros H'1; case H'1; auto. + intros H0; case H0; auto. + intros H0 H1 H2; case (not_even_and_odd n); auto. + case H0; auto. Qed. Lemma odd_plus_odd_inv_l : forall n m, odd (n + m) -> even m -> odd n. Proof. -intros n m H; case (even_plus_aux n m). -intros H' H'0; elim H'. -intros H'1; case H'1; auto. -intros H0; case H0; auto. -intros H0 H1 H2; case (not_even_and_odd m); auto. -case H0; auto. + intros n m H; case (even_plus_aux n m). + intros H' H'0; elim H'. + intros H'1; case H'1; auto. + intros H0; case H0; auto. + intros H0 H1 H2; case (not_even_and_odd m); auto. + case H0; auto. Qed. - + Lemma odd_plus_odd_inv_r : forall n m, odd (n + m) -> even n -> odd m. Proof. -intros n m H; case (even_plus_aux n m). -intros H' H'0; elim H'. -intros H'1; case H'1; auto. -intros H0 H1 H2; case (not_even_and_odd n); auto. -case H0; auto. -intros H0; case H0; auto. + intros n m H; case (even_plus_aux n m). + intros H' H'0; elim H'. + intros H'1; case H'1; auto. + intros H0 H1 H2; case (not_even_and_odd n); auto. + case H0; auto. + intros H0; case H0; auto. Qed. Hint Resolve odd_plus_l odd_plus_r: arith. - + + +(** * Facts about [even] and [odd] wrt. [mult] *) + Lemma even_mult_aux : - forall n m, - (odd (n * m) <-> odd n /\ odd m) /\ (even (n * m) <-> even n \/ even m). + forall n m, + (odd (n * m) <-> odd n /\ odd m) /\ (even (n * m) <-> even n \/ even m). Proof. -intros n; elim n; simpl in |- *; auto with arith. -intros m; split; split; auto with arith. -intros H'; inversion H'. -intros H'; elim H'; auto. -intros n0 H' m; split; split; auto with arith. -intros H'0. -elim (even_plus_aux m (n0 * m)); intros H'3 H'4; case H'3; intros H'1 H'2; - case H'1; auto. -intros H'5; elim H'5; intros H'6 H'7; auto with arith. -split; auto with arith. -case (H' m). -intros H'8 H'9; case H'9. -intros H'10; case H'10; auto with arith. -intros H'11 H'12; case (not_even_and_odd m); auto with arith. -intros H'5; elim H'5; intros H'6 H'7; case (not_even_and_odd (n0 * m)); auto. -case (H' m). -intros H'8 H'9; case H'9; auto. -intros H'0; elim H'0; intros H'1 H'2; clear H'0. -elim (even_plus_aux m (n0 * m)); auto. -intros H'0 H'3. -elim H'0. -intros H'4 H'5; apply H'5; auto. -left; split; auto with arith. -case (H' m). -intros H'6 H'7; elim H'7. -intros H'8 H'9; apply H'9. -left. -inversion H'1; auto. -intros H'0. -elim (even_plus_aux m (n0 * m)); intros H'3 H'4; case H'4. -intros H'1 H'2. -elim H'1; auto. -intros H; case H; auto. -intros H'5; elim H'5; intros H'6 H'7; auto with arith. -left. -case (H' m). -intros H'8; elim H'8. -intros H'9; elim H'9; auto with arith. -intros H'0; elim H'0; intros H'1. -case (even_or_odd m); intros H'2. -apply even_even_plus; auto. -case (H' m). -intros H H0; case H0; auto. -apply odd_even_plus; auto. -inversion H'1; case (H' m); auto. -intros H1; case H1; auto. -apply even_even_plus; auto. -case (H' m). -intros H H0; case H0; auto. + intros n; elim n; simpl in |- *; auto with arith. + intros m; split; split; auto with arith. + intros H'; inversion H'. + intros H'; elim H'; auto. + intros n0 H' m; split; split; auto with arith. + intros H'0. + elim (even_plus_aux m (n0 * m)); intros H'3 H'4; case H'3; intros H'1 H'2; + case H'1; auto. + intros H'5; elim H'5; intros H'6 H'7; auto with arith. + split; auto with arith. + case (H' m). + intros H'8 H'9; case H'9. + intros H'10; case H'10; auto with arith. + intros H'11 H'12; case (not_even_and_odd m); auto with arith. + intros H'5; elim H'5; intros H'6 H'7; case (not_even_and_odd (n0 * m)); auto. + case (H' m). + intros H'8 H'9; case H'9; auto. + intros H'0; elim H'0; intros H'1 H'2; clear H'0. + elim (even_plus_aux m (n0 * m)); auto. + intros H'0 H'3. + elim H'0. + intros H'4 H'5; apply H'5; auto. + left; split; auto with arith. + case (H' m). + intros H'6 H'7; elim H'7. + intros H'8 H'9; apply H'9. + left. + inversion H'1; auto. + intros H'0. + elim (even_plus_aux m (n0 * m)); intros H'3 H'4; case H'4. + intros H'1 H'2. + elim H'1; auto. + intros H; case H; auto. + intros H'5; elim H'5; intros H'6 H'7; auto with arith. + left. + case (H' m). + intros H'8; elim H'8. + intros H'9; elim H'9; auto with arith. + intros H'0; elim H'0; intros H'1. + case (even_or_odd m); intros H'2. + apply even_even_plus; auto. + case (H' m). + intros H H0; case H0; auto. + apply odd_even_plus; auto. + inversion H'1; case (H' m); auto. + intros H1; case H1; auto. + apply even_even_plus; auto. + case (H' m). + intros H H0; case H0; auto. Qed. - + Lemma even_mult_l : forall n m, even n -> even (n * m). Proof. -intros n m; case (even_mult_aux n m); auto. -intros H H0; case H0; auto. + intros n m; case (even_mult_aux n m); auto. + intros H H0; case H0; auto. Qed. Lemma even_mult_r : forall n m, even m -> even (n * m). Proof. -intros n m; case (even_mult_aux n m); auto. -intros H H0; case H0; auto. + intros n m; case (even_mult_aux n m); auto. + intros H H0; case H0; auto. Qed. Hint Resolve even_mult_l even_mult_r: arith. - + Lemma even_mult_inv_r : forall n m, even (n * m) -> odd n -> even m. Proof. -intros n m H' H'0. -case (even_mult_aux n m). -intros H'1 H'2; elim H'2. -intros H'3; elim H'3; auto. -intros H; case (not_even_and_odd n); auto. + intros n m H' H'0. + case (even_mult_aux n m). + intros H'1 H'2; elim H'2. + intros H'3; elim H'3; auto. + intros H; case (not_even_and_odd n); auto. Qed. Lemma even_mult_inv_l : forall n m, even (n * m) -> odd m -> even n. Proof. -intros n m H' H'0. -case (even_mult_aux n m). -intros H'1 H'2; elim H'2. -intros H'3; elim H'3; auto. -intros H; case (not_even_and_odd m); auto. + intros n m H' H'0. + case (even_mult_aux n m). + intros H'1 H'2; elim H'2. + intros H'3; elim H'3; auto. + intros H; case (not_even_and_odd m); auto. Qed. Lemma odd_mult : forall n m, odd n -> odd m -> odd (n * m). Proof. -intros n m; case (even_mult_aux n m); intros H; case H; auto. + intros n m; case (even_mult_aux n m); intros H; case H; auto. Qed. Hint Resolve even_mult_l even_mult_r odd_mult: arith. Lemma odd_mult_inv_l : forall n m, odd (n * m) -> odd n. Proof. -intros n m H'. -case (even_mult_aux n m). -intros H'1 H'2; elim H'1. -intros H'3; elim H'3; auto. + intros n m H'. + case (even_mult_aux n m). + intros H'1 H'2; elim H'1. + intros H'3; elim H'3; auto. Qed. - + Lemma odd_mult_inv_r : forall n m, odd (n * m) -> odd m. Proof. -intros n m H'. -case (even_mult_aux n m). -intros H'1 H'2; elim H'1. -intros H'3; elim H'3; auto. + intros n m H'. + case (even_mult_aux n m). + intros H'1 H'2; elim H'1. + intros H'3; elim H'3; auto. Qed. diff --git a/theories/Arith/Factorial.v b/theories/Arith/Factorial.v index 2767f9f0..5e2f491a 100644 --- a/theories/Arith/Factorial.v +++ b/theories/Arith/Factorial.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Factorial.v 6338 2004-11-22 09:10:51Z gregoire $ i*) +(*i $Id: Factorial.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Plus. Require Import Mult. @@ -17,34 +17,34 @@ Open Local Scope nat_scope. Boxed Fixpoint fact (n:nat) : nat := match n with - | O => 1 - | S n => S n * fact n + | O => 1 + | S n => S n * fact n end. Arguments Scope fact [nat_scope]. Lemma lt_O_fact : forall n:nat, 0 < fact n. Proof. -simple induction n; unfold lt in |- *; simpl in |- *; auto with arith. + simple induction n; unfold lt in |- *; simpl in |- *; auto with arith. Qed. Lemma fact_neq_0 : forall n:nat, fact n <> 0. Proof. -intro. -apply sym_not_eq. -apply lt_O_neq. -apply lt_O_fact. + intro. + apply sym_not_eq. + apply lt_O_neq. + apply lt_O_fact. Qed. Lemma fact_le : forall n m:nat, n <= m -> fact n <= fact m. Proof. -induction 1. -apply le_n. -assert (1 * fact n <= S m * fact m). -apply mult_le_compat. -apply lt_le_S; apply lt_O_Sn. -assumption. -simpl (1 * fact n) in H0. -rewrite <- plus_n_O in H0. -assumption. + induction 1. + apply le_n. + assert (1 * fact n <= S m * fact m). + apply mult_le_compat. + apply lt_le_S; apply lt_O_Sn. + assumption. + simpl (1 * fact n) in H0. + rewrite <- plus_n_O in H0. + assumption. Qed. diff --git a/theories/Arith/Gt.v b/theories/Arith/Gt.v index 90f893a3..5b1ee1b2 100644 --- a/theories/Arith/Gt.v +++ b/theories/Arith/Gt.v @@ -6,7 +6,13 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Gt.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Gt.v 9245 2006-10-17 12:53:34Z notin $ i*) + +(** Theorems about [gt] in [nat]. [gt] is defined in [Init/Peano.v] as: +<< +Definition gt (n m:nat) := m < n. +>> +*) Require Import Le. Require Import Lt. @@ -15,7 +21,7 @@ Open Local Scope nat_scope. Implicit Types m n p : nat. -(** Order and successor *) +(** * Order and successor *) Theorem gt_Sn_O : forall n, S n > 0. Proof. @@ -52,20 +58,20 @@ Proof. Qed. Hint Immediate gt_pred: arith v62. -(** Irreflexivity *) +(** * Irreflexivity *) Lemma gt_irrefl : forall n, ~ n > n. Proof lt_irrefl. Hint Resolve gt_irrefl: arith v62. -(** Asymmetry *) +(** * Asymmetry *) Lemma gt_asym : forall n m, n > m -> ~ m > n. Proof fun n m => lt_asym m n. Hint Resolve gt_asym: arith v62. -(** Relating strict and large orders *) +(** * Relating strict and large orders *) Lemma le_not_gt : forall n m, n <= m -> ~ n > m. Proof le_not_lt. @@ -102,7 +108,7 @@ Proof. Qed. Hint Resolve le_gt_S: arith v62. -(** Transitivity *) +(** * Transitivity *) Theorem le_gt_trans : forall n m p, m <= n -> m > p -> n > p. Proof. @@ -127,14 +133,14 @@ Qed. Hint Resolve gt_trans_S le_gt_trans gt_le_trans: arith v62. -(** Comparison to 0 *) +(** * Comparison to 0 *) Theorem gt_O_eq : forall n, n > 0 \/ 0 = n. Proof. intro n; apply gt_S; auto with arith. Qed. -(** Simplification and compatibility *) +(** * Simplification and compatibility *) Lemma plus_gt_reg_l : forall n m p, p + n > p + m -> n > m. Proof. diff --git a/theories/Arith/Le.v b/theories/Arith/Le.v index e95ef408..e8b9e6be 100644 --- a/theories/Arith/Le.v +++ b/theories/Arith/Le.v @@ -6,108 +6,124 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Le.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Le.v 9245 2006-10-17 12:53:34Z notin $ i*) + +(** Order on natural numbers. [le] is defined in [Init/Peano.v] as: +<< +Inductive le (n:nat) : nat -> Prop := + | le_n : n <= n + | le_S : forall m:nat, n <= m -> n <= S m + +where "n <= m" := (le n m) : nat_scope. +>> + *) -(** Order on natural numbers *) Open Local Scope nat_scope. Implicit Types m n p : nat. -(** Reflexivity *) +(** * [le] is a pre-order *) +(** Reflexivity *) Theorem le_refl : forall n, n <= n. Proof. -exact le_n. + exact le_n. Qed. (** Transitivity *) - Theorem le_trans : forall n m p, n <= m -> m <= p -> n <= p. Proof. induction 2; auto. Qed. Hint Resolve le_trans: arith v62. -(** Order, successor and predecessor *) +(** * Properties of [le] w.r.t. successor, predecessor and 0 *) -Theorem le_n_S : forall n m, n <= m -> S n <= S m. +(** Comparison to 0 *) + +Theorem le_O_n : forall n, 0 <= n. Proof. - induction 1; auto. + induction n; auto. Qed. -Theorem le_n_Sn : forall n, n <= S n. +Theorem le_Sn_O : forall n, ~ S n <= 0. Proof. - auto. + red in |- *; intros n H. + change (IsSucc 0) in |- *; elim H; simpl in |- *; auto with arith. Qed. -Theorem le_O_n : forall n, 0 <= n. +Hint Resolve le_O_n le_Sn_O: arith v62. + +Theorem le_n_O_eq : forall n, n <= 0 -> 0 = n. Proof. - induction n; auto. + induction n; auto with arith. + intro; contradiction le_Sn_O with n. Qed. +Hint Immediate le_n_O_eq: arith v62. -Hint Resolve le_n_S le_n_Sn le_O_n le_n_S: arith v62. -Theorem le_pred_n : forall n, pred n <= n. +(** [le] and successor *) + +Theorem le_n_S : forall n m, n <= m -> S n <= S m. Proof. -induction n; auto with arith. + induction 1; auto. Qed. -Hint Resolve le_pred_n: arith v62. + +Theorem le_n_Sn : forall n, n <= S n. +Proof. + auto. +Qed. + +Hint Resolve le_n_S le_n_Sn : arith v62. Theorem le_Sn_le : forall n m, S n <= m -> n <= m. Proof. -intros n m H; apply le_trans with (S n); auto with arith. + intros n m H; apply le_trans with (S n); auto with arith. Qed. Hint Immediate le_Sn_le: arith v62. Theorem le_S_n : forall n m, S n <= S m -> n <= m. Proof. -intros n m H; change (pred (S n) <= pred (S m)) in |- *. -destruct H; simpl; auto with arith. + intros n m H; change (pred (S n) <= pred (S m)) in |- *. + destruct H; simpl; auto with arith. Qed. Hint Immediate le_S_n: arith v62. -Theorem le_pred : forall n m, n <= m -> pred n <= pred m. +Theorem le_Sn_n : forall n, ~ S n <= n. Proof. -destruct n; simpl; auto with arith. -destruct m; simpl; auto with arith. + induction n; auto with arith. Qed. +Hint Resolve le_Sn_n: arith v62. -(** Comparison to 0 *) +(** [le] and predecessor *) -Theorem le_Sn_O : forall n, ~ S n <= 0. +Theorem le_pred_n : forall n, pred n <= n. Proof. -red in |- *; intros n H. -change (IsSucc 0) in |- *; elim H; simpl in |- *; auto with arith. + induction n; auto with arith. Qed. -Hint Resolve le_Sn_O: arith v62. +Hint Resolve le_pred_n: arith v62. -Theorem le_n_O_eq : forall n, n <= 0 -> 0 = n. +Theorem le_pred : forall n m, n <= m -> pred n <= pred m. Proof. -induction n; auto with arith. -intro; contradiction le_Sn_O with n. + destruct n; simpl; auto with arith. + destruct m; simpl; auto with arith. Qed. -Hint Immediate le_n_O_eq: arith v62. -(** Negative properties *) - -Theorem le_Sn_n : forall n, ~ S n <= n. -Proof. -induction n; auto with arith. -Qed. -Hint Resolve le_Sn_n: arith v62. +(** * [le] is a order on [nat] *) (** Antisymmetry *) Theorem le_antisym : forall n m, n <= m -> m <= n -> n = m. Proof. -intros n m h; destruct h as [| m0 H]; auto with arith. -intros H1. -absurd (S m0 <= m0); auto with arith. -apply le_trans with n; auto with arith. + intros n m H; destruct H as [|m' H]; auto with arith. + intros H1. + absurd (S m' <= m'); auto with arith. + apply le_trans with n; auto with arith. Qed. Hint Immediate le_antisym: arith v62. -(** A different elimination principle for the order on natural numbers *) + +(** * A different elimination principle for the order on natural numbers *) Lemma le_elim_rel : forall P:nat -> nat -> Prop, @@ -115,7 +131,7 @@ Lemma le_elim_rel : (forall p (q:nat), p <= q -> P p q -> P (S p) (S q)) -> forall n m, n <= m -> P n m. Proof. -induction n; auto with arith. -intros m Le. -elim Le; auto with arith. -Qed.
\ No newline at end of file + induction n; auto with arith. + intros m Le. + elim Le; auto with arith. +Qed. diff --git a/theories/Arith/Lt.v b/theories/Arith/Lt.v index eeb4e35e..94cf3793 100644 --- a/theories/Arith/Lt.v +++ b/theories/Arith/Lt.v @@ -6,86 +6,93 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Lt.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Lt.v 9245 2006-10-17 12:53:34Z notin $ i*) + +(** Theorems about [lt] in nat. [lt] is defined in library [Init/Peano.v] as: +<< +Definition lt (n m:nat) := S n <= m. +Infix "<" := lt : nat_scope. +>> +*) Require Import Le. Open Local Scope nat_scope. Implicit Types m n p : nat. -(** Irreflexivity *) +(** * Irreflexivity *) Theorem lt_irrefl : forall n, ~ n < n. Proof le_Sn_n. Hint Resolve lt_irrefl: arith v62. -(** Relationship between [le] and [lt] *) +(** * Relationship between [le] and [lt] *) Theorem lt_le_S : forall n m, n < m -> S n <= m. Proof. -auto with arith. + auto with arith. Qed. Hint Immediate lt_le_S: arith v62. Theorem lt_n_Sm_le : forall n m, n < S m -> n <= m. Proof. -auto with arith. + auto with arith. Qed. Hint Immediate lt_n_Sm_le: arith v62. Theorem le_lt_n_Sm : forall n m, n <= m -> n < S m. Proof. -auto with arith. + auto with arith. Qed. Hint Immediate le_lt_n_Sm: arith v62. Theorem le_not_lt : forall n m, n <= m -> ~ m < n. Proof. -induction 1; auto with arith. + induction 1; auto with arith. Qed. Theorem lt_not_le : forall n m, n < m -> ~ m <= n. Proof. -red in |- *; intros n m Lt Le; exact (le_not_lt m n Le Lt). + red in |- *; intros n m Lt Le; exact (le_not_lt m n Le Lt). Qed. Hint Immediate le_not_lt lt_not_le: arith v62. -(** Asymmetry *) +(** * Asymmetry *) Theorem lt_asym : forall n m, n < m -> ~ m < n. Proof. -induction 1; auto with arith. + induction 1; auto with arith. Qed. -(** Order and successor *) +(** * Order and successor *) Theorem lt_n_Sn : forall n, n < S n. Proof. -auto with arith. + auto with arith. Qed. Hint Resolve lt_n_Sn: arith v62. Theorem lt_S : forall n m, n < m -> n < S m. Proof. -auto with arith. + auto with arith. Qed. Hint Resolve lt_S: arith v62. Theorem lt_n_S : forall n m, n < m -> S n < S m. Proof. -auto with arith. + auto with arith. Qed. Hint Resolve lt_n_S: arith v62. Theorem lt_S_n : forall n m, S n < S m -> n < m. Proof. -auto with arith. + auto with arith. Qed. Hint Immediate lt_S_n: arith v62. Theorem lt_O_Sn : forall n, 0 < S n. Proof. -auto with arith. + auto with arith. Qed. Hint Resolve lt_O_Sn: arith v62. @@ -93,7 +100,7 @@ Theorem lt_n_O : forall n, ~ n < 0. Proof le_Sn_O. Hint Resolve lt_n_O: arith v62. -(** Predecessor *) +(** * Predecessor *) Lemma S_pred : forall n m, m < n -> n = S (pred n). Proof. @@ -111,65 +118,65 @@ destruct 1; simpl in |- *; auto with arith. Qed. Hint Resolve lt_pred_n_n: arith v62. -(** Transitivity properties *) +(** * Transitivity properties *) Theorem lt_trans : forall n m p, n < m -> m < p -> n < p. Proof. -induction 2; auto with arith. + induction 2; auto with arith. Qed. Theorem lt_le_trans : forall n m p, n < m -> m <= p -> n < p. Proof. -induction 2; auto with arith. + induction 2; auto with arith. Qed. Theorem le_lt_trans : forall n m p, n <= m -> m < p -> n < p. Proof. -induction 2; auto with arith. + induction 2; auto with arith. Qed. Hint Resolve lt_trans lt_le_trans le_lt_trans: arith v62. -(** Large = strict or equal *) +(** * Large = strict or equal *) Theorem le_lt_or_eq : forall n m, n <= m -> n < m \/ n = m. Proof. -induction 1; auto with arith. + induction 1; auto with arith. Qed. Theorem lt_le_weak : forall n m, n < m -> n <= m. Proof. -auto with arith. + auto with arith. Qed. Hint Immediate lt_le_weak: arith v62. -(** Dichotomy *) +(** * Dichotomy *) Theorem le_or_lt : forall n m, n <= m \/ m < n. Proof. -intros n m; pattern n, m in |- *; apply nat_double_ind; auto with arith. -induction 1; auto with arith. + intros n m; pattern n, m in |- *; apply nat_double_ind; auto with arith. + induction 1; auto with arith. Qed. Theorem nat_total_order : forall n m, n <> m -> n < m \/ m < n. Proof. -intros m n diff. -elim (le_or_lt n m); [ intro H'0 | auto with arith ]. -elim (le_lt_or_eq n m); auto with arith. -intro H'; elim diff; auto with arith. + intros m n diff. + elim (le_or_lt n m); [ intro H'0 | auto with arith ]. + elim (le_lt_or_eq n m); auto with arith. + intro H'; elim diff; auto with arith. Qed. -(** Comparison to 0 *) +(** * Comparison to 0 *) Theorem neq_O_lt : forall n, 0 <> n -> 0 < n. Proof. -induction n; auto with arith. -intros; absurd (0 = 0); trivial with arith. + induction n; auto with arith. + intros; absurd (0 = 0); trivial with arith. Qed. Hint Immediate neq_O_lt: arith v62. Theorem lt_O_neq : forall n, 0 < n -> 0 <> n. Proof. -induction 1; auto with arith. + induction 1; auto with arith. Qed. Hint Immediate lt_O_neq: arith v62.
\ No newline at end of file diff --git a/theories/Arith/Max.v b/theories/Arith/Max.v index 7f5c1148..e0222e41 100644 --- a/theories/Arith/Max.v +++ b/theories/Arith/Max.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Max.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Max.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Arith. @@ -14,66 +14,66 @@ Open Local Scope nat_scope. Implicit Types m n : nat. -(** maximum of two natural numbers *) +(** * maximum of two natural numbers *) Fixpoint max n m {struct n} : nat := match n, m with - | O, _ => m - | S n', O => n - | S n', S m' => S (max n' m') + | O, _ => m + | S n', O => n + | S n', S m' => S (max n' m') end. -(** Simplifications of [max] *) +(** * Simplifications of [max] *) Lemma max_SS : forall n m, S (max n m) = max (S n) (S m). Proof. -auto with arith. + auto with arith. Qed. Lemma max_comm : forall n m, max n m = max m n. Proof. -induction n; induction m; simpl in |- *; auto with arith. + induction n; induction m; simpl in |- *; auto with arith. Qed. -(** [max] and [le] *) +(** * [max] and [le] *) Lemma max_l : forall n m, m <= n -> max n m = n. Proof. -induction n; induction m; simpl in |- *; auto with arith. + induction n; induction m; simpl in |- *; auto with arith. Qed. Lemma max_r : forall n m, n <= m -> max n m = m. Proof. -induction n; induction m; simpl in |- *; auto with arith. + induction n; induction m; simpl in |- *; auto with arith. Qed. Lemma le_max_l : forall n m, n <= max n m. Proof. -induction n; intros; simpl in |- *; auto with arith. -elim m; intros; simpl in |- *; auto with arith. + induction n; intros; simpl in |- *; auto with arith. + elim m; intros; simpl in |- *; auto with arith. Qed. Lemma le_max_r : forall n m, m <= max n m. Proof. -induction n; simpl in |- *; auto with arith. -induction m; simpl in |- *; auto with arith. + induction n; simpl in |- *; auto with arith. + induction m; simpl in |- *; auto with arith. Qed. Hint Resolve max_r max_l le_max_l le_max_r: arith v62. -(** [max n m] is equal to [n] or [m] *) +(** * [max n m] is equal to [n] or [m] *) Lemma max_dec : forall n m, {max n m = n} + {max n m = m}. Proof. -induction n; induction m; simpl in |- *; auto with arith. -elim (IHn m); intro H; elim H; auto. + induction n; induction m; simpl in |- *; auto with arith. + elim (IHn m); intro H; elim H; auto. Qed. Lemma max_case : forall n m (P:nat -> Type), P n -> P m -> P (max n m). Proof. -induction n; simpl in |- *; auto with arith. -induction m; intros; simpl in |- *; auto with arith. -pattern (max n m) in |- *; apply IHn; auto with arith. + induction n; simpl in |- *; auto with arith. + induction m; intros; simpl in |- *; auto with arith. + pattern (max n m) in |- *; apply IHn; auto with arith. Qed. Notation max_case2 := max_case (only parsing). diff --git a/theories/Arith/Min.v b/theories/Arith/Min.v index 38351817..db14e74b 100644 --- a/theories/Arith/Min.v +++ b/theories/Arith/Min.v @@ -6,73 +6,73 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Min.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Min.v 9245 2006-10-17 12:53:34Z notin $ i*) -Require Import Arith. +Require Import Le. Open Local Scope nat_scope. Implicit Types m n : nat. -(** minimum of two natural numbers *) +(** * minimum of two natural numbers *) Fixpoint min n m {struct n} : nat := match n, m with - | O, _ => 0 - | S n', O => 0 - | S n', S m' => S (min n' m') + | O, _ => 0 + | S n', O => 0 + | S n', S m' => S (min n' m') end. -(** Simplifications of [min] *) +(** * Simplifications of [min] *) Lemma min_SS : forall n m, S (min n m) = min (S n) (S m). Proof. -auto with arith. + auto with arith. Qed. Lemma min_comm : forall n m, min n m = min m n. Proof. -induction n; induction m; simpl in |- *; auto with arith. + induction n; induction m; simpl in |- *; auto with arith. Qed. -(** [min] and [le] *) +(** * [min] and [le] *) Lemma min_l : forall n m, n <= m -> min n m = n. Proof. -induction n; induction m; simpl in |- *; auto with arith. + induction n; induction m; simpl in |- *; auto with arith. Qed. Lemma min_r : forall n m, m <= n -> min n m = m. Proof. -induction n; induction m; simpl in |- *; auto with arith. + induction n; induction m; simpl in |- *; auto with arith. Qed. Lemma le_min_l : forall n m, min n m <= n. Proof. -induction n; intros; simpl in |- *; auto with arith. -elim m; intros; simpl in |- *; auto with arith. + induction n; intros; simpl in |- *; auto with arith. + elim m; intros; simpl in |- *; auto with arith. Qed. Lemma le_min_r : forall n m, min n m <= m. Proof. -induction n; simpl in |- *; auto with arith. -induction m; simpl in |- *; auto with arith. + induction n; simpl in |- *; auto with arith. + induction m; simpl in |- *; auto with arith. Qed. Hint Resolve min_l min_r le_min_l le_min_r: arith v62. -(** [min n m] is equal to [n] or [m] *) +(** * [min n m] is equal to [n] or [m] *) Lemma min_dec : forall n m, {min n m = n} + {min n m = m}. Proof. -induction n; induction m; simpl in |- *; auto with arith. -elim (IHn m); intro H; elim H; auto. + induction n; induction m; simpl in |- *; auto with arith. + elim (IHn m); intro H; elim H; auto. Qed. Lemma min_case : forall n m (P:nat -> Type), P n -> P m -> P (min n m). Proof. -induction n; simpl in |- *; auto with arith. -induction m; intros; simpl in |- *; auto with arith. -pattern (min n m) in |- *; apply IHn; auto with arith. + induction n; simpl in |- *; auto with arith. + induction m; intros; simpl in |- *; auto with arith. + pattern (min n m) in |- *; apply IHn; auto with arith. Qed. Notation min_case2 := min_case (only parsing). diff --git a/theories/Arith/Minus.v b/theories/Arith/Minus.v index dfecd7cf..2380c2de 100644 --- a/theories/Arith/Minus.v +++ b/theories/Arith/Minus.v @@ -6,9 +6,19 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Minus.v 8642 2006-03-17 10:09:02Z notin $ i*) - -(** Subtraction (difference between two natural numbers) *) +(*i $Id: Minus.v 9245 2006-10-17 12:53:34Z notin $ i*) + +(** [minus] (difference between two natural numbers) is defined in [Init/Peano.v] as: +<< +Fixpoint minus (n m:nat) {struct n} : nat := + match n, m with + | O, _ => 0 + | S k, O => S k + | S k, S l => k - l + end +where "n - m" := (minus n m) : nat_scope. +>> +*) Require Import Lt. Require Import Le. @@ -17,36 +27,37 @@ Open Local Scope nat_scope. Implicit Types m n p : nat. -(** 0 is right neutral *) +(** * 0 is right neutral *) Lemma minus_n_O : forall n, n = n - 0. Proof. -induction n; simpl in |- *; auto with arith. + induction n; simpl in |- *; auto with arith. Qed. Hint Resolve minus_n_O: arith v62. -(** Permutation with successor *) +(** * Permutation with successor *) Lemma minus_Sn_m : forall n m, m <= n -> S (n - m) = S n - m. Proof. -intros n m Le; pattern m, n in |- *; apply le_elim_rel; simpl in |- *; - auto with arith. + intros n m Le; pattern m, n in |- *; apply le_elim_rel; simpl in |- *; + auto with arith. Qed. Hint Resolve minus_Sn_m: arith v62. Theorem pred_of_minus : forall n, pred n = n - 1. -intro x; induction x; simpl in |- *; auto with arith. +Proof. + intro x; induction x; simpl in |- *; auto with arith. Qed. -(** Diagonal *) +(** * Diagonal *) Lemma minus_n_n : forall n, 0 = n - n. Proof. -induction n; simpl in |- *; auto with arith. + induction n; simpl in |- *; auto with arith. Qed. Hint Resolve minus_n_n: arith v62. -(** Simplification *) +(** * Simplification *) Lemma minus_plus_simpl_l_reverse : forall n m p, n - m = p + n - (p + m). Proof. @@ -54,70 +65,71 @@ Proof. Qed. Hint Resolve minus_plus_simpl_l_reverse: arith v62. -(** Relation with plus *) +(** * Relation with plus *) Lemma plus_minus : forall n m p, n = m + p -> p = n - m. Proof. -intros n m p; pattern m, n in |- *; apply nat_double_ind; simpl in |- *; - intros. -replace (n0 - 0) with n0; auto with arith. -absurd (0 = S (n0 + p)); auto with arith. -auto with arith. + intros n m p; pattern m, n in |- *; apply nat_double_ind; simpl in |- *; + intros. + replace (n0 - 0) with n0; auto with arith. + absurd (0 = S (n0 + p)); auto with arith. + auto with arith. Qed. Hint Immediate plus_minus: arith v62. Lemma minus_plus : forall n m, n + m - n = m. -symmetry in |- *; auto with arith. + symmetry in |- *; auto with arith. Qed. Hint Resolve minus_plus: arith v62. Lemma le_plus_minus : forall n m, n <= m -> m = n + (m - n). Proof. -intros n m Le; pattern n, m in |- *; apply le_elim_rel; simpl in |- *; - auto with arith. + intros n m Le; pattern n, m in |- *; apply le_elim_rel; simpl in |- *; + auto with arith. Qed. Hint Resolve le_plus_minus: arith v62. Lemma le_plus_minus_r : forall n m, n <= m -> n + (m - n) = m. Proof. -symmetry in |- *; auto with arith. + symmetry in |- *; auto with arith. Qed. Hint Resolve le_plus_minus_r: arith v62. -(** Relation with order *) +(** * Relation with order *) Theorem le_minus : forall n m, n - m <= n. Proof. -intros i h; pattern i, h in |- *; apply nat_double_ind; - [ auto - | auto - | intros m n H; simpl in |- *; apply le_trans with (m := m); auto ]. + intros i h; pattern i, h in |- *; apply nat_double_ind; + [ auto + | auto + | intros m n H; simpl in |- *; apply le_trans with (m := m); auto ]. Qed. Lemma lt_minus : forall n m, m <= n -> 0 < m -> n - m < n. Proof. -intros n m Le; pattern m, n in |- *; apply le_elim_rel; simpl in |- *; - auto with arith. -intros; absurd (0 < 0); auto with arith. -intros p q lepq Hp gtp. -elim (le_lt_or_eq 0 p); auto with arith. -auto with arith. -induction 1; elim minus_n_O; auto with arith. + intros n m Le; pattern m, n in |- *; apply le_elim_rel; simpl in |- *; + auto with arith. + intros; absurd (0 < 0); auto with arith. + intros p q lepq Hp gtp. + elim (le_lt_or_eq 0 p); auto with arith. + auto with arith. + induction 1; elim minus_n_O; auto with arith. Qed. Hint Resolve lt_minus: arith v62. Lemma lt_O_minus_lt : forall n m, 0 < n - m -> m < n. Proof. -intros n m; pattern n, m in |- *; apply nat_double_ind; simpl in |- *; - auto with arith. -intros; absurd (0 < 0); trivial with arith. + intros n m; pattern n, m in |- *; apply nat_double_ind; simpl in |- *; + auto with arith. + intros; absurd (0 < 0); trivial with arith. Qed. Hint Immediate lt_O_minus_lt: arith v62. Theorem not_le_minus_0 : forall n m, ~ m <= n -> n - m = 0. -intros y x; pattern y, x in |- *; apply nat_double_ind; - [ simpl in |- *; trivial with arith - | intros n H; absurd (0 <= S n); [ assumption | apply le_O_n ] - | simpl in |- *; intros n m H1 H2; apply H1; unfold not in |- *; intros H3; - apply H2; apply le_n_S; assumption ]. -Qed.
\ No newline at end of file +Proof. + intros y x; pattern y, x in |- *; apply nat_double_ind; + [ simpl in |- *; trivial with arith + | intros n H; absurd (0 <= S n); [ assumption | apply le_O_n ] + | simpl in |- *; intros n m H1 H2; apply H1; unfold not in |- *; intros H3; + apply H2; apply le_n_S; assumption ]. +Qed. diff --git a/theories/Arith/Mult.v b/theories/Arith/Mult.v index 051f8645..2315e12c 100644 --- a/theories/Arith/Mult.v +++ b/theories/Arith/Mult.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Mult.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Mult.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Export Plus. Require Export Minus. @@ -17,86 +17,98 @@ Open Local Scope nat_scope. Implicit Types m n p : nat. -(** Zero property *) +(** Theorems about multiplication in [nat]. [mult] is defined in module [Init/Peano.v]. *) + +(** * [nat] is a semi-ring *) + +(** ** Zero property *) Lemma mult_0_r : forall n, n * 0 = 0. Proof. -intro; symmetry in |- *; apply mult_n_O. + intro; symmetry in |- *; apply mult_n_O. Qed. Lemma mult_0_l : forall n, 0 * n = 0. Proof. -reflexivity. + reflexivity. Qed. -(** Distributivity *) +(** ** 1 is neutral *) -Lemma mult_plus_distr_r : forall n m p, (n + m) * p = n * p + m * p. +Lemma mult_1_l : forall n, 1 * n = n. Proof. -intros; elim n; simpl in |- *; intros; auto with arith. -elim plus_assoc; elim H; auto with arith. + simpl in |- *; auto with arith. Qed. -Hint Resolve mult_plus_distr_r: arith v62. +Hint Resolve mult_1_l: arith v62. -Lemma mult_plus_distr_l : forall n m p, n * (m + p) = n * m + n * p. +Lemma mult_1_r : forall n, n * 1 = n. Proof. - induction n. trivial. - intros. simpl in |- *. rewrite (IHn m p). apply sym_eq. apply plus_permute_2_in_4. + induction n; [ trivial | + simpl; rewrite IHn; reflexivity]. Qed. +Hint Resolve mult_1_r: arith v62. -Lemma mult_minus_distr_r : forall n m p, (n - m) * p = n * p - m * p. +(** ** Commutativity *) + +Lemma mult_comm : forall n m, n * m = m * n. Proof. -intros; pattern n, m in |- *; apply nat_double_ind; simpl in |- *; intros; - auto with arith. -elim minus_plus_simpl_l_reverse; auto with arith. +intros; elim n; intros; simpl in |- *; auto with arith. +elim mult_n_Sm. +elim H; apply plus_comm. Qed. -Hint Resolve mult_minus_distr_r: arith v62. +Hint Resolve mult_comm: arith v62. -(** Associativity *) +(** ** Distributivity *) -Lemma mult_assoc_reverse : forall n m p, n * m * p = n * (m * p). +Lemma mult_plus_distr_r : forall n m p, (n + m) * p = n * p + m * p. Proof. -intros; elim n; intros; simpl in |- *; auto with arith. -rewrite mult_plus_distr_r. -elim H; auto with arith. + intros; elim n; simpl in |- *; intros; auto with arith. + elim plus_assoc; elim H; auto with arith. Qed. -Hint Resolve mult_assoc_reverse: arith v62. +Hint Resolve mult_plus_distr_r: arith v62. -Lemma mult_assoc : forall n m p, n * (m * p) = n * m * p. +Lemma mult_plus_distr_l : forall n m p, n * (m + p) = n * m + n * p. Proof. -auto with arith. + induction n. trivial. + intros. simpl in |- *. rewrite (IHn m p). apply sym_eq. apply plus_permute_2_in_4. Qed. -Hint Resolve mult_assoc: arith v62. -(** Commutativity *) +Lemma mult_minus_distr_r : forall n m p, (n - m) * p = n * p - m * p. +Proof. + intros; pattern n, m in |- *; apply nat_double_ind; simpl in |- *; intros; + auto with arith. + elim minus_plus_simpl_l_reverse; auto with arith. +Qed. +Hint Resolve mult_minus_distr_r: arith v62. -Lemma mult_comm : forall n m, n * m = m * n. +Lemma mult_minus_distr_l : forall n m p, n * (m - p) = n * m - n * p. Proof. -intros; elim n; intros; simpl in |- *; auto with arith. -elim mult_n_Sm. -elim H; apply plus_comm. + intros n m p. rewrite mult_comm. rewrite mult_minus_distr_r. + rewrite (mult_comm m n); rewrite (mult_comm p n); reflexivity. Qed. -Hint Resolve mult_comm: arith v62. +Hint Resolve mult_minus_distr_l: arith v62. -(** 1 is neutral *) +(** ** Associativity *) -Lemma mult_1_l : forall n, 1 * n = n. +Lemma mult_assoc_reverse : forall n m p, n * m * p = n * (m * p). Proof. -simpl in |- *; auto with arith. + intros; elim n; intros; simpl in |- *; auto with arith. + rewrite mult_plus_distr_r. + elim H; auto with arith. Qed. -Hint Resolve mult_1_l: arith v62. +Hint Resolve mult_assoc_reverse: arith v62. -Lemma mult_1_r : forall n, n * 1 = n. +Lemma mult_assoc : forall n m p, n * (m * p) = n * m * p. Proof. -intro; elim mult_comm; auto with arith. + auto with arith. Qed. -Hint Resolve mult_1_r: arith v62. +Hint Resolve mult_assoc: arith v62. -(** Compatibility with orders *) +(** * Compatibility with orders *) Lemma mult_O_le : forall n m, m = 0 \/ n <= m * n. Proof. -induction m; simpl in |- *; auto with arith. + induction m; simpl in |- *; auto with arith. Qed. Hint Resolve mult_O_le: arith v62. @@ -110,26 +122,27 @@ Hint Resolve mult_le_compat_l: arith. Lemma mult_le_compat_r : forall n m p, n <= m -> n * p <= m * p. -intros m n p H. -rewrite mult_comm. rewrite (mult_comm n). -auto with arith. +Proof. + intros m n p H. + rewrite mult_comm. rewrite (mult_comm n). + auto with arith. Qed. Lemma mult_le_compat : - forall n m p (q:nat), n <= m -> p <= q -> n * p <= m * q. -Proof. -intros m n p q Hmn Hpq; induction Hmn. -induction Hpq. -(* m*p<=m*p *) -apply le_n. -(* m*p<=m*m0 -> m*p<=m*(S m0) *) -rewrite <- mult_n_Sm; apply le_trans with (m * m0). -assumption. -apply le_plus_l. -(* m*p<=m0*q -> m*p<=(S m0)*q *) -simpl in |- *; apply le_trans with (m0 * q). -assumption. -apply le_plus_r. + forall n m p (q:nat), n <= m -> p <= q -> n * p <= m * q. +Proof. + intros m n p q Hmn Hpq; induction Hmn. + induction Hpq. + (* m*p<=m*p *) + apply le_n. + (* m*p<=m*m0 -> m*p<=m*(S m0) *) + rewrite <- mult_n_Sm; apply le_trans with (m * m0). + assumption. + apply le_plus_l. + (* m*p<=m0*q -> m*p<=(S m0)*q *) + simpl in |- *; apply le_trans with (m0 * q). + assumption. + apply le_plus_r. Qed. Lemma mult_S_lt_compat_l : forall n m p, m < p -> S n * m < S n * p. @@ -141,11 +154,12 @@ Qed. Hint Resolve mult_S_lt_compat_l: arith. Lemma mult_lt_compat_r : forall n m p, n < m -> 0 < p -> n * p < m * p. -intros m n p H H0. -induction p. -elim (lt_irrefl _ H0). -rewrite mult_comm. -replace (n * S p) with (S p * n); auto with arith. +Proof. + intros m n p H H0. + induction p. + elim (lt_irrefl _ H0). + rewrite mult_comm. + replace (n * S p) with (S p * n); auto with arith. Qed. Lemma mult_S_le_reg_l : forall n m p, S n * m <= S n * p -> m <= p. @@ -156,27 +170,28 @@ Proof. apply mult_S_lt_compat_l. assumption. Qed. -(** n|->2*n and n|->2n+1 have disjoint image *) +(** * n|->2*n and n|->2n+1 have disjoint image *) Theorem odd_even_lem : forall p q, 2 * p + 1 <> 2 * q. -intros p; elim p; auto. -intros q; case q; simpl in |- *. -red in |- *; intros; discriminate. -intros q'; rewrite (fun x y => plus_comm x (S y)); simpl in |- *; red in |- *; - intros; discriminate. -intros p' H q; case q. -simpl in |- *; red in |- *; intros; discriminate. -intros q'; red in |- *; intros H0; case (H q'). -replace (2 * q') with (2 * S q' - 2). -rewrite <- H0; simpl in |- *; auto. -repeat rewrite (fun x y => plus_comm x (S y)); simpl in |- *; auto. -simpl in |- *; repeat rewrite (fun x y => plus_comm x (S y)); simpl in |- *; - auto. -case q'; simpl in |- *; auto. +Proof. + intros p; elim p; auto. + intros q; case q; simpl in |- *. + red in |- *; intros; discriminate. + intros q'; rewrite (fun x y => plus_comm x (S y)); simpl in |- *; red in |- *; + intros; discriminate. + intros p' H q; case q. + simpl in |- *; red in |- *; intros; discriminate. + intros q'; red in |- *; intros H0; case (H q'). + replace (2 * q') with (2 * S q' - 2). + rewrite <- H0; simpl in |- *; auto. + repeat rewrite (fun x y => plus_comm x (S y)); simpl in |- *; auto. + simpl in |- *; repeat rewrite (fun x y => plus_comm x (S y)); simpl in |- *; + auto. + case q'; simpl in |- *; auto. Qed. -(** Tail-recursive mult *) +(** * Tail-recursive mult *) (** [tail_mult] is an alternative definition for [mult] which is tail-recursive, whereas [mult] is not. This can be useful @@ -184,23 +199,23 @@ Qed. Fixpoint mult_acc (s:nat) m n {struct n} : nat := match n with - | O => s - | S p => mult_acc (tail_plus m s) m p + | O => s + | S p => mult_acc (tail_plus m s) m p end. Lemma mult_acc_aux : forall n m p, m + n * p = mult_acc m p n. Proof. -induction n as [| p IHp]; simpl in |- *; auto. -intros s m; rewrite <- plus_tail_plus; rewrite <- IHp. -rewrite <- plus_assoc_reverse; apply (f_equal2 (A1:=nat) (A2:=nat)); auto. -rewrite plus_comm; auto. + induction n as [| p IHp]; simpl in |- *; auto. + intros s m; rewrite <- plus_tail_plus; rewrite <- IHp. + rewrite <- plus_assoc_reverse; apply (f_equal2 (A1:=nat) (A2:=nat)); auto. + rewrite plus_comm; auto. Qed. Definition tail_mult n m := mult_acc 0 m n. Lemma mult_tail_mult : forall n m, n * m = tail_mult n m. Proof. -intros; unfold tail_mult in |- *; rewrite <- mult_acc_aux; auto. + intros; unfold tail_mult in |- *; rewrite <- mult_acc_aux; auto. Qed. (** [TailSimpl] transforms any [tail_plus] and [tail_mult] into [plus] @@ -208,4 +223,4 @@ Qed. Ltac tail_simpl := repeat rewrite <- plus_tail_plus; repeat rewrite <- mult_tail_mult; - simpl in |- *.
\ No newline at end of file + simpl in |- *.
\ No newline at end of file diff --git a/theories/Arith/Peano_dec.v b/theories/Arith/Peano_dec.v index 4aef7dc0..b17021bc 100644 --- a/theories/Arith/Peano_dec.v +++ b/theories/Arith/Peano_dec.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Peano_dec.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Peano_dec.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Decidable. @@ -16,19 +16,19 @@ Implicit Types m n x y : nat. Theorem O_or_S : forall n, {m : nat | S m = n} + {0 = n}. Proof. -induction n. -auto. -left; exists n; auto. + induction n. + auto. + left; exists n; auto. Defined. Theorem eq_nat_dec : forall n m, {n = m} + {n <> m}. Proof. -induction n; induction m; auto. -elim (IHn m); auto. + induction n; induction m; auto. + elim (IHn m); auto. Defined. Hint Resolve O_or_S eq_nat_dec: arith. Theorem dec_eq_nat : forall n m, decidable (n = m). -intros x y; unfold decidable in |- *; elim (eq_nat_dec x y); auto with arith. + intros x y; unfold decidable in |- *; elim (eq_nat_dec x y); auto with arith. Defined. diff --git a/theories/Arith/Plus.v b/theories/Arith/Plus.v index 56e1c58a..74d0dc93 100644 --- a/theories/Arith/Plus.v +++ b/theories/Arith/Plus.v @@ -6,9 +6,18 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Plus.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Plus.v 9245 2006-10-17 12:53:34Z notin $ i*) -(** Properties of addition *) +(** Properties of addition. [add] is defined in [Init/Peano.v] as: +<< +Fixpoint plus (n m:nat) {struct n} : nat := + match n with + | O => m + | S p => S (p + m) + end +where "n + m" := (plus n m) : nat_scope. +>> + *) Require Import Le. Require Import Lt. @@ -17,126 +26,127 @@ Open Local Scope nat_scope. Implicit Types m n p q : nat. -(** Zero is neutral *) +(** * Zero is neutral *) Lemma plus_0_l : forall n, 0 + n = n. Proof. -reflexivity. + reflexivity. Qed. Lemma plus_0_r : forall n, n + 0 = n. Proof. -intro; symmetry in |- *; apply plus_n_O. + intro; symmetry in |- *; apply plus_n_O. Qed. -(** Commutativity *) +(** * Commutativity *) Lemma plus_comm : forall n m, n + m = m + n. Proof. -intros n m; elim n; simpl in |- *; auto with arith. -intros y H; elim (plus_n_Sm m y); auto with arith. + intros n m; elim n; simpl in |- *; auto with arith. + intros y H; elim (plus_n_Sm m y); auto with arith. Qed. Hint Immediate plus_comm: arith v62. -(** Associativity *) +(** * Associativity *) Lemma plus_Snm_nSm : forall n m, S n + m = n + S m. -intros. -simpl in |- *. -rewrite (plus_comm n m). -rewrite (plus_comm n (S m)). -trivial with arith. +Proof. + intros. + simpl in |- *. + rewrite (plus_comm n m). + rewrite (plus_comm n (S m)). + trivial with arith. Qed. Lemma plus_assoc : forall n m p, n + (m + p) = n + m + p. Proof. -intros n m p; elim n; simpl in |- *; auto with arith. + intros n m p; elim n; simpl in |- *; auto with arith. Qed. Hint Resolve plus_assoc: arith v62. Lemma plus_permute : forall n m p, n + (m + p) = m + (n + p). Proof. -intros; rewrite (plus_assoc m n p); rewrite (plus_comm m n); auto with arith. + intros; rewrite (plus_assoc m n p); rewrite (plus_comm m n); auto with arith. Qed. Lemma plus_assoc_reverse : forall n m p, n + m + p = n + (m + p). Proof. -auto with arith. + auto with arith. Qed. Hint Resolve plus_assoc_reverse: arith v62. -(** Simplification *) +(** * Simplification *) Lemma plus_reg_l : forall n m p, p + n = p + m -> n = m. Proof. -intros m p n; induction n; simpl in |- *; auto with arith. + intros m p n; induction n; simpl in |- *; auto with arith. Qed. Lemma plus_le_reg_l : forall n m p, p + n <= p + m -> n <= m. Proof. -induction p; simpl in |- *; auto with arith. + induction p; simpl in |- *; auto with arith. Qed. Lemma plus_lt_reg_l : forall n m p, p + n < p + m -> n < m. Proof. -induction p; simpl in |- *; auto with arith. + induction p; simpl in |- *; auto with arith. Qed. -(** Compatibility with order *) +(** * Compatibility with order *) Lemma plus_le_compat_l : forall n m p, n <= m -> p + n <= p + m. Proof. -induction p; simpl in |- *; auto with arith. + induction p; simpl in |- *; auto with arith. Qed. Hint Resolve plus_le_compat_l: arith v62. Lemma plus_le_compat_r : forall n m p, n <= m -> n + p <= m + p. Proof. -induction 1; simpl in |- *; auto with arith. + induction 1; simpl in |- *; auto with arith. Qed. Hint Resolve plus_le_compat_r: arith v62. Lemma le_plus_l : forall n m, n <= n + m. Proof. -induction n; simpl in |- *; auto with arith. + induction n; simpl in |- *; auto with arith. Qed. Hint Resolve le_plus_l: arith v62. Lemma le_plus_r : forall n m, m <= n + m. Proof. -intros n m; elim n; simpl in |- *; auto with arith. + intros n m; elim n; simpl in |- *; auto with arith. Qed. Hint Resolve le_plus_r: arith v62. Theorem le_plus_trans : forall n m p, n <= m -> n <= m + p. Proof. -intros; apply le_trans with (m := m); auto with arith. + intros; apply le_trans with (m := m); auto with arith. Qed. Hint Resolve le_plus_trans: arith v62. Theorem lt_plus_trans : forall n m p, n < m -> n < m + p. Proof. -intros; apply lt_le_trans with (m := m); auto with arith. + intros; apply lt_le_trans with (m := m); auto with arith. Qed. Hint Immediate lt_plus_trans: arith v62. Lemma plus_lt_compat_l : forall n m p, n < m -> p + n < p + m. Proof. -induction p; simpl in |- *; auto with arith. + induction p; simpl in |- *; auto with arith. Qed. Hint Resolve plus_lt_compat_l: arith v62. Lemma plus_lt_compat_r : forall n m p, n < m -> n + p < m + p. Proof. -intros n m p H; rewrite (plus_comm n p); rewrite (plus_comm m p). -elim p; auto with arith. + intros n m p H; rewrite (plus_comm n p); rewrite (plus_comm m p). + elim p; auto with arith. Qed. Hint Resolve plus_lt_compat_r: arith v62. Lemma plus_le_compat : forall n m p q, n <= m -> p <= q -> n + p <= m + q. Proof. -intros n m p q H H0. -elim H; simpl in |- *; auto with arith. + intros n m p q H H0. + elim H; simpl in |- *; auto with arith. Qed. Lemma plus_le_lt_compat : forall n m p q, n <= m -> p < q -> n + p < m + q. @@ -156,7 +166,7 @@ Proof. apply lt_le_weak. assumption. Qed. -(** Inversion lemmas *) +(** * Inversion lemmas *) Lemma plus_is_O : forall n m, n + m = 0 -> n = 0 /\ m = 0. Proof. @@ -173,7 +183,7 @@ Proof. simpl in H. discriminate H. Defined. -(** Derived properties *) +(** * Derived properties *) Lemma plus_permute_2_in_4 : forall n m p q, n + m + (p + q) = n + p + (m + q). Proof. @@ -182,7 +192,7 @@ Proof. rewrite (plus_comm n p). rewrite <- (plus_assoc p n q). apply plus_assoc. Qed. -(** Tail-recursive plus *) +(** * Tail-recursive plus *) (** [tail_plus] is an alternative definition for [plus] which is tail-recursive, whereas [plus] is not. This can be useful @@ -190,8 +200,8 @@ Qed. Fixpoint plus_acc q n {struct n} : nat := match n with - | O => q - | S p => plus_acc (S q) p + | O => q + | S p => plus_acc (S q) p end. Definition tail_plus n m := plus_acc m n. @@ -201,27 +211,27 @@ unfold tail_plus in |- *; induction n as [| n IHn]; simpl in |- *; auto. intro m; rewrite <- IHn; simpl in |- *; auto. Qed. -(** Discrimination *) +(** * Discrimination *) Lemma succ_plus_discr : forall n m, n <> S (plus m n). Proof. -intros n m; induction n as [|n IHn]. - discriminate. - intro H; apply IHn; apply eq_add_S; rewrite H; rewrite <- plus_n_Sm; - reflexivity. + intros n m; induction n as [|n IHn]. + discriminate. + intro H; apply IHn; apply eq_add_S; rewrite H; rewrite <- plus_n_Sm; + reflexivity. Qed. Lemma n_SSn : forall n, n <> S (S n). Proof. -intro n; exact (succ_plus_discr n 1). + intro n; exact (succ_plus_discr n 1). Qed. Lemma n_SSSn : forall n, n <> S (S (S n)). Proof. -intro n; exact (succ_plus_discr n 2). + intro n; exact (succ_plus_discr n 2). Qed. Lemma n_SSSSn : forall n, n <> S (S (S (S n))). Proof. -intro n; exact (succ_plus_discr n 3). + intro n; exact (succ_plus_discr n 3). Qed. diff --git a/theories/Arith/Wf_nat.v b/theories/Arith/Wf_nat.v index e1bbfad9..11fcd161 100644 --- a/theories/Arith/Wf_nat.v +++ b/theories/Arith/Wf_nat.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Wf_nat.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Wf_nat.v 9341 2006-11-06 13:08:10Z notin $ i*) (** Well-founded relations and natural numbers *) @@ -18,7 +18,7 @@ Implicit Types m n p : nat. Section Well_founded_Nat. -Variable A : Set. +Variable A : Type. Variable f : A -> nat. Definition ltof (a b:A) := f a < f b. @@ -26,21 +26,21 @@ Definition gtof (a b:A) := f b > f a. Theorem well_founded_ltof : well_founded ltof. Proof. -red in |- *. -cut (forall n (a:A), f a < n -> Acc ltof a). -intros H a; apply (H (S (f a))); auto with arith. -induction n. -intros; absurd (f a < 0); auto with arith. -intros a ltSma. -apply Acc_intro. -unfold ltof in |- *; intros b ltfafb. -apply IHn. -apply lt_le_trans with (f a); auto with arith. + red in |- *. + cut (forall n (a:A), f a < n -> Acc ltof a). + intros H a; apply (H (S (f a))); auto with arith. + induction n. + intros; absurd (f a < 0); auto with arith. + intros a ltSma. + apply Acc_intro. + unfold ltof in |- *; intros b ltfafb. + apply IHn. + apply lt_le_trans with (f a); auto with arith. Defined. Theorem well_founded_gtof : well_founded gtof. Proof. -exact well_founded_ltof. + exact well_founded_ltof. Defined. (** It is possible to directly prove the induction principle going @@ -48,52 +48,55 @@ Defined. or to use the previous lemmas to extract a program with a fixpoint ([induction_ltof2]) -the ML-like program for [induction_ltof1] is : [[ +the ML-like program for [induction_ltof1] is : +[[ let induction_ltof1 F a = indrec ((f a)+1) a where rec indrec = function 0 -> (function a -> error) |(S m) -> (function a -> (F a (function y -> indrec y m)));; ]] -the ML-like program for [induction_ltof2] is : [[ +the ML-like program for [induction_ltof2] is : +[[ let induction_ltof2 F a = indrec a where rec indrec a = F a indrec;; -]] *) +]] +*) Theorem induction_ltof1 : - forall P:A -> Set, - (forall x:A, (forall y:A, ltof y x -> P y) -> P x) -> forall a:A, P a. -Proof. -intros P F; cut (forall n (a:A), f a < n -> P a). -intros H a; apply (H (S (f a))); auto with arith. -induction n. -intros; absurd (f a < 0); auto with arith. -intros a ltSma. -apply F. -unfold ltof in |- *; intros b ltfafb. -apply IHn. -apply lt_le_trans with (f a); auto with arith. + forall P:A -> Set, + (forall x:A, (forall y:A, ltof y x -> P y) -> P x) -> forall a:A, P a. +Proof. + intros P F; cut (forall n (a:A), f a < n -> P a). + intros H a; apply (H (S (f a))); auto with arith. + induction n. + intros; absurd (f a < 0); auto with arith. + intros a ltSma. + apply F. + unfold ltof in |- *; intros b ltfafb. + apply IHn. + apply lt_le_trans with (f a); auto with arith. Defined. Theorem induction_gtof1 : - forall P:A -> Set, - (forall x:A, (forall y:A, gtof y x -> P y) -> P x) -> forall a:A, P a. + forall P:A -> Set, + (forall x:A, (forall y:A, gtof y x -> P y) -> P x) -> forall a:A, P a. Proof. -exact induction_ltof1. + exact induction_ltof1. Defined. Theorem induction_ltof2 : - forall P:A -> Set, - (forall x:A, (forall y:A, ltof y x -> P y) -> P x) -> forall a:A, P a. + forall P:A -> Set, + (forall x:A, (forall y:A, ltof y x -> P y) -> P x) -> forall a:A, P a. Proof. -exact (well_founded_induction well_founded_ltof). + exact (well_founded_induction well_founded_ltof). Defined. Theorem induction_gtof2 : - forall P:A -> Set, - (forall x:A, (forall y:A, gtof y x -> P y) -> P x) -> forall a:A, P a. + forall P:A -> Set, + (forall x:A, (forall y:A, gtof y x -> P y) -> P x) -> forall a:A, P a. Proof. -exact induction_ltof2. + exact induction_ltof2. Defined. (** If a relation [R] is compatible with [lt] i.e. if [x R y => f(x) < f(y)] @@ -105,105 +108,105 @@ Hypothesis H_compat : forall x y:A, R x y -> f x < f y. Theorem well_founded_lt_compat : well_founded R. Proof. -red in |- *. -cut (forall n (a:A), f a < n -> Acc R a). -intros H a; apply (H (S (f a))); auto with arith. -induction n. -intros; absurd (f a < 0); auto with arith. -intros a ltSma. -apply Acc_intro. -intros b ltfafb. -apply IHn. -apply lt_le_trans with (f a); auto with arith. + red in |- *. + cut (forall n (a:A), f a < n -> Acc R a). + intros H a; apply (H (S (f a))); auto with arith. + induction n. + intros; absurd (f a < 0); auto with arith. + intros a ltSma. + apply Acc_intro. + intros b ltfafb. + apply IHn. + apply lt_le_trans with (f a); auto with arith. Defined. End Well_founded_Nat. Lemma lt_wf : well_founded lt. Proof. -exact (well_founded_ltof nat (fun m => m)). + exact (well_founded_ltof nat (fun m => m)). Defined. Lemma lt_wf_rec1 : - forall n (P:nat -> Set), (forall n, (forall m, m < n -> P m) -> P n) -> P n. + forall n (P:nat -> Set), (forall n, (forall m, m < n -> P m) -> P n) -> P n. Proof. -exact (fun p P F => induction_ltof1 nat (fun m => m) P F p). + exact (fun p P F => induction_ltof1 nat (fun m => m) P F p). Defined. Lemma lt_wf_rec : - forall n (P:nat -> Set), (forall n, (forall m, m < n -> P m) -> P n) -> P n. + forall n (P:nat -> Set), (forall n, (forall m, m < n -> P m) -> P n) -> P n. Proof. -exact (fun p P F => induction_ltof2 nat (fun m => m) P F p). + exact (fun p P F => induction_ltof2 nat (fun m => m) P F p). Defined. Lemma lt_wf_ind : - forall n (P:nat -> Prop), (forall n, (forall m, m < n -> P m) -> P n) -> P n. + forall n (P:nat -> Prop), (forall n, (forall m, m < n -> P m) -> P n) -> P n. Proof. -intro p; intros; elim (lt_wf p); auto with arith. + intro p; intros; elim (lt_wf p); auto with arith. Qed. Lemma gt_wf_rec : - forall n (P:nat -> Set), (forall n, (forall m, n > m -> P m) -> P n) -> P n. + forall n (P:nat -> Set), (forall n, (forall m, n > m -> P m) -> P n) -> P n. Proof. -exact lt_wf_rec. + exact lt_wf_rec. Defined. Lemma gt_wf_ind : - forall n (P:nat -> Prop), (forall n, (forall m, n > m -> P m) -> P n) -> P n. + forall n (P:nat -> Prop), (forall n, (forall m, n > m -> P m) -> P n) -> P n. Proof lt_wf_ind. Lemma lt_wf_double_rec : forall P:nat -> nat -> Set, (forall n m, - (forall p q, p < n -> P p q) -> - (forall p, p < m -> P n p) -> P n m) -> forall n m, P n m. + (forall p q, p < n -> P p q) -> + (forall p, p < m -> P n p) -> P n m) -> forall n m, P n m. Proof. -intros P Hrec p; pattern p in |- *; apply lt_wf_rec. -intros n H q; pattern q in |- *; apply lt_wf_rec; auto with arith. + intros P Hrec p; pattern p in |- *; apply lt_wf_rec. + intros n H q; pattern q in |- *; apply lt_wf_rec; auto with arith. Defined. Lemma lt_wf_double_ind : - forall P:nat -> nat -> Prop, - (forall n m, + forall P:nat -> nat -> Prop, + (forall n m, (forall p (q:nat), p < n -> P p q) -> (forall p, p < m -> P n p) -> P n m) -> forall n m, P n m. Proof. -intros P Hrec p; pattern p in |- *; apply lt_wf_ind. -intros n H q; pattern q in |- *; apply lt_wf_ind; auto with arith. + intros P Hrec p; pattern p in |- *; apply lt_wf_ind. + intros n H q; pattern q in |- *; apply lt_wf_ind; auto with arith. Qed. Hint Resolve lt_wf: arith. Hint Resolve well_founded_lt_compat: arith. Section LT_WF_REL. -Variable A : Set. -Variable R : A -> A -> Prop. - -(* Relational form of inversion *) -Variable F : A -> nat -> Prop. -Definition inv_lt_rel x y := exists2 n, F x n & (forall m, F y m -> n < m). - -Hypothesis F_compat : forall x y:A, R x y -> inv_lt_rel x y. -Remark acc_lt_rel : forall x:A, (exists n, F x n) -> Acc R x. -Proof. -intros x [n fxn]; generalize dependent x. -pattern n in |- *; apply lt_wf_ind; intros. -constructor; intros. -destruct (F_compat y x) as (x0,H1,H2); trivial. -apply (H x0); auto. -Qed. - -Theorem well_founded_inv_lt_rel_compat : well_founded R. -Proof. -constructor; intros. -case (F_compat y a); trivial; intros. -apply acc_lt_rel; trivial. -exists x; trivial. -Qed. + Variable A : Set. + Variable R : A -> A -> Prop. + + (* Relational form of inversion *) + Variable F : A -> nat -> Prop. + Definition inv_lt_rel x y := exists2 n, F x n & (forall m, F y m -> n < m). + + Hypothesis F_compat : forall x y:A, R x y -> inv_lt_rel x y. + Remark acc_lt_rel : forall x:A, (exists n, F x n) -> Acc R x. + Proof. + intros x [n fxn]; generalize dependent x. + pattern n in |- *; apply lt_wf_ind; intros. + constructor; intros. + destruct (F_compat y x) as (x0,H1,H2); trivial. + apply (H x0); auto. + Qed. + + Theorem well_founded_inv_lt_rel_compat : well_founded R. + Proof. + constructor; intros. + case (F_compat y a); trivial; intros. + apply acc_lt_rel; trivial. + exists x; trivial. + Qed. End LT_WF_REL. Lemma well_founded_inv_rel_inv_lt_rel : - forall (A:Set) (F:A -> nat -> Prop), well_founded (inv_lt_rel A F). -intros; apply (well_founded_inv_lt_rel_compat A (inv_lt_rel A F) F); trivial. + forall (A:Set) (F:A -> nat -> Prop), well_founded (inv_lt_rel A F). + intros; apply (well_founded_inv_lt_rel_compat A (inv_lt_rel A F) F); trivial. Qed. diff --git a/theories/Bool/Bool.v b/theories/Bool/Bool.v index ff87eb96..e126ad35 100644 --- a/theories/Bool/Bool.v +++ b/theories/Bool/Bool.v @@ -6,9 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Bool.v 8642 2006-03-17 10:09:02Z notin $ i*) - -(** ** Booleans *) +(*i $Id: Bool.v 9246 2006-10-17 14:01:18Z herbelin $ i*) (** The type [bool] is defined in the prelude as [Inductive bool : Set := true : bool | false : bool] *) @@ -16,34 +14,34 @@ (** Interpretation of booleans as propositions *) Definition Is_true (b:bool) := match b with - | true => True - | false => False + | true => True + | false => False end. -(*****************) -(** Decidability *) -(*****************) +(*******************) +(** * Decidability *) +(*******************) Lemma bool_dec : forall b1 b2 : bool, {b1 = b2} + {b1 <> b2}. Proof. decide equality. Defined. -(*******************) -(** Discrimination *) -(*******************) +(*********************) +(** * Discrimination *) +(*********************) Lemma diff_true_false : true <> false. Proof. -unfold not in |- *; intro contr; change (Is_true false) in |- *. -elim contr; simpl in |- *; trivial. + unfold not in |- *; intro contr; change (Is_true false) in |- *. + elim contr; simpl in |- *; trivial. Qed. Hint Resolve diff_true_false : bool v62. Lemma diff_false_true : false <> true. Proof. -red in |- *; intros H; apply diff_true_false. -symmetry in |- *. + red in |- *; intros H; apply diff_true_false. + symmetry in |- *. assumption. Qed. Hint Resolve diff_false_true : bool v62. @@ -51,92 +49,92 @@ Hint Extern 1 (false <> true) => exact diff_false_true. Lemma eq_true_false_abs : forall b:bool, b = true -> b = false -> False. Proof. -intros b H; rewrite H; auto with bool. + intros b H; rewrite H; auto with bool. Qed. Lemma not_true_is_false : forall b:bool, b <> true -> b = false. Proof. -destruct b. -intros. -red in H; elim H. -reflexivity. -intros abs. -reflexivity. + destruct b. + intros. + red in H; elim H. + reflexivity. + intros abs. + reflexivity. Qed. Lemma not_false_is_true : forall b:bool, b <> false -> b = true. Proof. -destruct b. -intros. -reflexivity. -intro H; red in H; elim H. -reflexivity. + destruct b. + intros. + reflexivity. + intro H; red in H; elim H. + reflexivity. Qed. (**********************) -(** Order on booleans *) +(** * Order on booleans *) (**********************) Definition leb (b1 b2:bool) := match b1 with - | true => b2 = true - | false => True + | true => b2 = true + | false => True end. Hint Unfold leb: bool v62. (* Infix "<=" := leb : bool_scope. *) (*************) -(** Equality *) +(** * Equality *) (*************) Definition eqb (b1 b2:bool) : bool := match b1, b2 with - | true, true => true - | true, false => false - | false, true => false - | false, false => true + | true, true => true + | true, false => false + | false, true => false + | false, false => true end. Lemma eqb_subst : - forall (P:bool -> Prop) (b1 b2:bool), eqb b1 b2 = true -> P b1 -> P b2. -Proof. -unfold eqb in |- *. -intros P b1. -intros b2. -case b1. -case b2. -trivial with bool. -intros H. -inversion_clear H. -case b2. -intros H. -inversion_clear H. -trivial with bool. + forall (P:bool -> Prop) (b1 b2:bool), eqb b1 b2 = true -> P b1 -> P b2. +Proof. + unfold eqb in |- *. + intros P b1. + intros b2. + case b1. + case b2. + trivial with bool. + intros H. + inversion_clear H. + case b2. + intros H. + inversion_clear H. + trivial with bool. Qed. Lemma eqb_reflx : forall b:bool, eqb b b = true. Proof. -intro b. -case b. -trivial with bool. -trivial with bool. + intro b. + case b. + trivial with bool. + trivial with bool. Qed. Lemma eqb_prop : forall a b:bool, eqb a b = true -> a = b. Proof. -destruct a; destruct b; simpl in |- *; intro; discriminate H || reflexivity. + destruct a; destruct b; simpl in |- *; intro; discriminate H || reflexivity. Qed. (************************) -(** Logical combinators *) +(** * Logical combinators *) (************************) Definition ifb (b1 b2 b3:bool) : bool := match b1 with - | true => b2 - | false => b3 + | true => b2 + | false => b3 end. Definition andb (b1 b2:bool) : bool := ifb b1 b2 false. @@ -147,10 +145,10 @@ Definition implb (b1 b2:bool) : bool := ifb b1 b2 true. Definition xorb (b1 b2:bool) : bool := match b1, b2 with - | true, true => false - | true, false => true - | false, true => true - | false, false => false + | true, true => false + | true, false => true + | false, true => true + | false, false => false end. Definition negb (b:bool) := if b then false else true. @@ -165,7 +163,7 @@ Delimit Scope bool_scope with bool. Bind Scope bool_scope with bool. (****************************) -(** De Morgan laws *) +(** * De Morgan laws *) (****************************) Lemma negb_orb : forall b1 b2:bool, negb (b1 || b2) = negb b1 && negb b2. @@ -179,17 +177,17 @@ Proof. Qed. (********************************) -(** *** Properties of [negb] *) +(** * Properties of [negb] *) (********************************) Lemma negb_involutive : forall b:bool, negb (negb b) = b. Proof. -destruct b; reflexivity. + destruct b; reflexivity. Qed. Lemma negb_involutive_reverse : forall b:bool, b = negb (negb b). Proof. -destruct b; reflexivity. + destruct b; reflexivity. Qed. Notation negb_elim := negb_involutive (only parsing). @@ -197,68 +195,68 @@ Notation negb_intro := negb_involutive_reverse (only parsing). Lemma negb_sym : forall b b':bool, b' = negb b -> b = negb b'. Proof. -destruct b; destruct b'; intros; simpl in |- *; trivial with bool. + destruct b; destruct b'; intros; simpl in |- *; trivial with bool. Qed. Lemma no_fixpoint_negb : forall b:bool, negb b <> b. Proof. -destruct b; simpl in |- *; intro; apply diff_true_false; - auto with bool. + destruct b; simpl in |- *; intro; apply diff_true_false; + auto with bool. Qed. Lemma eqb_negb1 : forall b:bool, eqb (negb b) b = false. Proof. -destruct b. -trivial with bool. -trivial with bool. + destruct b. + trivial with bool. + trivial with bool. Qed. Lemma eqb_negb2 : forall b:bool, eqb b (negb b) = false. Proof. -destruct b. -trivial with bool. -trivial with bool. + destruct b. + trivial with bool. + trivial with bool. Qed. Lemma if_negb : - forall (A:Set) (b:bool) (x y:A), - (if negb b then x else y) = (if b then y else x). + forall (A:Set) (b:bool) (x y:A), + (if negb b then x else y) = (if b then y else x). Proof. destruct b; trivial. Qed. (********************************) -(** *** Properties of [orb] *) +(** * Properties of [orb] *) (********************************) Lemma orb_true_elim : forall b1 b2:bool, b1 || b2 = true -> {b1 = true} + {b2 = true}. Proof. -destruct b1; simpl in |- *; auto with bool. + destruct b1; simpl in |- *; auto with bool. Defined. Lemma orb_prop : forall a b:bool, a || b = true -> a = true \/ b = true. Proof. -destruct a; destruct b; simpl in |- *; try (intro H; discriminate H); - auto with bool. + destruct a; destruct b; simpl in |- *; try (intro H; discriminate H); + auto with bool. Qed. Lemma orb_true_intro : - forall b1 b2:bool, b1 = true \/ b2 = true -> b1 || b2 = true. + forall b1 b2:bool, b1 = true \/ b2 = true -> b1 || b2 = true. Proof. -destruct b1; auto with bool. -destruct 1; intros. -elim diff_true_false; auto with bool. -rewrite H; trivial with bool. + destruct b1; auto with bool. + destruct 1; intros. + elim diff_true_false; auto with bool. + rewrite H; trivial with bool. Qed. Hint Resolve orb_true_intro: bool v62. Lemma orb_false_intro : - forall b1 b2:bool, b1 = false -> b2 = false -> b1 || b2 = false. + forall b1 b2:bool, b1 = false -> b2 = false -> b1 || b2 = false. Proof. -intros b1 b2 H1 H2; rewrite H1; rewrite H2; trivial with bool. + intros b1 b2 H1 H2; rewrite H1; rewrite H2; trivial with bool. Qed. Hint Resolve orb_false_intro: bool v62. @@ -266,13 +264,13 @@ Hint Resolve orb_false_intro: bool v62. Lemma orb_true_r : forall b:bool, b || true = true. Proof. -auto with bool. + auto with bool. Qed. Hint Resolve orb_true_r: bool v62. Lemma orb_true_l : forall b:bool, true || b = true. Proof. -trivial with bool. + trivial with bool. Qed. Notation orb_b_true := orb_true_r (only parsing). @@ -296,7 +294,7 @@ Notation orb_b_false := orb_false_r (only parsing). Notation orb_false_b := orb_false_l (only parsing). Lemma orb_false_elim : - forall b1 b2:bool, b1 || b2 = false -> b1 = false /\ b2 = false. + forall b1 b2:bool, b1 || b2 = false -> b1 = false /\ b2 = false. Proof. destruct b1. intros; elim diff_true_false; auto with bool. @@ -319,7 +317,7 @@ Notation orb_neg_b := orb_negb_r (only parsing). Lemma orb_comm : forall b1 b2:bool, b1 || b2 = b2 || b1. Proof. -destruct b1; destruct b2; reflexivity. + destruct b1; destruct b2; reflexivity. Qed. (** Associativity *) @@ -330,14 +328,14 @@ Proof. Qed. Hint Resolve orb_comm orb_assoc: bool v62. -(*********************************) -(** *** Properties of [andb] *) -(*********************************) +(*******************************) +(** * Properties of [andb] *) +(*******************************) Lemma andb_prop : forall a b:bool, a && b = true -> a = true /\ b = true. Proof. destruct a; destruct b; simpl in |- *; try (intro H; discriminate H); - auto with bool. + auto with bool. Qed. Hint Resolve andb_prop: bool v62. @@ -348,7 +346,7 @@ Proof. Defined. Lemma andb_true_intro : - forall b1 b2:bool, b1 = true /\ b2 = true -> b1 && b2 = true. + forall b1 b2:bool, b1 = true /\ b2 = true -> b1 && b2 = true. Proof. destruct b1; destruct b2; simpl in |- *; tauto || auto with bool. Qed. @@ -356,24 +354,24 @@ Hint Resolve andb_true_intro: bool v62. Lemma andb_false_intro1 : forall b1 b2:bool, b1 = false -> b1 && b2 = false. Proof. -destruct b1; destruct b2; simpl in |- *; tauto || auto with bool. + destruct b1; destruct b2; simpl in |- *; tauto || auto with bool. Qed. Lemma andb_false_intro2 : forall b1 b2:bool, b2 = false -> b1 && b2 = false. Proof. -destruct b1; destruct b2; simpl in |- *; tauto || auto with bool. + destruct b1; destruct b2; simpl in |- *; tauto || auto with bool. Qed. (** [false] is a zero for [andb] *) Lemma andb_false_r : forall b:bool, b && false = false. Proof. -destruct b; auto with bool. + destruct b; auto with bool. Qed. Lemma andb_false_l : forall b:bool, false && b = false. Proof. -trivial with bool. + trivial with bool. Qed. Notation andb_b_false := andb_false_r (only parsing). @@ -383,12 +381,12 @@ Notation andb_false_b := andb_false_l (only parsing). Lemma andb_true_r : forall b:bool, b && true = b. Proof. -destruct b; auto with bool. + destruct b; auto with bool. Qed. Lemma andb_true_l : forall b:bool, true && b = b. Proof. -trivial with bool. + trivial with bool. Qed. Notation andb_b_true := andb_true_r (only parsing). @@ -397,7 +395,7 @@ Notation andb_true_b := andb_true_l (only parsing). Lemma andb_false_elim : forall b1 b2:bool, b1 && b2 = false -> {b1 = false} + {b2 = false}. Proof. -destruct b1; simpl in |- *; auto with bool. + destruct b1; simpl in |- *; auto with bool. Defined. Hint Resolve andb_false_elim: bool v62. @@ -405,7 +403,7 @@ Hint Resolve andb_false_elim: bool v62. Lemma andb_negb_r : forall b:bool, b && negb b = false. Proof. -destruct b; reflexivity. + destruct b; reflexivity. Qed. Hint Resolve andb_negb_r: bool v62. @@ -415,46 +413,46 @@ Notation andb_neg_b := andb_negb_r (only parsing). Lemma andb_comm : forall b1 b2:bool, b1 && b2 = b2 && b1. Proof. -destruct b1; destruct b2; reflexivity. + destruct b1; destruct b2; reflexivity. Qed. (** Associativity *) Lemma andb_assoc : forall b1 b2 b3:bool, b1 && (b2 && b3) = b1 && b2 && b3. Proof. -destruct b1; destruct b2; destruct b3; reflexivity. + destruct b1; destruct b2; destruct b3; reflexivity. Qed. Hint Resolve andb_comm andb_assoc: bool v62. (*******************************************) -(** *** Properties mixing [andb] and [orb] *) +(** * Properties mixing [andb] and [orb] *) (*******************************************) (** Distributivity *) Lemma andb_orb_distrib_r : - forall b1 b2 b3:bool, b1 && (b2 || b3) = b1 && b2 || b1 && b3. + forall b1 b2 b3:bool, b1 && (b2 || b3) = b1 && b2 || b1 && b3. Proof. -destruct b1; destruct b2; destruct b3; reflexivity. + destruct b1; destruct b2; destruct b3; reflexivity. Qed. Lemma andb_orb_distrib_l : forall b1 b2 b3:bool, (b1 || b2) && b3 = b1 && b3 || b2 && b3. Proof. -destruct b1; destruct b2; destruct b3; reflexivity. + destruct b1; destruct b2; destruct b3; reflexivity. Qed. Lemma orb_andb_distrib_r : - forall b1 b2 b3:bool, b1 || b2 && b3 = (b1 || b2) && (b1 || b3). + forall b1 b2 b3:bool, b1 || b2 && b3 = (b1 || b2) && (b1 || b3). Proof. -destruct b1; destruct b2; destruct b3; reflexivity. + destruct b1; destruct b2; destruct b3; reflexivity. Qed. Lemma orb_andb_distrib_l : - forall b1 b2 b3:bool, b1 && b2 || b3 = (b1 || b3) && (b2 || b3). + forall b1 b2 b3:bool, b1 && b2 || b3 = (b1 || b3) && (b2 || b3). Proof. -destruct b1; destruct b2; destruct b3; reflexivity. + destruct b1; destruct b2; destruct b3; reflexivity. Qed. (* Compatibility *) @@ -475,46 +473,64 @@ Proof. destruct b1; destruct b2; simpl in |- *; reflexivity. Qed. -(***********************************) -(** *** Properties of [xorb] *) -(***********************************) +(*********************************) +(** * Properties of [xorb] *) +(*********************************) -Lemma xorb_false : forall b:bool, xorb b false = b. +(** [false] is neutral for [xorb] *) + +Lemma xorb_false_r : forall b:bool, xorb b false = b. Proof. destruct b; trivial. Qed. -Lemma false_xorb : forall b:bool, xorb false b = b. +Lemma xorb_false_l : forall b:bool, xorb false b = b. Proof. destruct b; trivial. Qed. -Lemma xorb_true : forall b:bool, xorb b true = negb b. +Notation xorb_false := xorb_false_r (only parsing). +Notation false_xorb := xorb_false_l (only parsing). + +(** [true] is "complementing" for [xorb] *) + +Lemma xorb_true_r : forall b:bool, xorb b true = negb b. Proof. trivial. Qed. -Lemma true_xorb : forall b:bool, xorb true b = negb b. +Lemma xorb_true_l : forall b:bool, xorb true b = negb b. Proof. destruct b; trivial. Qed. +Notation xorb_true := xorb_true_r (only parsing). +Notation true_xorb := xorb_true_l (only parsing). + +(** Nilpotency (alternatively: identity is a inverse for [xorb]) *) + Lemma xorb_nilpotent : forall b:bool, xorb b b = false. Proof. destruct b; trivial. Qed. +(** Commutativity *) + Lemma xorb_comm : forall b b':bool, xorb b b' = xorb b' b. Proof. destruct b; destruct b'; trivial. Qed. -Lemma xorb_assoc : - forall b b' b'':bool, xorb (xorb b b') b'' = xorb b (xorb b' b''). +(** Associativity *) + +Lemma xorb_assoc_reverse : + forall b b' b'':bool, xorb (xorb b b') b'' = xorb b (xorb b' b''). Proof. destruct b; destruct b'; destruct b''; trivial. Qed. +Notation xorb_assoc := xorb_assoc_reverse (only parsing). (* Compatibility *) + Lemma xorb_eq : forall b b':bool, xorb b b' = false -> b = b'. Proof. destruct b; destruct b'; trivial. @@ -522,26 +538,26 @@ Proof. Qed. Lemma xorb_move_l_r_1 : - forall b b' b'':bool, xorb b b' = b'' -> b' = xorb b b''. + forall b b' b'':bool, xorb b b' = b'' -> b' = xorb b b''. Proof. intros. rewrite <- (false_xorb b'). rewrite <- (xorb_nilpotent b). rewrite xorb_assoc. rewrite H. reflexivity. Qed. Lemma xorb_move_l_r_2 : - forall b b' b'':bool, xorb b b' = b'' -> b = xorb b'' b'. + forall b b' b'':bool, xorb b b' = b'' -> b = xorb b'' b'. Proof. intros. rewrite xorb_comm in H. rewrite (xorb_move_l_r_1 b' b b'' H). apply xorb_comm. Qed. Lemma xorb_move_r_l_1 : - forall b b' b'':bool, b = xorb b' b'' -> xorb b' b = b''. + forall b b' b'':bool, b = xorb b' b'' -> xorb b' b = b''. Proof. intros. rewrite H. rewrite <- xorb_assoc. rewrite xorb_nilpotent. apply false_xorb. Qed. Lemma xorb_move_r_l_2 : - forall b b' b'':bool, b = xorb b' b'' -> xorb b b'' = b'. + forall b b' b'':bool, b = xorb b' b'' -> xorb b b'' = b'. Proof. intros. rewrite H. rewrite xorb_assoc. rewrite xorb_nilpotent. apply xorb_false. Qed. @@ -550,24 +566,24 @@ Qed. Lemma eq_true_iff_eq : forall b1 b2, (b1 = true <-> b2 = true) -> b1 = b2. Proof. - intros b1 b2; case b1; case b2; intuition. + intros b1 b2; case b1; case b2; intuition. Qed. -Notation bool_1 := eq_true_iff_eq. (* Compatibility *) +Notation bool_1 := eq_true_iff_eq (only parsing). (* Compatibility *) Lemma eq_true_negb_classical : forall b:bool, negb b <> true -> b = true. Proof. destruct b; intuition. Qed. -Notation bool_3 := eq_true_negb_classical. (* Compatibility *) +Notation bool_3 := eq_true_negb_classical (only parsing). (* Compatibility *) Lemma eq_true_not_negb : forall b:bool, b <> true -> negb b = true. Proof. destruct b; intuition. Qed. -Notation bool_6 := eq_true_not_negb. (* Compatibility *) +Notation bool_6 := eq_true_not_negb (only parsing). (* Compatibility *) Hint Resolve eq_true_not_negb : bool. @@ -596,7 +612,7 @@ Qed. Hint Resolve trans_eq_bool. (*****************************************) -(** *** Reflection of [bool] into [Prop] *) +(** * Reflection of [bool] into [Prop] *) (*****************************************) (** [Is_true] and equality *) @@ -605,9 +621,9 @@ Hint Unfold Is_true: bool. Lemma Is_true_eq_true : forall x:bool, Is_true x -> x = true. Proof. -destruct x; simpl in |- *; tauto. + destruct x; simpl in |- *; tauto. Qed. - + Lemma Is_true_eq_left : forall x:bool, x = true -> Is_true x. Proof. intros; rewrite H; auto with bool. @@ -635,7 +651,7 @@ Qed. (** [Is_true] and connectives *) Lemma orb_prop_elim : - forall a b:bool, Is_true (a || b) -> Is_true a \/ Is_true b. + forall a b:bool, Is_true (a || b) -> Is_true a \/ Is_true b. Proof. destruct a; destruct b; simpl; tauto. Qed. @@ -643,13 +659,13 @@ Qed. Notation orb_prop2 := orb_prop_elim (only parsing). Lemma orb_prop_intro : - forall a b:bool, Is_true a \/ Is_true b -> Is_true (a || b). + forall a b:bool, Is_true a \/ Is_true b -> Is_true (a || b). Proof. destruct a; destruct b; simpl; tauto. Qed. Lemma andb_prop_intro : - forall b1 b2:bool, Is_true b1 /\ Is_true b2 -> Is_true (b1 && b2). + forall b1 b2:bool, Is_true b1 /\ Is_true b2 -> Is_true (b1 && b2). Proof. destruct b1; destruct b2; simpl in |- *; tauto. Qed. @@ -660,42 +676,42 @@ Notation andb_true_intro2 := (only parsing). Lemma andb_prop_elim : - forall a b:bool, Is_true (a && b) -> Is_true a /\ Is_true b. + forall a b:bool, Is_true (a && b) -> Is_true a /\ Is_true b. Proof. destruct a; destruct b; simpl in |- *; try (intro H; discriminate H); - auto with bool. + auto with bool. Qed. Hint Resolve andb_prop_elim: bool v62. Notation andb_prop2 := andb_prop_elim (only parsing). Lemma eq_bool_prop_intro : - forall b1 b2, (Is_true b1 <-> Is_true b2) -> b1 = b2. + forall b1 b2, (Is_true b1 <-> Is_true b2) -> b1 = b2. Proof. - destruct b1; destruct b2; simpl in *; intuition. + destruct b1; destruct b2; simpl in *; intuition. Qed. Lemma eq_bool_prop_elim : forall b1 b2, b1 = b2 -> (Is_true b1 <-> Is_true b2). Proof. - intros b1 b2; case b1; case b2; intuition. + intros b1 b2; case b1; case b2; intuition. Qed. Lemma negb_prop_elim : forall b, Is_true (negb b) -> ~ Is_true b. Proof. - destruct b; intuition. + destruct b; intuition. Qed. Lemma negb_prop_intro : forall b, ~ Is_true b -> Is_true (negb b). Proof. - destruct b; simpl in *; intuition. + destruct b; simpl in *; intuition. Qed. Lemma negb_prop_classical : forall b, ~ Is_true (negb b) -> Is_true b. Proof. - destruct b; intuition. + destruct b; intuition. Qed. Lemma negb_prop_involutive : forall b, Is_true b -> ~ Is_true (negb b). Proof. - destruct b; intuition. + destruct b; intuition. Qed. diff --git a/theories/Bool/Bvector.v b/theories/Bool/Bvector.v index 576993c9..659630c5 100644 --- a/theories/Bool/Bvector.v +++ b/theories/Bool/Bvector.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Bvector.v 8866 2006-05-28 16:21:04Z herbelin $ i*) +(*i $Id: Bvector.v 9245 2006-10-17 12:53:34Z notin $ i*) (** Bit vectors. Contribution by Jean Duprat (ENS Lyon). *) @@ -16,34 +16,34 @@ Require Import Arith. Open Local Scope nat_scope. -(* +(** On s'inspire de List.v pour fabriquer les vecteurs de bits. -La dimension du vecteur est un paramètre trop important pour +La dimension du vecteur est un paramètre trop important pour se contenter de la fonction "length". -La première idée est de faire un record avec la liste et la longueur. +La première idée est de faire un record avec la liste et la longueur. Malheureusement, cette verification a posteriori amene a faire de nombreux lemmes pour gerer les longueurs. -La seconde idée est de faire un type dépendant dans lequel la -longueur est un paramètre de construction. Cela complique un -peu les inductions structurelles, la solution qui a ma préférence -est alors d'utiliser un terme de preuve comme définition, car le -mécanisme d'inférence du type du filtrage n'est pas aussi puissant que -celui implanté par les tactiques d'élimination. +La seconde idée est de faire un type dépendant dans lequel la +longueur est un paramètre de construction. Cela complique un +peu les inductions structurelles, la solution qui a ma préférence +est alors d'utiliser un terme de preuve comme définition, car le +mécanisme d'inférence du type du filtrage n'est pas aussi puissant que +celui implanté par les tactiques d'élimination. *) Section VECTORS. -(* -Un vecteur est une liste de taille n d'éléments d'un ensemble A. -Si la taille est non nulle, on peut extraire la première composante et -le reste du vecteur, la dernière composante ou rajouter ou enlever -une composante (carry) ou repeter la dernière composante en fin de vecteur. -On peut aussi tronquer le vecteur de ses p dernières composantes ou -au contraire l'étendre (concaténer) d'un vecteur de longueur p. -Une fonction unaire sur A génère une fonction des vecteurs de taille n -dans les vecteurs de taille n en appliquant f terme à terme. -Une fonction binaire sur A génère une fonction des couple de vecteurs -de taille n dans les vecteurs de taille n en appliquant f terme à terme. +(** +Un vecteur est une liste de taille n d'éléments d'un ensemble A. +Si la taille est non nulle, on peut extraire la première composante et +le reste du vecteur, la dernière composante ou rajouter ou enlever +une composante (carry) ou repeter la dernière composante en fin de vecteur. +On peut aussi tronquer le vecteur de ses p dernières composantes ou +au contraire l'étendre (concaténer) d'un vecteur de longueur p. +Une fonction unaire sur A génère une fonction des vecteurs de taille n +dans les vecteurs de taille n en appliquant f terme à terme. +Une fonction binaire sur A génère une fonction des couples de vecteurs +de taille n dans les vecteurs de taille n en appliquant f terme à terme. *) Variable A : Type. @@ -54,129 +54,129 @@ Inductive vector : nat -> Type := Definition Vhead : forall n:nat, vector (S n) -> A. Proof. - intros n v; inversion v; exact a. + intros n v; inversion v; exact a. Defined. Definition Vtail : forall n:nat, vector (S n) -> vector n. Proof. - intros n v; inversion v as [|_ n0 H0 H1]; exact H0. + intros n v; inversion v as [|_ n0 H0 H1]; exact H0. Defined. Definition Vlast : forall n:nat, vector (S n) -> A. Proof. - induction n as [| n f]; intro v. - inversion v. - exact a. - - inversion v as [| n0 a H0 H1]. - exact (f H0). + induction n as [| n f]; intro v. + inversion v. + exact a. + + inversion v as [| n0 a H0 H1]. + exact (f H0). Defined. Definition Vconst : forall (a:A) (n:nat), vector n. Proof. - induction n as [| n v]. - exact Vnil. + induction n as [| n v]. + exact Vnil. - exact (Vcons a n v). + exact (Vcons a n v). Defined. Lemma Vshiftout : forall n:nat, vector (S n) -> vector n. Proof. - induction n as [| n f]; intro v. - exact Vnil. - - inversion v as [| a n0 H0 H1]. - exact (Vcons a n (f H0)). + induction n as [| n f]; intro v. + exact Vnil. + + inversion v as [| a n0 H0 H1]. + exact (Vcons a n (f H0)). Defined. Lemma Vshiftin : forall n:nat, A -> vector n -> vector (S n). Proof. - induction n as [| n f]; intros a v. - exact (Vcons a 0 v). - - inversion v as [| a0 n0 H0 H1 ]. - exact (Vcons a (S n) (f a H0)). + induction n as [| n f]; intros a v. + exact (Vcons a 0 v). + + inversion v as [| a0 n0 H0 H1 ]. + exact (Vcons a (S n) (f a H0)). Defined. Lemma Vshiftrepeat : forall n:nat, vector (S n) -> vector (S (S n)). Proof. - induction n as [| n f]; intro v. - inversion v. - exact (Vcons a 1 v). - - inversion v as [| a n0 H0 H1 ]. - exact (Vcons a (S (S n)) (f H0)). + induction n as [| n f]; intro v. + inversion v. + exact (Vcons a 1 v). + + inversion v as [| a n0 H0 H1 ]. + exact (Vcons a (S (S n)) (f H0)). Defined. Lemma Vtrunc : forall n p:nat, n > p -> vector n -> vector (n - p). Proof. - induction p as [| p f]; intros H v. - rewrite <- minus_n_O. - exact v. - - apply (Vshiftout (n - S p)). - -rewrite minus_Sn_m. -apply f. -auto with *. -exact v. -auto with *. + induction p as [| p f]; intros H v. + rewrite <- minus_n_O. + exact v. + + apply (Vshiftout (n - S p)). + + rewrite minus_Sn_m. + apply f. + auto with *. + exact v. + auto with *. Defined. Lemma Vextend : forall n p:nat, vector n -> vector p -> vector (n + p). Proof. - induction n as [| n f]; intros p v v0. - simpl in |- *; exact v0. - - inversion v as [| a n0 H0 H1]. - simpl in |- *; exact (Vcons a (n + p) (f p H0 v0)). + induction n as [| n f]; intros p v v0. + simpl in |- *; exact v0. + + inversion v as [| a n0 H0 H1]. + simpl in |- *; exact (Vcons a (n + p) (f p H0 v0)). Defined. Variable f : A -> A. Lemma Vunary : forall n:nat, vector n -> vector n. Proof. - induction n as [| n g]; intro v. - exact Vnil. - - inversion v as [| a n0 H0 H1]. - exact (Vcons (f a) n (g H0)). + induction n as [| n g]; intro v. + exact Vnil. + + inversion v as [| a n0 H0 H1]. + exact (Vcons (f a) n (g H0)). Defined. Variable g : A -> A -> A. Lemma Vbinary : forall n:nat, vector n -> vector n -> vector n. Proof. - induction n as [| n h]; intros v v0. - exact Vnil. - - inversion v as [| a n0 H0 H1]; inversion v0 as [| a0 n1 H2 H3]. - exact (Vcons (g a a0) n (h H0 H2)). + induction n as [| n h]; intros v v0. + exact Vnil. + + inversion v as [| a n0 H0 H1]; inversion v0 as [| a0 n1 H2 H3]. + exact (Vcons (g a a0) n (h H0 H2)). Defined. Definition Vid : forall n:nat, vector n -> vector n. Proof. -destruct n; intro X. -exact Vnil. -exact (Vcons (Vhead _ X) _ (Vtail _ X)). + destruct n; intro X. + exact Vnil. + exact (Vcons (Vhead _ X) _ (Vtail _ X)). Defined. Lemma Vid_eq : forall (n:nat) (v:vector n), v=(Vid n v). Proof. -destruct v; auto. + destruct v; auto. Qed. Lemma VSn_eq : forall (n : nat) (v : vector (S n)), v = Vcons (Vhead _ v) _ (Vtail _ v). Proof. -intros. -exact (Vid_eq _ v). + intros. + exact (Vid_eq _ v). Qed. Lemma V0_eq : forall (v : vector 0), v = Vnil. Proof. -intros. -exact (Vid_eq _ v). + intros. + exact (Vid_eq _ v). Qed. End VECTORS. @@ -188,15 +188,15 @@ Implicit Arguments Vcons [A n]. Section BOOLEAN_VECTORS. -(* -Un vecteur de bits est un vecteur sur l'ensemble des booléens de longueur fixe. -ATTENTION : le stockage s'effectue poids FAIBLE en tête. +(** +Un vecteur de bits est un vecteur sur l'ensemble des booléens de longueur fixe. +ATTENTION : le stockage s'effectue poids FAIBLE en tête. On en extrait le bit de poids faible (head) et la fin du vecteur (tail). -On calcule la négation d'un vecteur, le et, le ou et le xor bit à bit de 2 vecteurs. -On calcule les décalages d'une position vers la gauche (vers les poids forts, on +On calcule la négation d'un vecteur, le et, le ou et le xor bit à bit de 2 vecteurs. +On calcule les décalages d'une position vers la gauche (vers les poids forts, on utilise donc Vshiftout, vers la droite (vers les poids faibles, on utilise Vshiftin) en -insérant un bit 'carry' (logique) ou en répétant le bit de poids fort (arithmétique). -ATTENTION : Tous les décalages prennent la taille moins un comme paramètre +insérant un bit 'carry' (logique) ou en répétant le bit de poids fort (arithmétique). +ATTENTION : Tous les décalages prennent la taille moins un comme paramètre (ils ne travaillent que sur des vecteurs au moins de longueur un). *) @@ -234,24 +234,24 @@ Definition BshiftRa (n:nat) (bv:Bvector (S n)) := Bhigh (S n) (Vshiftrepeat bool n bv). Fixpoint BshiftL_iter (n:nat) (bv:Bvector (S n)) (p:nat) {struct p} : - Bvector (S n) := + Bvector (S n) := match p with - | O => bv - | S p' => BshiftL n (BshiftL_iter n bv p') false + | O => bv + | S p' => BshiftL n (BshiftL_iter n bv p') false end. Fixpoint BshiftRl_iter (n:nat) (bv:Bvector (S n)) (p:nat) {struct p} : - Bvector (S n) := + Bvector (S n) := match p with - | O => bv - | S p' => BshiftRl n (BshiftRl_iter n bv p') false + | O => bv + | S p' => BshiftRl n (BshiftRl_iter n bv p') false end. Fixpoint BshiftRa_iter (n:nat) (bv:Bvector (S n)) (p:nat) {struct p} : - Bvector (S n) := + Bvector (S n) := match p with - | O => bv - | S p' => BshiftRa n (BshiftRa_iter n bv p') + | O => bv + | S p' => BshiftRa n (BshiftRa_iter n bv p') end. End BOOLEAN_VECTORS. diff --git a/theories/Bool/DecBool.v b/theories/Bool/DecBool.v index 31ff029c..af9acea1 100644 --- a/theories/Bool/DecBool.v +++ b/theories/Bool/DecBool.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: DecBool.v 8866 2006-05-28 16:21:04Z herbelin $ i*) +(*i $Id: DecBool.v 9245 2006-10-17 12:53:34Z notin $ i*) Set Implicit Arguments. @@ -15,17 +15,19 @@ Definition ifdec (A B:Prop) (C:Type) (H:{A} + {B}) (x y:C) : C := Theorem ifdec_left : - forall (A B:Prop) (C:Set) (H:{A} + {B}), - ~ B -> forall x y:C, ifdec H x y = x. -intros; case H; auto. -intro; absurd B; trivial. + forall (A B:Prop) (C:Set) (H:{A} + {B}), + ~ B -> forall x y:C, ifdec H x y = x. +Proof. + intros; case H; auto. + intro; absurd B; trivial. Qed. Theorem ifdec_right : - forall (A B:Prop) (C:Set) (H:{A} + {B}), - ~ A -> forall x y:C, ifdec H x y = y. -intros; case H; auto. -intro; absurd A; trivial. + forall (A B:Prop) (C:Set) (H:{A} + {B}), + ~ A -> forall x y:C, ifdec H x y = y. +Proof. + intros; case H; auto. + intro; absurd A; trivial. Qed. Unset Implicit Arguments. diff --git a/theories/Bool/Sumbool.v b/theories/Bool/Sumbool.v index 2842437d..0da72f56 100644 --- a/theories/Bool/Sumbool.v +++ b/theories/Bool/Sumbool.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Sumbool.v 7235 2005-07-15 17:11:57Z coq $ i*) +(*i $Id: Sumbool.v 9245 2006-10-17 12:53:34Z notin $ i*) (** Here are collected some results about the type sumbool (see INIT/Specif.v) [sumbool A B], which is written [{A}+{B}], is the informative @@ -16,7 +16,6 @@ (** A boolean is either [true] or [false], and this is decidable *) Definition sumbool_of_bool : forall b:bool, {b = true} + {b = false}. -Proof. destruct b; auto. Defined. @@ -25,41 +24,36 @@ Hint Resolve sumbool_of_bool: bool. Definition bool_eq_rec : forall (b:bool) (P:bool -> Set), (b = true -> P true) -> (b = false -> P false) -> P b. -destruct b; auto. + destruct b; auto. Defined. Definition bool_eq_ind : forall (b:bool) (P:bool -> Prop), (b = true -> P true) -> (b = false -> P false) -> P b. -destruct b; auto. + destruct b; auto. Defined. -(*i pourquoi ce machin-la est dans BOOL et pas dans LOGIC ? Papageno i*) - (** Logic connectives on type [sumbool] *) Section connectives. -Variables A B C D : Prop. - -Hypothesis H1 : {A} + {B}. -Hypothesis H2 : {C} + {D}. - -Definition sumbool_and : {A /\ C} + {B \/ D}. -Proof. -case H1; case H2; auto. -Defined. - -Definition sumbool_or : {A \/ C} + {B /\ D}. -Proof. -case H1; case H2; auto. -Defined. - -Definition sumbool_not : {B} + {A}. -Proof. -case H1; auto. -Defined. + Variables A B C D : Prop. + + Hypothesis H1 : {A} + {B}. + Hypothesis H2 : {C} + {D}. + + Definition sumbool_and : {A /\ C} + {B \/ D}. + case H1; case H2; auto. + Defined. + + Definition sumbool_or : {A \/ C} + {B /\ D}. + case H1; case H2; auto. + Defined. + + Definition sumbool_not : {B} + {A}. + case H1; auto. + Defined. End connectives. @@ -71,8 +65,7 @@ Hint Immediate sumbool_not : core. Definition bool_of_sumbool : forall A B:Prop, {A} + {B} -> {b : bool | if b then A else B}. -Proof. -intros A B H. -elim H; [ intro; exists true; assumption | intro; exists false; assumption ]. + intros A B H. + elim H; intro; [exists true | exists false]; assumption. Defined. Implicit Arguments bool_of_sumbool.
\ No newline at end of file diff --git a/theories/Bool/Zerob.v b/theories/Bool/Zerob.v index c9abf94a..fe656777 100644 --- a/theories/Bool/Zerob.v +++ b/theories/Bool/Zerob.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Zerob.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Zerob.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Arith. Require Import Bool. @@ -15,24 +15,28 @@ Open Local Scope nat_scope. Definition zerob (n:nat) : bool := match n with - | O => true - | S _ => false + | O => true + | S _ => false end. Lemma zerob_true_intro : forall n:nat, n = 0 -> zerob n = true. -destruct n; [ trivial with bool | inversion 1 ]. +Proof. + destruct n; [ trivial with bool | inversion 1 ]. Qed. Hint Resolve zerob_true_intro: bool. Lemma zerob_true_elim : forall n:nat, zerob n = true -> n = 0. -destruct n; [ trivial with bool | inversion 1 ]. +Proof. + destruct n; [ trivial with bool | inversion 1 ]. Qed. Lemma zerob_false_intro : forall n:nat, n <> 0 -> zerob n = false. -destruct n; [ destruct 1; auto with bool | trivial with bool ]. +Proof. + destruct n; [ destruct 1; auto with bool | trivial with bool ]. Qed. Hint Resolve zerob_false_intro: bool. Lemma zerob_false_elim : forall n:nat, zerob n = false -> n <> 0. -destruct n; [ intro H; inversion H | auto with bool ]. +Proof. + destruct n; [ inversion 1 | auto with bool ]. Qed.
\ No newline at end of file diff --git a/theories/FSets/FMapPositive.v b/theories/FSets/FMapPositive.v index dcb7fb49..911de00e 100644 --- a/theories/FSets/FMapPositive.v +++ b/theories/FSets/FMapPositive.v @@ -11,8 +11,9 @@ * Institution: LRI, CNRS UMR 8623 - Université Paris Sud * 91405 Orsay, France *) -(* $Id: FMapPositive.v 8773 2006-04-29 14:31:32Z letouzey $ *) +(* $Id: FMapPositive.v 9178 2006-09-26 11:18:22Z barras $ *) +Require Import Bool. Require Import ZArith. Require Import OrderedType. Require Import FMapInterface. @@ -734,7 +735,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. Proof. intros. generalize (xelements_complete _ _ _ _ H); clear H; intros. - revert H; revert v; revert m; revert q; revert p0. + revert p0 q m v H. induction p; destruct p0; simpl; intros; eauto; try discriminate. Qed. @@ -743,7 +744,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. Proof. intros. generalize (xelements_complete _ _ _ _ H); clear H; intros. - revert H; revert v; revert m; revert q; revert p0. + revert p0 q m v H. induction p; destruct p0; simpl; intros; eauto; try discriminate. Qed. diff --git a/theories/FSets/FSetWeak.v b/theories/FSets/FSetWeak.v index bfe34cd7..c88a7869 100644 --- a/theories/FSets/FSetWeak.v +++ b/theories/FSets/FSetWeak.v @@ -6,11 +6,11 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -(* $Id: FSetWeak.v 8819 2006-05-15 09:52:36Z letouzey $ *) +(* $Id: FSetWeak.v 9278 2006-10-25 13:43:17Z letouzey $ *) Require Export DecidableType. Require Export DecidableTypeEx. Require Export FSetWeakInterface. -Require Export FSetFacts. -Require Export FSetProperties. +Require Export FSetWeakFacts. +Require Export FSetWeakProperties. Require Export FSetWeakList. diff --git a/theories/FSets/OrderedTypeEx.v b/theories/FSets/OrderedTypeEx.v index 1c5a4054..6fa6a85c 100644 --- a/theories/FSets/OrderedTypeEx.v +++ b/theories/FSets/OrderedTypeEx.v @@ -11,7 +11,7 @@ * Institution: LRI, CNRS UMR 8623 - Université Paris Sud * 91405 Orsay, France *) -(* $Id: OrderedTypeEx.v 8836 2006-05-20 21:34:27Z letouzey $ *) +(* $Id: OrderedTypeEx.v 9066 2006-08-14 10:11:18Z letouzey $ *) Require Import OrderedType. Require Import ZArith. @@ -66,7 +66,7 @@ Module Nat_as_OT <: UsualOrderedType. constructor 1; auto. constructor 2; auto. intro; constructor 3; auto. - Qed. + Defined. End Nat_as_OT. @@ -182,7 +182,7 @@ Module N_as_OT <: UsualOrderedType. destruct (Nle x y); auto. destruct (x ?= y)%N; simpl; try discriminate. intros (H0,_); elim H0; auto. - Qed. + Defined. End N_as_OT. @@ -242,7 +242,7 @@ Module PairOrderedType(O1 O2:OrderedType) <: OrderedType. apply EQ; unfold eq; auto. apply GT; unfold lt; auto. apply GT; unfold lt; auto. - Qed. + Defined. End PairOrderedType. diff --git a/theories/Init/Datatypes.v b/theories/Init/Datatypes.v index fdd7ba35..56dc7e95 100644 --- a/theories/Init/Datatypes.v +++ b/theories/Init/Datatypes.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Datatypes.v 8872 2006-05-29 07:36:28Z herbelin $ i*) +(*i $Id: Datatypes.v 9245 2006-10-17 12:53:34Z notin $ i*) Set Implicit Arguments. @@ -48,7 +48,7 @@ Inductive Empty_set : Set :=. sole inhabitant is denoted [refl_identity A a] *) Inductive identity (A:Type) (a:A) : A -> Type := - refl_identity : identity (A:=A) a a. + refl_identity : identity (A:=A) a a. Hint Resolve refl_identity: core v62. Implicit Arguments identity_ind [A]. @@ -65,8 +65,8 @@ Implicit Arguments None [A]. Definition option_map (A B:Type) (f:A->B) o := match o with - | Some a => Some (f a) - | None => None + | Some a => Some (f a) + | None => None end. (** [sum A B], written [A + B], is the disjoint sum of [A] and [B] *) @@ -81,7 +81,7 @@ Notation "x + y" := (sum x y) : type_scope. the pair [pair A B a b] of [a] and [b] is abbreviated [(a,b)] *) Inductive prod (A B:Type) : Type := - pair : A -> B -> prod A B. + pair : A -> B -> prod A B. Add Printing Let prod. Notation "x * y" := (prod x y) : type_scope. @@ -90,27 +90,27 @@ Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. Section projections. Variables A B : Type. Definition fst (p:A * B) := match p with - | (x, y) => x + | (x, y) => x end. Definition snd (p:A * B) := match p with - | (x, y) => y + | (x, y) => y end. End projections. Hint Resolve pair inl inr: core v62. Lemma surjective_pairing : - forall (A B:Type) (p:A * B), p = pair (fst p) (snd p). + forall (A B:Type) (p:A * B), p = pair (fst p) (snd p). Proof. -destruct p; reflexivity. + destruct p; reflexivity. Qed. Lemma injective_projections : - forall (A B:Type) (p1 p2:A * B), - fst p1 = fst p2 -> snd p1 = snd p2 -> p1 = p2. + forall (A B:Type) (p1 p2:A * B), + fst p1 = fst p2 -> snd p1 = snd p2 -> p1 = p2. Proof. -destruct p1; destruct p2; simpl in |- *; intros Hfst Hsnd. -rewrite Hfst; rewrite Hsnd; reflexivity. + destruct p1; destruct p2; simpl in |- *; intros Hfst Hsnd. + rewrite Hfst; rewrite Hsnd; reflexivity. Qed. Definition prod_uncurry (A B C:Type) (f:prod A B -> C) @@ -130,9 +130,9 @@ Inductive comparison : Set := Definition CompOpp (r:comparison) := match r with - | Eq => Eq - | Lt => Gt - | Gt => Lt + | Eq => Eq + | Lt => Gt + | Gt => Lt end. (* Compatibility *) diff --git a/theories/Init/Logic.v b/theories/Init/Logic.v index 71583718..8b487432 100644 --- a/theories/Init/Logic.v +++ b/theories/Init/Logic.v @@ -6,17 +6,17 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Logic.v 8936 2006-06-09 15:43:33Z herbelin $ i*) +(*i $Id: Logic.v 9245 2006-10-17 12:53:34Z notin $ i*) Set Implicit Arguments. Require Import Notations. -(** *** Propositional connectives *) +(** * Propositional connectives *) (** [True] is the always true proposition *) Inductive True : Prop := - I : True. + I : True. (** [False] is the always false proposition *) Inductive False : Prop :=. @@ -36,8 +36,8 @@ Hint Unfold not: core. [proj1] and [proj2] are first and second projections of a conjunction *) Inductive and (A B:Prop) : Prop := - conj : A -> B -> A /\ B - + conj : A -> B -> A /\ B + where "A /\ B" := (and A B) : type_scope. Section Conjunction. @@ -46,12 +46,12 @@ Section Conjunction. Theorem proj1 : A /\ B -> A. Proof. - destruct 1; trivial. + destruct 1; trivial. Qed. Theorem proj2 : A /\ B -> B. Proof. - destruct 1; trivial. + destruct 1; trivial. Qed. End Conjunction. @@ -97,7 +97,7 @@ Definition IF_then_else (P Q R:Prop) := P /\ Q \/ ~ P /\ R. Notation "'IF' c1 'then' c2 'else' c3" := (IF_then_else c1 c2 c3) (at level 200, right associativity) : type_scope. -(** *** First-order quantifiers *) +(** * First-order quantifiers *) (** [ex P], or simply [exists x, P x], or also [exists x:A, P x], expresses the existence of an [x] of some type [A] in [Set] which @@ -112,16 +112,16 @@ Notation "'IF' c1 'then' c2 'else' c3" := (IF_then_else c1 c2 c3) is provided too. *) -(* Remark: [exists x, Q] denotes [ex (fun x => Q)] so that [exists x, +(** Remark: [exists x, Q] denotes [ex (fun x => Q)] so that [exists x, P x] is in fact equivalent to [ex (fun x => P x)] which may be not convertible to [ex P] if [P] is not itself an abstraction *) Inductive ex (A:Type) (P:A -> Prop) : Prop := - ex_intro : forall x:A, P x -> ex (A:=A) P. + ex_intro : forall x:A, P x -> ex (A:=A) P. Inductive ex2 (A:Type) (P Q:A -> Prop) : Prop := - ex_intro2 : forall x:A, P x -> Q x -> ex2 (A:=A) P Q. + ex_intro2 : forall x:A, P x -> Q x -> ex2 (A:=A) P Q. Definition all (A:Type) (P:A -> Prop) := forall x:A, P x. @@ -131,14 +131,14 @@ Notation "'exists' x , p" := (ex (fun x => p)) (at level 200, x ident, right associativity) : type_scope. Notation "'exists' x : t , p" := (ex (fun x:t => p)) (at level 200, x ident, right associativity, - format "'[' 'exists' '/ ' x : t , '/ ' p ']'") + format "'[' 'exists' '/ ' x : t , '/ ' p ']'") : type_scope. Notation "'exists2' x , p & q" := (ex2 (fun x => p) (fun x => q)) (at level 200, x ident, p at level 200, right associativity) : type_scope. Notation "'exists2' x : t , p & q" := (ex2 (fun x:t => p) (fun x:t => q)) (at level 200, x ident, t at level 200, p at level 200, right associativity, - format "'[' 'exists2' '/ ' x : t , '/ ' '[' p & '/' q ']' ']'") + format "'[' 'exists2' '/ ' x : t , '/ ' '[' p & '/' q ']' ']'") : type_scope. (** Derived rules for universal quantification *) @@ -150,17 +150,17 @@ Section universal_quantification. Theorem inst : forall x:A, all (fun x => P x) -> P x. Proof. - unfold all in |- *; auto. + unfold all in |- *; auto. Qed. Theorem gen : forall (B:Prop) (f:forall y:A, B -> P y), B -> all P. Proof. - red in |- *; auto. + red in |- *; auto. Qed. End universal_quantification. -(** *** Equality *) +(** * Equality *) (** [eq x y], or simply [x=y] expresses the equality of [x] and [y]. Both [x] and [y] must belong to the same type [A]. @@ -202,27 +202,27 @@ Section Logic_lemmas. Theorem sym_eq : x = y -> y = x. Proof. - destruct 1; trivial. + destruct 1; trivial. Defined. Opaque sym_eq. Theorem trans_eq : x = y -> y = z -> x = z. Proof. - destruct 2; trivial. + destruct 2; trivial. Defined. Opaque trans_eq. Theorem f_equal : x = y -> f x = f y. Proof. - destruct 1; trivial. + destruct 1; trivial. Defined. Opaque f_equal. Theorem sym_not_eq : x <> y -> y <> x. Proof. - red in |- *; intros h1 h2; apply h1; destruct h2; trivial. + red in |- *; intros h1 h2; apply h1; destruct h2; trivial. Qed. - + Definition sym_equal := sym_eq. Definition sym_not_equal := sym_not_eq. Definition trans_equal := trans_eq. @@ -231,14 +231,14 @@ Section Logic_lemmas. Definition eq_ind_r : forall (A:Type) (x:A) (P:A -> Prop), P x -> forall y:A, y = x -> P y. - intros A x P H y H0; elim sym_eq with (1 := H0); assumption. + intros A x P H y H0; elim sym_eq with (1 := H0); assumption. Defined. - + Definition eq_rec_r : forall (A:Type) (x:A) (P:A -> Set), P x -> forall y:A, y = x -> P y. intros A x P H y H0; elim sym_eq with (1 := H0); assumption. Defined. - + Definition eq_rect_r : forall (A:Type) (x:A) (P:A -> Type), P x -> forall y:A, y = x -> P y. intros A x P H y H0; elim sym_eq with (1 := H0); assumption. @@ -246,34 +246,34 @@ Section Logic_lemmas. End Logic_lemmas. Theorem f_equal2 : - forall (A1 A2 B:Type) (f:A1 -> A2 -> B) (x1 y1:A1) - (x2 y2:A2), x1 = y1 -> x2 = y2 -> f x1 x2 = f y1 y2. + forall (A1 A2 B:Type) (f:A1 -> A2 -> B) (x1 y1:A1) + (x2 y2:A2), x1 = y1 -> x2 = y2 -> f x1 x2 = f y1 y2. Proof. destruct 1; destruct 1; reflexivity. Qed. Theorem f_equal3 : - forall (A1 A2 A3 B:Type) (f:A1 -> A2 -> A3 -> B) (x1 y1:A1) - (x2 y2:A2) (x3 y3:A3), - x1 = y1 -> x2 = y2 -> x3 = y3 -> f x1 x2 x3 = f y1 y2 y3. + forall (A1 A2 A3 B:Type) (f:A1 -> A2 -> A3 -> B) (x1 y1:A1) + (x2 y2:A2) (x3 y3:A3), + x1 = y1 -> x2 = y2 -> x3 = y3 -> f x1 x2 x3 = f y1 y2 y3. Proof. destruct 1; destruct 1; destruct 1; reflexivity. Qed. Theorem f_equal4 : - forall (A1 A2 A3 A4 B:Type) (f:A1 -> A2 -> A3 -> A4 -> B) - (x1 y1:A1) (x2 y2:A2) (x3 y3:A3) (x4 y4:A4), - x1 = y1 -> x2 = y2 -> x3 = y3 -> x4 = y4 -> f x1 x2 x3 x4 = f y1 y2 y3 y4. + forall (A1 A2 A3 A4 B:Type) (f:A1 -> A2 -> A3 -> A4 -> B) + (x1 y1:A1) (x2 y2:A2) (x3 y3:A3) (x4 y4:A4), + x1 = y1 -> x2 = y2 -> x3 = y3 -> x4 = y4 -> f x1 x2 x3 x4 = f y1 y2 y3 y4. Proof. destruct 1; destruct 1; destruct 1; destruct 1; reflexivity. Qed. Theorem f_equal5 : - forall (A1 A2 A3 A4 A5 B:Type) (f:A1 -> A2 -> A3 -> A4 -> A5 -> B) - (x1 y1:A1) (x2 y2:A2) (x3 y3:A3) (x4 y4:A4) (x5 y5:A5), - x1 = y1 -> - x2 = y2 -> - x3 = y3 -> x4 = y4 -> x5 = y5 -> f x1 x2 x3 x4 x5 = f y1 y2 y3 y4 y5. + forall (A1 A2 A3 A4 A5 B:Type) (f:A1 -> A2 -> A3 -> A4 -> A5 -> B) + (x1 y1:A1) (x2 y2:A2) (x3 y3:A3) (x4 y4:A4) (x5 y5:A5), + x1 = y1 -> + x2 = y2 -> + x3 = y3 -> x4 = y4 -> x5 = y5 -> f x1 x2 x3 x4 x5 = f y1 y2 y3 y4 y5. Proof. destruct 1; destruct 1; destruct 1; destruct 1; destruct 1; reflexivity. Qed. @@ -294,22 +294,26 @@ Definition uniqueness (A:Type) (P:A->Prop) := forall x y, P x -> P y -> x = y. Notation "'exists' ! x , P" := (ex (unique (fun x => P))) (at level 200, x ident, right associativity, - format "'[' 'exists' ! '/ ' x , '/ ' P ']'") : type_scope. + format "'[' 'exists' ! '/ ' x , '/ ' P ']'") : type_scope. Notation "'exists' ! x : A , P" := (ex (unique (fun x:A => P))) (at level 200, x ident, right associativity, - format "'[' 'exists' ! '/ ' x : A , '/ ' P ']'") : type_scope. + format "'[' 'exists' ! '/ ' x : A , '/ ' P ']'") : type_scope. Lemma unique_existence : forall (A:Type) (P:A->Prop), ((exists x, P x) /\ uniqueness P) <-> (exists! x, P x). Proof. -intros A P; split. + intros A P; split. intros ((x,Hx),Huni); exists x; red; auto. intros (x,(Hx,Huni)); split. - exists x; assumption. - intros x' x'' Hx' Hx''; transitivity x. - symmetry; auto. - auto. + exists x; assumption. + intros x' x'' Hx' Hx''; transitivity x. + symmetry; auto. + auto. Qed. +(** Being inhabited *) + +Inductive inhabited (A:Type) : Prop := inhabits : A -> inhabited A. +Hint Resolve inhabits: core. diff --git a/theories/Init/Peano.v b/theories/Init/Peano.v index c0416b63..3df2b566 100644 --- a/theories/Init/Peano.v +++ b/theories/Init/Peano.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Peano.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Peano.v 9245 2006-10-17 12:53:34Z notin $ i*) (** The type [nat] of Peano natural numbers (built from [O] and [S]) is defined in [Datatypes.v] *) @@ -47,14 +47,16 @@ Hint Resolve (f_equal pred): v62. Theorem pred_Sn : forall n:nat, n = pred (S n). Proof. - auto. + simpl; reflexivity. Qed. (** Injectivity of successor *) Theorem eq_add_S : forall n m:nat, S n = S m -> n = m. Proof. - intros n m H; change (pred (S n) = pred (S m)) in |- *; auto. + intros n m Sn_eq_Sm. + replace (n=m) with (pred (S n) = pred (S m)) by auto using pred_Sn. + rewrite Sn_eq_Sm; trivial. Qed. Hint Immediate eq_add_S: core v62. @@ -65,19 +67,18 @@ Proof. Qed. Hint Resolve not_eq_S: core v62. -(** Zero is not the successor of a number *) - Definition IsSucc (n:nat) : Prop := match n with | O => False | S p => True end. +(** Zero is not the successor of a number *) + Theorem O_S : forall n:nat, 0 <> S n. Proof. - red in |- *; intros n H. - change (IsSucc 0) in |- *. - rewrite <- (sym_eq (x:=0) (y:=(S n))); [ exact I | assumption ]. + unfold not; intros n H. + inversion H. Qed. Hint Resolve O_S: core v62. diff --git a/theories/Init/Tactics.v b/theories/Init/Tactics.v index ce37715e..ba210dd6 100644 --- a/theories/Init/Tactics.v +++ b/theories/Init/Tactics.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Tactics.v 8100 2006-02-27 12:10:03Z letouzey $ i*) +(*i $Id: Tactics.v 9268 2006-10-24 12:56:16Z herbelin $ i*) Require Import Notations. Require Import Logic. @@ -15,7 +15,7 @@ Require Import Logic. (* A shorter name for generalize + clear, can be seen as an anti-intro *) -Ltac revert H := generalize H; clear H. +Tactic Notation "revert" ne_hyp_list(l) := generalize l; clear l. (* to contradict an hypothesis without copying its type. *) @@ -49,24 +49,16 @@ Ltac f_equal := | _ => idtac end. -(* Rewriting in all hypothesis. *) - -Ltac rewrite_all Eq := match type of Eq with - ?a = ?b => - generalize Eq; clear Eq; - match goal with - | H : context [a] |- _ => intro Eq; rewrite Eq in H; rewrite_all Eq - | _ => intro Eq; try rewrite Eq - end - end. - -Ltac rewrite_all_rev Eq := match type of Eq with - ?a = ?b => - generalize Eq; clear Eq; - match goal with - | H : context [b] |- _ => intro Eq; rewrite <- Eq in H; rewrite_all_rev Eq - | _ => intro Eq; try rewrite <- Eq - end - end. - -Tactic Notation "rewrite_all" "<-" constr(H) := rewrite_all_rev H. +(* Rewriting in all hypothesis several times everywhere *) + +Tactic Notation "rewrite_all" constr(eq) := repeat rewrite eq in *. +Tactic Notation "rewrite_all" "<-" constr(eq) := repeat rewrite <- eq in *. + +(* Keeping a copy of an expression *) + +Ltac remembertac x a := + let x := fresh x in + let H := fresh "Heq" x in + (set (x:=a) in *; assert (H: x=a) by reflexivity; clearbody x). + +Tactic Notation "remember" constr(c) "as" ident(x) := remembertac x c. diff --git a/theories/Lists/List.v b/theories/Lists/List.v index df2b17e0..c80d0b15 100644 --- a/theories/Lists/List.v +++ b/theories/Lists/List.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) - (*i $Id: List.v 9035 2006-07-09 15:42:09Z herbelin $ i*) + (*i $Id: List.v 9290 2006-10-26 19:20:42Z herbelin $ i*) Require Import Le Gt Minus Min Bool. Require Import Setoid. @@ -39,6 +39,12 @@ Section Lists. | x :: _ => value x end. + Definition hd (default:A) (l:list) := + match l with + | nil => default + | x :: _ => x + end. + Definition tail (l:list) : list := match l with | nil => nil @@ -670,21 +676,27 @@ Section ListOps. (** An alternative tail-recursive definition for reverse *) - Fixpoint rev_acc (l l': list A) {struct l} : list A := + Fixpoint rev_append (l l': list A) {struct l} : list A := match l with | nil => l' - | a::l => rev_acc l (a::l') + | a::l => rev_append l (a::l') end. - Lemma rev_acc_rev : forall l l', rev_acc l l' = rev l ++ l'. + Definition rev' l : list A := rev_append l nil. + + Notation rev_acc := rev_append (only parsing). + + Lemma rev_append_rev : forall l l', rev_acc l l' = rev l ++ l'. Proof. induction l; simpl; auto; intros. rewrite <- ass_app; firstorder. Qed. - Lemma rev_alt : forall l, rev l = rev_acc l nil. + Notation rev_acc_rev := rev_append_rev (only parsing). + + Lemma rev_alt : forall l, rev l = rev_append l nil. Proof. - intros; rewrite rev_acc_rev. + intros; rewrite rev_append_rev. apply app_nil_end. Qed. @@ -1336,14 +1348,14 @@ End Fold_Right_Recursor. rewrite IHl; simpl; auto. Qed. - Lemma split_lenght_l : forall (l:list (A*B)), + Lemma split_length_l : forall (l:list (A*B)), length (fst (split l)) = length l. Proof. induction l; simpl; auto. destruct a; destruct (split l); simpl; auto. Qed. - Lemma split_lenght_r : forall (l:list (A*B)), + Lemma split_length_r : forall (l:list (A*B)), length (snd (split l)) = length l. Proof. induction l; simpl; auto. diff --git a/theories/Lists/ListTactics.v b/theories/Lists/ListTactics.v new file mode 100644 index 00000000..a3b4e647 --- /dev/null +++ b/theories/Lists/ListTactics.v @@ -0,0 +1,69 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id: ListTactics.v 9290 2006-10-26 19:20:42Z herbelin $ i*) + +Require Import BinPos. +Require Import List. + +Ltac list_fold_right fcons fnil l := + match l with + | (cons ?x ?tl) => fcons x ltac:(list_fold_right fcons fnil tl) + | nil => fnil + end. + +Ltac list_fold_left fcons fnil l := + match l with + | (cons ?x ?tl) => list_fold_left fcons ltac:(fcons x fnil) tl + | nil => fnil + end. + +Ltac list_iter f l := + match l with + | (cons ?x ?tl) => f x; list_iter f tl + | nil => idtac + end. + +Ltac list_iter_gen seq f l := + match l with + | (cons ?x ?tl) => + let t1 _ := f x in + let t2 _ := list_iter_gen seq f tl in + seq t1 t2 + | nil => idtac + end. + +Ltac AddFvTail a l := + match l with + | nil => constr:(cons a l) + | (cons a _) => l + | (cons ?x ?l) => let l' := AddFvTail a l in constr:(cons x l') + end. + +Ltac Find_at a l := + let rec find n l := + match l with + | nil => fail 100 "anomaly: Find_at" + | (cons a _) => eval compute in n + | (cons _ ?l) => find (Psucc n) l + end + in find 1%positive l. + +Ltac check_is_list t := + match t with + | cons _ ?l => check_is_list l + | nil => idtac + | _ => fail 100 "anomaly: failed to build a canonical list" + end. + +Ltac check_fv l := + check_is_list l; + match type of l with + | list _ => idtac + | _ => fail 100 "anomaly: built an ill-typed list" + end. diff --git a/theories/Logic/ChoiceFacts.v b/theories/Logic/ChoiceFacts.v index d2b7db04..3b066cfc 100644 --- a/theories/Logic/ChoiceFacts.v +++ b/theories/Logic/ChoiceFacts.v @@ -7,9 +7,9 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: ChoiceFacts.v 8999 2006-07-04 12:46:04Z notin $ i*) +(*i $Id: ChoiceFacts.v 9245 2006-10-17 12:53:34Z notin $ i*) -(** ** Some facts and definitions concerning choice and description in +(** Some facts and definitions concerning choice and description in intuitionistic logic. We investigate the relations between the following choice and @@ -54,21 +54,21 @@ IPL^2 = 2nd-order functional minimal predicate logic (with ex. quant.) Table of contents -A. Definitions +1. Definitions -B. IPL_2^2 |- AC_rel + AC! = AC_fun +2. IPL_2^2 |- AC_rel + AC! = AC_fun -C. 1. AC_rel + PI -> GAC_rel and PL_2 |- AC_rel + IGP -> GAC_rel and GAC_rel = OAC_rel +3. 1. AC_rel + PI -> GAC_rel and PL_2 |- AC_rel + IGP -> GAC_rel and GAC_rel = OAC_rel -C. 2. IPL^2 |- AC_fun + IGP = GAC_fun = OAC_fun = AC_fun + Drinker +4. 2. IPL^2 |- AC_fun + IGP = GAC_fun = OAC_fun = AC_fun + Drinker -D. Derivability of choice for decidable relations with well-ordered codomain +5. Derivability of choice for decidable relations with well-ordered codomain -E. Equivalence of choices on dependent or non dependent functional types +6. Equivalence of choices on dependent or non dependent functional types -F. Non contradiction of constructive descriptions wrt functional choices +7. Non contradiction of constructive descriptions wrt functional choices -G. Definite description transports classical logic to the computational world +8. Definite description transports classical logic to the computational world References: @@ -87,7 +87,7 @@ Set Implicit Arguments. Notation Local "'inhabited' A" := A (at level 10, only parsing). (**********************************************************************) -(** *** A. Definitions *) +(** * Definitions *) (** Choice, reification and description schemes *) @@ -99,29 +99,29 @@ Variables P:A->Prop. Variables R:A->B->Prop. -(** **** Constructive choice and description *) +(** ** Constructive choice and description *) (** AC_rel *) Definition RelationalChoice_on := forall R:A->B->Prop, - (forall x : A, exists y : B, R x y) -> - (exists R' : A->B->Prop, subrelation R' R /\ forall x, exists! y, R' x y). + (forall x : A, exists y : B, R x y) -> + (exists R' : A->B->Prop, subrelation R' R /\ forall x, exists! y, R' x y). (** AC_fun *) Definition FunctionalChoice_on := forall R:A->B->Prop, - (forall x : A, exists y : B, R x y) -> - (exists f : A->B, forall x : A, R x (f x)). + (forall x : A, exists y : B, R x y) -> + (exists f : A->B, forall x : A, R x (f x)). (** AC! or Functional Relation Reification (known as Axiom of Unique Choice in topos theory; also called principle of definite description *) Definition FunctionalRelReification_on := forall R:A->B->Prop, - (forall x : A, exists! y : B, R x y) -> - (exists f : A->B, forall x : A, R x (f x)). + (forall x : A, exists! y : B, R x y) -> + (exists f : A->B, forall x : A, R x (f x)). (** ID_epsilon (constructive version of indefinite description; combined with proof-irrelevance, it may be connected to @@ -130,7 +130,7 @@ Definition FunctionalRelReification_on := Definition ConstructiveIndefiniteDescription_on := forall P:A->Prop, - (exists x, P x) -> { x:A | P x }. + (exists x, P x) -> { x:A | P x }. (** ID_iota (constructive version of definite description; combined with proof-irrelevance, it may be connected to Carlstrøm's and @@ -139,59 +139,59 @@ Definition ConstructiveIndefiniteDescription_on := Definition ConstructiveDefiniteDescription_on := forall P:A->Prop, - (exists! x, P x) -> { x:A | P x }. + (exists! x, P x) -> { x:A | P x }. -(** **** Weakly classical choice and description *) +(** ** Weakly classical choice and description *) (** GAC_rel *) Definition GuardedRelationalChoice_on := forall P : A->Prop, forall R : A->B->Prop, - (forall x : A, P x -> exists y : B, R x y) -> - (exists R' : A->B->Prop, - subrelation R' R /\ forall x, P x -> exists! y, R' x y). + (forall x : A, P x -> exists y : B, R x y) -> + (exists R' : A->B->Prop, + subrelation R' R /\ forall x, P x -> exists! y, R' x y). (** GAC_fun *) Definition GuardedFunctionalChoice_on := forall P : A->Prop, forall R : A->B->Prop, - inhabited B -> - (forall x : A, P x -> exists y : B, R x y) -> - (exists f : A->B, forall x, P x -> R x (f x)). + inhabited B -> + (forall x : A, P x -> exists y : B, R x y) -> + (exists f : A->B, forall x, P x -> R x (f x)). (** GFR_fun *) Definition GuardedFunctionalRelReification_on := forall P : A->Prop, forall R : A->B->Prop, - inhabited B -> - (forall x : A, P x -> exists! y : B, R x y) -> - (exists f : A->B, forall x : A, P x -> R x (f x)). + inhabited B -> + (forall x : A, P x -> exists! y : B, R x y) -> + (exists f : A->B, forall x : A, P x -> R x (f x)). (** OAC_rel *) Definition OmniscientRelationalChoice_on := forall R : A->B->Prop, - exists R' : A->B->Prop, - subrelation R' R /\ forall x : A, (exists y : B, R x y) -> exists! y, R' x y. + exists R' : A->B->Prop, + subrelation R' R /\ forall x : A, (exists y : B, R x y) -> exists! y, R' x y. (** OAC_fun *) Definition OmniscientFunctionalChoice_on := forall R : A->B->Prop, - inhabited B -> - exists f : A->B, forall x : A, (exists y : B, R x y) -> R x (f x). + inhabited B -> + exists f : A->B, forall x : A, (exists y : B, R x y) -> R x (f x). (** D_epsilon *) Definition ClassicalIndefiniteDescription := forall P:A->Prop, - A -> { x:A | (exists x, P x) -> P x }. + A -> { x:A | (exists x, P x) -> P x }. (** D_iota *) Definition ClassicalDefiniteDescription := forall P:A->Prop, - A -> { x:A | (exists! x, P x) -> P x }. + A -> { x:A | (exists! x, P x) -> P x }. End ChoiceSchemes. @@ -235,10 +235,10 @@ Definition IndependenceOfGeneralPremises := Definition SmallDrinker'sParadox := forall (A:Type) (P:A -> Prop), inhabited A -> - exists x, (exists x, P x) -> P x. + exists x, (exists x, P x) -> P x. (**********************************************************************) -(** *** B. AC_rel + PDP = AC_fun +(** * AC_rel + PDP = AC_fun We show that the functional formulation of the axiom of Choice (usual formulation in type theory) is equivalent to its relational @@ -251,25 +251,25 @@ Definition SmallDrinker'sParadox := Lemma description_rel_choice_imp_funct_choice : forall A B : Type, - FunctionalRelReification_on A B -> RelationalChoice_on A B -> FunctionalChoice_on A B. + FunctionalRelReification_on A B -> RelationalChoice_on A B -> FunctionalChoice_on A B. Proof. -intros A B Descr RelCh R H. -destruct (RelCh R H) as (R',(HR'R,H0)). -destruct (Descr R') as (f,Hf). -firstorder. -exists f; intro x. -destruct (H0 x) as (y,(HR'xy,Huniq)). -rewrite <- (Huniq (f x) (Hf x)). -apply HR'R; assumption. + intros A B Descr RelCh R H. + destruct (RelCh R H) as (R',(HR'R,H0)). + destruct (Descr R') as (f,Hf). + firstorder. + exists f; intro x. + destruct (H0 x) as (y,(HR'xy,Huniq)). + rewrite <- (Huniq (f x) (Hf x)). + apply HR'R; assumption. Qed. Lemma funct_choice_imp_rel_choice : forall A B, FunctionalChoice_on A B -> RelationalChoice_on A B. Proof. -intros A B FunCh R H. -destruct (FunCh R H) as (f,H0). -exists (fun x y => f x = y). -split. + intros A B FunCh R H. + destruct (FunCh R H) as (f,H0). + exists (fun x y => f x = y). + split. intros x y Heq; rewrite <- Heq; trivial. intro x; exists (f x); split. reflexivity. @@ -279,77 +279,77 @@ Qed. Lemma funct_choice_imp_description : forall A B, FunctionalChoice_on A B -> FunctionalRelReification_on A B. Proof. -intros A B FunCh R H. -destruct (FunCh R) as [f H0]. -(* 1 *) -intro x. -destruct (H x) as (y,(HRxy,_)). -exists y; exact HRxy. -(* 2 *) -exists f; exact H0. + intros A B FunCh R H. + destruct (FunCh R) as [f H0]. + (* 1 *) + intro x. + destruct (H x) as (y,(HRxy,_)). + exists y; exact HRxy. + (* 2 *) + exists f; exact H0. Qed. Theorem FunChoice_Equiv_RelChoice_and_ParamDefinDescr : forall A B, FunctionalChoice_on A B <-> RelationalChoice_on A B /\ FunctionalRelReification_on A B. Proof. -intros A B; split. -intro H; split; - [ exact (funct_choice_imp_rel_choice H) - | exact (funct_choice_imp_description H) ]. -intros [H H0]; exact (description_rel_choice_imp_funct_choice H0 H). + intros A B; split. + intro H; split; + [ exact (funct_choice_imp_rel_choice H) + | exact (funct_choice_imp_description H) ]. + intros [H H0]; exact (description_rel_choice_imp_funct_choice H0 H). Qed. (**********************************************************************) -(** *** C. Connection between the guarded, non guarded and descriptive choices and *) +(** * Connection between the guarded, non guarded and descriptive choices and *) (** We show that the guarded relational formulation of the axiom of Choice comes from the non guarded formulation in presence either of the independance of premises or proof-irrelevance *) (**********************************************************************) -(** **** C. 1. AC_rel + PI -> GAC_rel and AC_rel + IGP -> GAC_rel and GAC_rel = OAC_rel *) +(** ** AC_rel + PI -> GAC_rel and AC_rel + IGP -> GAC_rel and GAC_rel = OAC_rel *) Lemma rel_choice_and_proof_irrel_imp_guarded_rel_choice : RelationalChoice -> ProofIrrelevance -> GuardedRelationalChoice. Proof. -intros rel_choice proof_irrel. -red in |- *; intros A B P R H. -destruct (rel_choice _ _ (fun (x:sigT P) (y:B) => R (projT1 x) y)) as (R',(HR'R,H0)). -intros (x,HPx). -destruct (H x HPx) as (y,HRxy). -exists y; exact HRxy. -set (R'' := fun (x:A) (y:B) => exists H : P x, R' (existT P x H) y). -exists R''; split. + intros rel_choice proof_irrel. + red in |- *; intros A B P R H. + destruct (rel_choice _ _ (fun (x:sigT P) (y:B) => R (projT1 x) y)) as (R',(HR'R,H0)). + intros (x,HPx). + destruct (H x HPx) as (y,HRxy). + exists y; exact HRxy. + set (R'' := fun (x:A) (y:B) => exists H : P x, R' (existT P x H) y). + exists R''; split. intros x y (HPx,HR'xy). change x with (projT1 (existT P x HPx)); apply HR'R; exact HR'xy. intros x HPx. destruct (H0 (existT P x HPx)) as (y,(HR'xy,Huniq)). - exists y; split. exists HPx; exact HR'xy. - intros y' (H'Px,HR'xy'). - apply Huniq. - rewrite proof_irrel with (a1 := HPx) (a2 := H'Px); exact HR'xy'. + exists y; split. exists HPx; exact HR'xy. + intros y' (H'Px,HR'xy'). + apply Huniq. + rewrite proof_irrel with (a1 := HPx) (a2 := H'Px); exact HR'xy'. Qed. Lemma rel_choice_indep_of_general_premises_imp_guarded_rel_choice : - forall A B, inhabited B -> RelationalChoice_on A B -> - IndependenceOfGeneralPremises -> GuardedRelationalChoice_on A B. + forall A B, inhabited B -> RelationalChoice_on A B -> + IndependenceOfGeneralPremises -> GuardedRelationalChoice_on A B. Proof. -intros A B Inh AC_rel IndPrem P R H. -destruct (AC_rel (fun x y => P x -> R x y)) as (R',(HR'R,H0)). + intros A B Inh AC_rel IndPrem P R H. + destruct (AC_rel (fun x y => P x -> R x y)) as (R',(HR'R,H0)). intro x. apply IndPrem. exact Inh. intro Hx. - apply H; assumption. + apply H; assumption. exists (fun x y => P x /\ R' x y). firstorder. Qed. Lemma guarded_rel_choice_imp_rel_choice : - forall A B, GuardedRelationalChoice_on A B -> RelationalChoice_on A B. + forall A B, GuardedRelationalChoice_on A B -> RelationalChoice_on A B. Proof. -intros A B GAC_rel R H. -destruct (GAC_rel (fun _ => True) R) as (R',(HR'R,H0)). + intros A B GAC_rel R H. + destruct (GAC_rel (fun _ => True) R) as (R',(HR'R,H0)). firstorder. -exists R'; firstorder. + exists R'; firstorder. Qed. (** OAC_rel = GAC_rel *) @@ -357,43 +357,43 @@ Qed. Lemma guarded_iff_omniscient_rel_choice : GuardedRelationalChoice <-> OmniscientRelationalChoice. Proof. -split. + split. intros GAC_rel A B R. - apply (GAC_rel A B (fun x => exists y, R x y) R); auto. + apply (GAC_rel A B (fun x => exists y, R x y) R); auto. intros OAC_rel A B P R H. - destruct (OAC_rel A B R) as (f,Hf); exists f; firstorder. + destruct (OAC_rel A B R) as (f,Hf); exists f; firstorder. Qed. (**********************************************************************) -(** **** C. 2. AC_fun + IGP = GAC_fun = OAC_fun = AC_fun + Drinker *) +(** ** AC_fun + IGP = GAC_fun = OAC_fun = AC_fun + Drinker *) (** AC_fun + IGP = GAC_fun *) Lemma guarded_fun_choice_imp_indep_of_general_premises : - GuardedFunctionalChoice -> IndependenceOfGeneralPremises. + GuardedFunctionalChoice -> IndependenceOfGeneralPremises. Proof. -intros GAC_fun A P Q Inh H. -destruct (GAC_fun unit A (fun _ => Q) (fun _ => P) Inh) as (f,Hf). -tauto. -exists (f tt); auto. + intros GAC_fun A P Q Inh H. + destruct (GAC_fun unit A (fun _ => Q) (fun _ => P) Inh) as (f,Hf). + tauto. + exists (f tt); auto. Qed. Lemma guarded_fun_choice_imp_fun_choice : - GuardedFunctionalChoice -> FunctionalChoiceOnInhabitedSet. + GuardedFunctionalChoice -> FunctionalChoiceOnInhabitedSet. Proof. -intros GAC_fun A B Inh R H. -destruct (GAC_fun A B (fun _ => True) R Inh) as (f,Hf). -firstorder. -exists f; auto. + intros GAC_fun A B Inh R H. + destruct (GAC_fun A B (fun _ => True) R Inh) as (f,Hf). + firstorder. + exists f; auto. Qed. Lemma fun_choice_and_indep_general_prem_imp_guarded_fun_choice : FunctionalChoiceOnInhabitedSet -> IndependenceOfGeneralPremises -> GuardedFunctionalChoice. Proof. -intros AC_fun IndPrem A B P R Inh H. -apply (AC_fun A B Inh (fun x y => P x -> R x y)). -intro x; apply IndPrem; eauto. + intros AC_fun IndPrem A B P R Inh H. + apply (AC_fun A B Inh (fun x y => P x -> R x y)). + intro x; apply IndPrem; eauto. Qed. (** AC_fun + Drinker = OAC_fun *) @@ -403,26 +403,26 @@ Qed. Lemma omniscient_fun_choice_imp_small_drinker : OmniscientFunctionalChoice -> SmallDrinker'sParadox. Proof. -intros OAC_fun A P Inh. -destruct (OAC_fun unit A (fun _ => P)) as (f,Hf). -auto. -exists (f tt); firstorder. + intros OAC_fun A P Inh. + destruct (OAC_fun unit A (fun _ => P)) as (f,Hf). + auto. + exists (f tt); firstorder. Qed. Lemma omniscient_fun_choice_imp_fun_choice : OmniscientFunctionalChoice -> FunctionalChoiceOnInhabitedSet. Proof. -intros OAC_fun A B Inh R H. -destruct (OAC_fun A B R Inh) as (f,Hf). -exists f; firstorder. + intros OAC_fun A B Inh R H. + destruct (OAC_fun A B R Inh) as (f,Hf). + exists f; firstorder. Qed. Lemma fun_choice_and_small_drinker_imp_omniscient_fun_choice : FunctionalChoiceOnInhabitedSet -> SmallDrinker'sParadox -> OmniscientFunctionalChoice. Proof. -intros AC_fun Drinker A B R Inh. -destruct (AC_fun A B Inh (fun x y => (exists y, R x y) -> R x y)) as (f,Hf). + intros AC_fun Drinker A B R Inh. + destruct (AC_fun A B Inh (fun x y => (exists y, R x y) -> R x y)) as (f,Hf). intro x; apply (Drinker B (R x) Inh). exists f; assumption. Qed. @@ -435,16 +435,16 @@ but we give a direct proof *) Lemma guarded_iff_omniscient_fun_choice : GuardedFunctionalChoice <-> OmniscientFunctionalChoice. Proof. -split. + split. intros GAC_fun A B R Inh. - apply (GAC_fun A B (fun x => exists y, R x y) R); auto. + apply (GAC_fun A B (fun x => exists y, R x y) R); auto. intros OAC_fun A B P R Inh H. - destruct (OAC_fun A B R Inh) as (f,Hf). - exists f; firstorder. + destruct (OAC_fun A B R Inh) as (f,Hf). + exists f; firstorder. Qed. (**********************************************************************) -(** *** D. Derivability of choice for decidable relations with well-ordered codomain *) +(** * Derivability of choice for decidable relations with well-ordered codomain *) (** Countable codomains, such as [nat], can be equipped with a well-order, which implies the existence of a least element on @@ -468,10 +468,10 @@ Lemma dec_inh_nat_subset_has_unique_least_element : forall P:nat->Prop, (forall n, P n \/ ~ P n) -> (exists n, P n) -> has_unique_least_element le P. Proof. -intros P Pdec (n0,HPn0). -assert - (forall n, (exists n', n'<n /\ P n' /\ forall n'', P n'' -> n'<=n'') - \/(forall n', P n' -> n<=n')). + intros P Pdec (n0,HPn0). + assert + (forall n, (exists n', n'<n /\ P n' /\ forall n'', P n'' -> n'<=n'') + \/(forall n', P n' -> n<=n')). induction n. right. intros n' Hn'. @@ -493,43 +493,43 @@ assert destruct H0. rewrite Heqn; assumption. destruct (H n0) as [(n,(Hltn,(Hmin,Huniqn)))|]; [exists n | exists n0]; - repeat split; - assumption || intros n' (HPn',Hminn'); apply le_antisym; auto. + repeat split; + assumption || intros n' (HPn',Hminn'); apply le_antisym; auto. Qed. Definition FunctionalChoice_on_rel (A B:Type) (R:A->B->Prop) := (forall x:A, exists y : B, R x y) -> - exists f : A -> B, (forall x:A, R x (f x)). + exists f : A -> B, (forall x:A, R x (f x)). Lemma classical_denumerable_description_imp_fun_choice : forall A:Type, - FunctionalRelReification_on A nat -> - forall R:A->nat->Prop, - (forall x y, decidable (R x y)) -> FunctionalChoice_on_rel R. + FunctionalRelReification_on A nat -> + forall R:A->nat->Prop, + (forall x y, decidable (R x y)) -> FunctionalChoice_on_rel R. Proof. -intros A Descr. -red in |- *; intros R Rdec H. -set (R':= fun x y => R x y /\ forall y', R x y' -> y <= y'). -destruct (Descr R') as (f,Hf). + intros A Descr. + red in |- *; intros R Rdec H. + set (R':= fun x y => R x y /\ forall y', R x y' -> y <= y'). + destruct (Descr R') as (f,Hf). intro x. apply (dec_inh_nat_subset_has_unique_least_element (R x)). apply Rdec. apply (H x). -exists f. -intros x. -destruct (Hf x) as (Hfx,_). -assumption. + exists f. + intros x. + destruct (Hf x) as (Hfx,_). + assumption. Qed. (**********************************************************************) -(** *** E. Choice on dependent and non dependent function types are equivalent *) +(** * Choice on dependent and non dependent function types are equivalent *) -(** **** E. 1. Choice on dependent and non dependent function types are equivalent *) +(** ** Choice on dependent and non dependent function types are equivalent *) Definition DependentFunctionalChoice_on (A:Type) (B:A -> Type) := forall R:forall x:A, B x -> Prop, - (forall x:A, exists y : B x, R x y) -> - (exists f : (forall x:A, B x), forall x:A, R x (f x)). + (forall x:A, exists y : B x, R x y) -> + (exists f : (forall x:A, B x), forall x:A, R x (f x)). Notation DependentFunctionalChoice := (forall A (B:A->Type), DependentFunctionalChoice_on B). @@ -539,7 +539,7 @@ Notation DependentFunctionalChoice := Theorem dep_non_dep_functional_choice : DependentFunctionalChoice -> FunctionalChoice. Proof. -intros AC_depfun A B R H. + intros AC_depfun A B R H. destruct (AC_depfun A (fun _ => B) R H) as (f,Hf). exists f; trivial. Qed. @@ -558,24 +558,24 @@ Definition proj1_inf (A B:Prop) (p : A/\B) := Theorem non_dep_dep_functional_choice : FunctionalChoice -> DependentFunctionalChoice. Proof. -intros AC_fun A B R H. -pose (B' := { x:A & B x }). -pose (R' := fun (x:A) (y:B') => projT1 y = x /\ R (projT1 y) (projT2 y)). -destruct (AC_fun A B' R') as (f,Hf). -intros x. destruct (H x) as (y,Hy). -exists (existT (fun x => B x) x y). split; trivial. -exists (fun x => eq_rect _ _ (projT2 (f x)) _ (proj1_inf (Hf x))). -intro x; destruct (Hf x) as (Heq,HR) using and_indd. -destruct (f x); simpl in *. -destruct Heq using eq_indd; trivial. + intros AC_fun A B R H. + pose (B' := { x:A & B x }). + pose (R' := fun (x:A) (y:B') => projT1 y = x /\ R (projT1 y) (projT2 y)). + destruct (AC_fun A B' R') as (f,Hf). + intros x. destruct (H x) as (y,Hy). + exists (existT (fun x => B x) x y). split; trivial. + exists (fun x => eq_rect _ _ (projT2 (f x)) _ (proj1_inf (Hf x))). + intro x; destruct (Hf x) as (Heq,HR) using and_indd. + destruct (f x); simpl in *. + destruct Heq using eq_indd; trivial. Qed. -(** **** E. 2. Reification of dependent and non dependent functional relation are equivalent *) +(** ** Reification of dependent and non dependent functional relation are equivalent *) Definition DependentFunctionalRelReification_on (A:Type) (B:A -> Type) := forall (R:forall x:A, B x -> Prop), - (forall x:A, exists! y : B x, R x y) -> - (exists f : (forall x:A, B x), forall x:A, R x (f x)). + (forall x:A, exists! y : B x, R x y) -> + (exists f : (forall x:A, B x), forall x:A, R x (f x)). Notation DependentFunctionalRelReification := (forall A (B:A->Type), DependentFunctionalRelReification_on B). @@ -585,7 +585,7 @@ Notation DependentFunctionalRelReification := Theorem dep_non_dep_functional_rel_reification : DependentFunctionalRelReification -> FunctionalRelReification. Proof. -intros DepFunReify A B R H. + intros DepFunReify A B R H. destruct (DepFunReify A (fun _ => B) R H) as (f,Hf). exists f; trivial. Qed. @@ -598,91 +598,91 @@ Qed. Theorem non_dep_dep_functional_rel_reification : FunctionalRelReification -> DependentFunctionalRelReification. Proof. -intros AC_fun A B R H. -pose (B' := { x:A & B x }). -pose (R' := fun (x:A) (y:B') => projT1 y = x /\ R (projT1 y) (projT2 y)). -destruct (AC_fun A B' R') as (f,Hf). -intros x. destruct (H x) as (y,(Hy,Huni)). + intros AC_fun A B R H. + pose (B' := { x:A & B x }). + pose (R' := fun (x:A) (y:B') => projT1 y = x /\ R (projT1 y) (projT2 y)). + destruct (AC_fun A B' R') as (f,Hf). + intros x. destruct (H x) as (y,(Hy,Huni)). exists (existT (fun x => B x) x y). repeat split; trivial. intros (x',y') (Heqx',Hy'). simpl in *. destruct Heqx'. rewrite (Huni y'); trivial. -exists (fun x => eq_rect _ _ (projT2 (f x)) _ (proj1_inf (Hf x))). -intro x; destruct (Hf x) as (Heq,HR) using and_indd. -destruct (f x); simpl in *. -destruct Heq using eq_indd; trivial. + exists (fun x => eq_rect _ _ (projT2 (f x)) _ (proj1_inf (Hf x))). + intro x; destruct (Hf x) as (Heq,HR) using and_indd. + destruct (f x); simpl in *. + destruct Heq using eq_indd; trivial. Qed. (**********************************************************************) -(** *** F. Non contradiction of constructive descriptions wrt functional axioms of choice *) +(** * Non contradiction of constructive descriptions wrt functional axioms of choice *) -(** **** F. 1. Non contradiction of indefinite description *) +(** ** Non contradiction of indefinite description *) Lemma relative_non_contradiction_of_indefinite_desc : - (ConstructiveIndefiniteDescription -> False) - -> (FunctionalChoice -> False). + (ConstructiveIndefiniteDescription -> False) + -> (FunctionalChoice -> False). Proof. -intros H AC_fun. -assert (AC_depfun := non_dep_dep_functional_choice AC_fun). -pose (A0 := { A:Type & { P:A->Prop & exists x, P x }}). -pose (B0 := fun x:A0 => projT1 x). -pose (R0 := fun x:A0 => fun y:B0 x => projT1 (projT2 x) y). -pose (H0 := fun x:A0 => projT2 (projT2 x)). -destruct (AC_depfun A0 B0 R0 H0) as (f, Hf). -apply H. -intros A P H'. -exists (f (existT (fun _ => sigT _) A - (existT (fun P => exists x, P x) P H'))). -pose (Hf' := - Hf (existT (fun _ => sigT _) A - (existT (fun P => exists x, P x) P H'))). -assumption. + intros H AC_fun. + assert (AC_depfun := non_dep_dep_functional_choice AC_fun). + pose (A0 := { A:Type & { P:A->Prop & exists x, P x }}). + pose (B0 := fun x:A0 => projT1 x). + pose (R0 := fun x:A0 => fun y:B0 x => projT1 (projT2 x) y). + pose (H0 := fun x:A0 => projT2 (projT2 x)). + destruct (AC_depfun A0 B0 R0 H0) as (f, Hf). + apply H. + intros A P H'. + exists (f (existT (fun _ => sigT _) A + (existT (fun P => exists x, P x) P H'))). + pose (Hf' := + Hf (existT (fun _ => sigT _) A + (existT (fun P => exists x, P x) P H'))). + assumption. Qed. Lemma constructive_indefinite_descr_fun_choice : - ConstructiveIndefiniteDescription -> FunctionalChoice. + ConstructiveIndefiniteDescription -> FunctionalChoice. Proof. -intros IndefDescr A B R H. -exists (fun x => proj1_sig (IndefDescr B (R x) (H x))). -intro x. -apply (proj2_sig (IndefDescr B (R x) (H x))). + intros IndefDescr A B R H. + exists (fun x => proj1_sig (IndefDescr B (R x) (H x))). + intro x. + apply (proj2_sig (IndefDescr B (R x) (H x))). Qed. -(** **** F. 2. Non contradiction of definite description *) +(** ** Non contradiction of definite description *) Lemma relative_non_contradiction_of_definite_descr : - (ConstructiveDefiniteDescription -> False) - -> (FunctionalRelReification -> False). + (ConstructiveDefiniteDescription -> False) + -> (FunctionalRelReification -> False). Proof. -intros H FunReify. -assert (DepFunReify := non_dep_dep_functional_rel_reification FunReify). -pose (A0 := { A:Type & { P:A->Prop & exists! x, P x }}). -pose (B0 := fun x:A0 => projT1 x). -pose (R0 := fun x:A0 => fun y:B0 x => projT1 (projT2 x) y). -pose (H0 := fun x:A0 => projT2 (projT2 x)). -destruct (DepFunReify A0 B0 R0 H0) as (f, Hf). -apply H. -intros A P H'. -exists (f (existT (fun _ => sigT _) A - (existT (fun P => exists! x, P x) P H'))). -pose (Hf' := - Hf (existT (fun _ => sigT _) A - (existT (fun P => exists! x, P x) P H'))). -assumption. + intros H FunReify. + assert (DepFunReify := non_dep_dep_functional_rel_reification FunReify). + pose (A0 := { A:Type & { P:A->Prop & exists! x, P x }}). + pose (B0 := fun x:A0 => projT1 x). + pose (R0 := fun x:A0 => fun y:B0 x => projT1 (projT2 x) y). + pose (H0 := fun x:A0 => projT2 (projT2 x)). + destruct (DepFunReify A0 B0 R0 H0) as (f, Hf). + apply H. + intros A P H'. + exists (f (existT (fun _ => sigT _) A + (existT (fun P => exists! x, P x) P H'))). + pose (Hf' := + Hf (existT (fun _ => sigT _) A + (existT (fun P => exists! x, P x) P H'))). + assumption. Qed. Lemma constructive_definite_descr_fun_reification : - ConstructiveDefiniteDescription -> FunctionalRelReification. + ConstructiveDefiniteDescription -> FunctionalRelReification. Proof. -intros DefDescr A B R H. -exists (fun x => proj1_sig (DefDescr B (R x) (H x))). -intro x. -apply (proj2_sig (DefDescr B (R x) (H x))). + intros DefDescr A B R H. + exists (fun x => proj1_sig (DefDescr B (R x) (H x))). + intro x. + apply (proj2_sig (DefDescr B (R x) (H x))). Qed. (**********************************************************************) -(** *** G. Excluded-middle + definite description => computational excluded-middle *) +(** * Excluded-middle + definite description => computational excluded-middle *) (** The idea for the following proof comes from [ChicliPottierSimpson02] *) @@ -705,15 +705,15 @@ Theorem constructive_definite_descr_excluded_middle : ConstructiveDefiniteDescription -> (forall P:Prop, P \/ ~ P) -> (forall P:Prop, {P} + {~ P}). Proof. -intros Descr EM P. -pose (select := fun b:bool => if b then P else ~P). -assert { b:bool | select b } as ([|],HP). + intros Descr EM P. + pose (select := fun b:bool => if b then P else ~P). + assert { b:bool | select b } as ([|],HP). apply Descr. rewrite <- unique_existence; split. destruct (EM P). - exists true; trivial. - exists false; trivial. - intros [|] [|] H1 H2; simpl in *; reflexivity || contradiction. -left; trivial. -right; trivial. + exists true; trivial. + exists false; trivial. + intros [|] [|] H1 H2; simpl in *; reflexivity || contradiction. + left; trivial. + right; trivial. Qed. diff --git a/theories/Logic/ClassicalEpsilon.v b/theories/Logic/ClassicalEpsilon.v index b7293bec..6d0a9c77 100644 --- a/theories/Logic/ClassicalEpsilon.v +++ b/theories/Logic/ClassicalEpsilon.v @@ -6,9 +6,9 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: ClassicalEpsilon.v 8933 2006-06-09 14:08:38Z herbelin $ i*) +(*i $Id: ClassicalEpsilon.v 9245 2006-10-17 12:53:34Z notin $ i*) -(** *** This file provides classical logic and indefinite description +(** This file provides classical logic and indefinite description (Hilbert's epsilon operator) *) (** Classical epsilon's operator (i.e. indefinite description) implies @@ -21,37 +21,39 @@ Require Import ChoiceFacts. Set Implicit Arguments. -Notation Local "'inhabited' A" := A (at level 200, only parsing). - Axiom constructive_indefinite_description : forall (A : Type) (P : A->Prop), - (ex P) -> { x : A | P x }. + (exists x, P x) -> { x : A | P x }. Lemma constructive_definite_description : forall (A : Type) (P : A->Prop), - (exists! x : A, P x) -> { x : A | P x }. + (exists! x, P x) -> { x : A | P x }. Proof. -intros; apply constructive_indefinite_description; firstorder. + intros; apply constructive_indefinite_description; firstorder. Qed. Theorem excluded_middle_informative : forall P:Prop, {P} + {~ P}. Proof. -apply - (constructive_definite_descr_excluded_middle - constructive_definite_description classic). + apply + (constructive_definite_descr_excluded_middle + constructive_definite_description classic). Qed. Theorem classical_indefinite_description : forall (A : Type) (P : A->Prop), inhabited A -> - { x : A | ex P -> P x }. + { x : A | (exists x, P x) -> P x }. Proof. -intros A P i. -destruct (excluded_middle_informative (exists x, P x)) as [Hex|HnonP]. - apply constructive_indefinite_description with (P:= fun x => ex P -> P x). + intros A P i. + destruct (excluded_middle_informative (exists x, P x)) as [Hex|HnonP]. + apply constructive_indefinite_description + with (P:= fun x => (exists x, P x) -> P x). destruct Hex as (x,Hx). exists x; intros _; exact Hx. - firstorder. -Qed. + assert {x : A | True} as (a,_). + apply constructive_indefinite_description with (P := fun _ : A => True). + destruct i as (a); firstorder. + firstorder. +Defined. (** Hilbert's epsilon operator *) @@ -59,11 +61,9 @@ Definition epsilon (A : Type) (i:inhabited A) (P : A->Prop) : A := proj1_sig (classical_indefinite_description P i). Definition epsilon_spec (A : Type) (i:inhabited A) (P : A->Prop) : - (ex P) -> P (epsilon i P) + (exists x, P x) -> P (epsilon i P) := proj2_sig (classical_indefinite_description P i). -Opaque epsilon. - (** Open question: is classical_indefinite_description constructively provable from [relational_choice] and [constructive_definite_description] (at least, using the fact that @@ -72,19 +72,31 @@ Opaque epsilon. [classical_indefinite_description] is provable (see [relative_non_contradiction_of_indefinite_desc]). *) -(** Remark: we use [ex P] rather than [exists x, P x] (which is [ex - (fun x => P x)] to ease unification *) +(** A proof that if [P] is inhabited, [epsilon a P] does not depend on + the actual proof that the domain of [P] is inhabited + (proof idea kindly provided by Pierre Castéran) *) + +Lemma epsilon_inh_irrelevance : + forall (A:Type) (i j : inhabited A) (P:A->Prop), + (exists x, P x) -> epsilon i P = epsilon j P. +Proof. + intros. + unfold epsilon, classical_indefinite_description. + destruct (excluded_middle_informative (exists x : A, P x)) as [|[]]; trivial. +Qed. + +Opaque epsilon. (** *** Weaker lemmas (compatibility lemmas) *) Theorem choice : - forall (A B : Type) (R : A->B->Prop), - (forall x : A, exists y : B, R x y) -> - (exists f : A->B, forall x : A, R x (f x)). + forall (A B : Type) (R : A->B->Prop), + (forall x : A, exists y : B, R x y) -> + (exists f : A->B, forall x : A, R x (f x)). Proof. -intros A B R H. -exists (fun x => proj1_sig (constructive_indefinite_description (H x))). -intro x. -apply (proj2_sig (constructive_indefinite_description (H x))). + intros A B R H. + exists (fun x => proj1_sig (constructive_indefinite_description _ (H x))). + intro x. + apply (proj2_sig (constructive_indefinite_description _ (H x))). Qed. diff --git a/theories/Logic/ClassicalFacts.v b/theories/Logic/ClassicalFacts.v index 70da74d3..dd911db6 100644 --- a/theories/Logic/ClassicalFacts.v +++ b/theories/Logic/ClassicalFacts.v @@ -7,39 +7,39 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: ClassicalFacts.v 8892 2006-06-04 17:59:53Z herbelin $ i*) +(*i $Id: ClassicalFacts.v 9245 2006-10-17 12:53:34Z notin $ i*) -(** ** Some facts and definitions about classical logic +(** Some facts and definitions about classical logic Table of contents: -A. Propositional degeneracy = excluded-middle + propositional extensionality +1. Propositional degeneracy = excluded-middle + propositional extensionality -B. Classical logic and proof-irrelevance +2. Classical logic and proof-irrelevance -B. 1. CC |- prop. ext. + A inhabited -> (A = A->A) -> A has fixpoint +2.1. CC |- prop. ext. + A inhabited -> (A = A->A) -> A has fixpoint -B. 2. CC |- prop. ext. + dep elim on bool -> proof-irrelevance +2.2. CC |- prop. ext. + dep elim on bool -> proof-irrelevance -B. 3. CIC |- prop. ext. -> proof-irrelevance +2.3. CIC |- prop. ext. -> proof-irrelevance -B. 4. CC |- excluded-middle + dep elim on bool -> proof-irrelevance +2.4. CC |- excluded-middle + dep elim on bool -> proof-irrelevance -B. 5. CIC |- excluded-middle -> proof-irrelevance +2.5. CIC |- excluded-middle -> proof-irrelevance -C. Weak classical axioms +3. Weak classical axioms -C. 1. Weak excluded middle +3.1. Weak excluded middle -C. 2. Gödel-Dummet axiom and right distributivity of implication over +3.2. Gödel-Dummet axiom and right distributivity of implication over disjunction -C. 3. Independence of general premises and drinker's paradox +3 3. Independence of general premises and drinker's paradox *) (************************************************************************) -(** *** A. Prop degeneracy = excluded-middle + prop extensionality *) +(** * Prop degeneracy = excluded-middle + prop extensionality *) (** i.e. [(forall A, A=True \/ A=False) <-> @@ -61,41 +61,41 @@ Definition excluded_middle := forall A:Prop, A \/ ~ A. Lemma prop_degen_ext : prop_degeneracy -> prop_extensionality. Proof. -intros H A B [Hab Hba]. -destruct (H A); destruct (H B). - rewrite H1; exact H0. - absurd B. - rewrite H1; exact (fun H => H). - apply Hab; rewrite H0; exact I. - absurd A. - rewrite H0; exact (fun H => H). - apply Hba; rewrite H1; exact I. - rewrite H1; exact H0. + intros H A B [Hab Hba]. + destruct (H A); destruct (H B). + rewrite H1; exact H0. + absurd B. + rewrite H1; exact (fun H => H). + apply Hab; rewrite H0; exact I. + absurd A. + rewrite H0; exact (fun H => H). + apply Hba; rewrite H1; exact I. + rewrite H1; exact H0. Qed. Lemma prop_degen_em : prop_degeneracy -> excluded_middle. Proof. -intros H A. -destruct (H A). - left; rewrite H0; exact I. - right; rewrite H0; exact (fun x => x). + intros H A. + destruct (H A). + left; rewrite H0; exact I. + right; rewrite H0; exact (fun x => x). Qed. Lemma prop_ext_em_degen : - prop_extensionality -> excluded_middle -> prop_degeneracy. + prop_extensionality -> excluded_middle -> prop_degeneracy. Proof. -intros Ext EM A. -destruct (EM A). - left; apply (Ext A True); split; - [ exact (fun _ => I) | exact (fun _ => H) ]. - right; apply (Ext A False); split; [ exact H | apply False_ind ]. + intros Ext EM A. + destruct (EM A). + left; apply (Ext A True); split; + [ exact (fun _ => I) | exact (fun _ => H) ]. + right; apply (Ext A False); split; [ exact H | apply False_ind ]. Qed. (************************************************************************) -(** *** B. Classical logic and proof-irrelevance *) +(** * Classical logic and proof-irrelevance *) (************************************************************************) -(** **** B. 1. CC |- prop ext + A inhabited -> (A = A->A) -> A has fixpoint *) +(** ** CC |- prop ext + A inhabited -> (A = A->A) -> A has fixpoint *) (** We successively show that: @@ -110,41 +110,41 @@ Qed. Definition inhabited (A:Prop) := A. Lemma prop_ext_A_eq_A_imp_A : - prop_extensionality -> forall A:Prop, inhabited A -> (A -> A) = A. + prop_extensionality -> forall A:Prop, inhabited A -> (A -> A) = A. Proof. -intros Ext A a. -apply (Ext (A -> A) A); split; [ exact (fun _ => a) | exact (fun _ _ => a) ]. + intros Ext A a. + apply (Ext (A -> A) A); split; [ exact (fun _ => a) | exact (fun _ _ => a) ]. Qed. Record retract (A B:Prop) : Prop := {f1 : A -> B; f2 : B -> A; f1_o_f2 : forall x:B, f1 (f2 x) = x}. Lemma prop_ext_retract_A_A_imp_A : - prop_extensionality -> forall A:Prop, inhabited A -> retract A (A -> A). + prop_extensionality -> forall A:Prop, inhabited A -> retract A (A -> A). Proof. -intros Ext A a. -rewrite (prop_ext_A_eq_A_imp_A Ext A a). -exists (fun x:A => x) (fun x:A => x). -reflexivity. + intros Ext A a. + rewrite (prop_ext_A_eq_A_imp_A Ext A a). + exists (fun x:A => x) (fun x:A => x). + reflexivity. Qed. Record has_fixpoint (A:Prop) : Prop := {F : (A -> A) -> A; Fix : forall f:A -> A, F f = f (F f)}. Lemma ext_prop_fixpoint : - prop_extensionality -> forall A:Prop, inhabited A -> has_fixpoint A. + prop_extensionality -> forall A:Prop, inhabited A -> has_fixpoint A. Proof. -intros Ext A a. -case (prop_ext_retract_A_A_imp_A Ext A a); intros g1 g2 g1_o_g2. -exists (fun f => (fun x:A => f (g1 x x)) (g2 (fun x => f (g1 x x)))). -intro f. -pattern (g1 (g2 (fun x:A => f (g1 x x)))) at 1 in |- *. -rewrite (g1_o_g2 (fun x:A => f (g1 x x))). -reflexivity. + intros Ext A a. + case (prop_ext_retract_A_A_imp_A Ext A a); intros g1 g2 g1_o_g2. + exists (fun f => (fun x:A => f (g1 x x)) (g2 (fun x => f (g1 x x)))). + intro f. + pattern (g1 (g2 (fun x:A => f (g1 x x)))) at 1 in |- *. + rewrite (g1_o_g2 (fun x:A => f (g1 x x))). + reflexivity. Qed. (************************************************************************) -(** **** B. 2. CC |- prop_ext /\ dep elim on bool -> proof-irrelevance *) +(** ** CC |- prop_ext /\ dep elim on bool -> proof-irrelevance *) (** [proof_irrelevance] asserts equality of all proofs of a given formula *) Definition proof_irrelevance := forall (A:Prop) (a1 a2:A), a1 = a2. @@ -161,44 +161,44 @@ Definition proof_irrelevance := forall (A:Prop) (a1 a2:A), a1 = a2. Section Proof_irrelevance_gen. -Variable bool : Prop. -Variable true : bool. -Variable false : bool. -Hypothesis bool_elim : forall C:Prop, C -> C -> bool -> C. -Hypothesis - bool_elim_redl : forall (C:Prop) (c1 c2:C), c1 = bool_elim C c1 c2 true. -Hypothesis - bool_elim_redr : forall (C:Prop) (c1 c2:C), c2 = bool_elim C c1 c2 false. -Let bool_dep_induction := + Variable bool : Prop. + Variable true : bool. + Variable false : bool. + Hypothesis bool_elim : forall C:Prop, C -> C -> bool -> C. + Hypothesis + bool_elim_redl : forall (C:Prop) (c1 c2:C), c1 = bool_elim C c1 c2 true. + Hypothesis + bool_elim_redr : forall (C:Prop) (c1 c2:C), c2 = bool_elim C c1 c2 false. + Let bool_dep_induction := forall P:bool -> Prop, P true -> P false -> forall b:bool, P b. -Lemma aux : prop_extensionality -> bool_dep_induction -> true = false. -Proof. -intros Ext Ind. -case (ext_prop_fixpoint Ext bool true); intros G Gfix. -set (neg := fun b:bool => bool_elim bool false true b). -generalize (refl_equal (G neg)). -pattern (G neg) at 1 in |- *. -apply Ind with (b := G neg); intro Heq. -rewrite (bool_elim_redl bool false true). -change (true = neg true) in |- *; rewrite Heq; apply Gfix. -rewrite (bool_elim_redr bool false true). -change (neg false = false) in |- *; rewrite Heq; symmetry in |- *; - apply Gfix. -Qed. - -Lemma ext_prop_dep_proof_irrel_gen : - prop_extensionality -> bool_dep_induction -> proof_irrelevance. -Proof. -intros Ext Ind A a1 a2. -set (f := fun b:bool => bool_elim A a1 a2 b). -rewrite (bool_elim_redl A a1 a2). -change (f true = a2) in |- *. -rewrite (bool_elim_redr A a1 a2). -change (f true = f false) in |- *. -rewrite (aux Ext Ind). -reflexivity. -Qed. + Lemma aux : prop_extensionality -> bool_dep_induction -> true = false. + Proof. + intros Ext Ind. + case (ext_prop_fixpoint Ext bool true); intros G Gfix. + set (neg := fun b:bool => bool_elim bool false true b). + generalize (refl_equal (G neg)). + pattern (G neg) at 1 in |- *. + apply Ind with (b := G neg); intro Heq. + rewrite (bool_elim_redl bool false true). + change (true = neg true) in |- *; rewrite Heq; apply Gfix. + rewrite (bool_elim_redr bool false true). + change (neg false = false) in |- *; rewrite Heq; symmetry in |- *; + apply Gfix. + Qed. + + Lemma ext_prop_dep_proof_irrel_gen : + prop_extensionality -> bool_dep_induction -> proof_irrelevance. + Proof. + intros Ext Ind A a1 a2. + set (f := fun b:bool => bool_elim A a1 a2 b). + rewrite (bool_elim_redl A a1 a2). + change (f true = a2) in |- *. + rewrite (bool_elim_redr A a1 a2). + change (f true = f false) in |- *. + rewrite (aux Ext Ind). + reflexivity. + Qed. End Proof_irrelevance_gen. @@ -208,29 +208,30 @@ End Proof_irrelevance_gen. *) Section Proof_irrelevance_Prop_Ext_CC. - -Definition BoolP := forall C:Prop, C -> C -> C. -Definition TrueP : BoolP := fun C c1 c2 => c1. -Definition FalseP : BoolP := fun C c1 c2 => c2. -Definition BoolP_elim C c1 c2 (b:BoolP) := b C c1 c2. -Definition BoolP_elim_redl (C:Prop) (c1 c2:C) : - c1 = BoolP_elim C c1 c2 TrueP := refl_equal c1. -Definition BoolP_elim_redr (C:Prop) (c1 c2:C) : - c2 = BoolP_elim C c1 c2 FalseP := refl_equal c2. - -Definition BoolP_dep_induction := - forall P:BoolP -> Prop, P TrueP -> P FalseP -> forall b:BoolP, P b. - -Lemma ext_prop_dep_proof_irrel_cc : - prop_extensionality -> BoolP_dep_induction -> proof_irrelevance. -Proof - ext_prop_dep_proof_irrel_gen BoolP TrueP FalseP BoolP_elim BoolP_elim_redl - BoolP_elim_redr. + + Definition BoolP := forall C:Prop, C -> C -> C. + Definition TrueP : BoolP := fun C c1 c2 => c1. + Definition FalseP : BoolP := fun C c1 c2 => c2. + Definition BoolP_elim C c1 c2 (b:BoolP) := b C c1 c2. + Definition BoolP_elim_redl (C:Prop) (c1 c2:C) : + c1 = BoolP_elim C c1 c2 TrueP := refl_equal c1. + Definition BoolP_elim_redr (C:Prop) (c1 c2:C) : + c2 = BoolP_elim C c1 c2 FalseP := refl_equal c2. + + Definition BoolP_dep_induction := + forall P:BoolP -> Prop, P TrueP -> P FalseP -> forall b:BoolP, P b. + + Lemma ext_prop_dep_proof_irrel_cc : + prop_extensionality -> BoolP_dep_induction -> proof_irrelevance. + Proof. + exact (ext_prop_dep_proof_irrel_gen BoolP TrueP FalseP BoolP_elim BoolP_elim_redl + BoolP_elim_redr). + Qed. End Proof_irrelevance_Prop_Ext_CC. (************************************************************************) -(** **** B. 3. CIC |- prop. ext. -> proof-irrelevance *) +(** ** CIC |- prop. ext. -> proof-irrelevance *) (** In the Calculus of Inductive Constructions, inductively defined booleans enjoy dependent case analysis, hence directly proof-irrelevance from @@ -238,21 +239,22 @@ End Proof_irrelevance_Prop_Ext_CC. *) Section Proof_irrelevance_CIC. - -Inductive boolP : Prop := - | trueP : boolP - | falseP : boolP. -Definition boolP_elim_redl (C:Prop) (c1 c2:C) : - c1 = boolP_ind C c1 c2 trueP := refl_equal c1. -Definition boolP_elim_redr (C:Prop) (c1 c2:C) : - c2 = boolP_ind C c1 c2 falseP := refl_equal c2. -Scheme boolP_indd := Induction for boolP Sort Prop. - -Lemma ext_prop_dep_proof_irrel_cic : prop_extensionality -> proof_irrelevance. -Proof - fun pe => - ext_prop_dep_proof_irrel_gen boolP trueP falseP boolP_ind boolP_elim_redl - boolP_elim_redr pe boolP_indd. + + Inductive boolP : Prop := + | trueP : boolP + | falseP : boolP. + Definition boolP_elim_redl (C:Prop) (c1 c2:C) : + c1 = boolP_ind C c1 c2 trueP := refl_equal c1. + Definition boolP_elim_redr (C:Prop) (c1 c2:C) : + c2 = boolP_ind C c1 c2 falseP := refl_equal c2. + Scheme boolP_indd := Induction for boolP Sort Prop. + + Lemma ext_prop_dep_proof_irrel_cic : prop_extensionality -> proof_irrelevance. + Proof. + exact (fun pe => + ext_prop_dep_proof_irrel_gen boolP trueP falseP boolP_ind boolP_elim_redl + boolP_elim_redr pe boolP_indd). + Qed. End Proof_irrelevance_CIC. @@ -267,12 +269,12 @@ End Proof_irrelevance_CIC. cannot be refined. [[Berardi90]] Stefano Berardi, "Type dependence and constructive - mathematics", Ph. D. thesis, Dipartimento Matematica, Università di + mathematics", Ph. D. thesis, Dipartimento Matematica, Università di Torino, 1990. *) (************************************************************************) -(** **** B. 4. CC |- excluded-middle + dep elim on bool -> proof-irrelevance *) +(** ** CC |- excluded-middle + dep elim on bool -> proof-irrelevance *) (** This is a proof in the pure Calculus of Construction that classical logic in [Prop] + dependent elimination of disjunction entails @@ -293,60 +295,61 @@ End Proof_irrelevance_CIC. Require Import Hurkens. Section Proof_irrelevance_EM_CC. - -Variable or : Prop -> Prop -> Prop. -Variable or_introl : forall A B:Prop, A -> or A B. -Variable or_intror : forall A B:Prop, B -> or A B. -Hypothesis or_elim : forall A B C:Prop, (A -> C) -> (B -> C) -> or A B -> C. -Hypothesis - or_elim_redl : + + Variable or : Prop -> Prop -> Prop. + Variable or_introl : forall A B:Prop, A -> or A B. + Variable or_intror : forall A B:Prop, B -> or A B. + Hypothesis or_elim : forall A B C:Prop, (A -> C) -> (B -> C) -> or A B -> C. + Hypothesis + or_elim_redl : forall (A B C:Prop) (f:A -> C) (g:B -> C) (a:A), f a = or_elim A B C f g (or_introl A B a). -Hypothesis - or_elim_redr : + Hypothesis + or_elim_redr : forall (A B C:Prop) (f:A -> C) (g:B -> C) (b:B), g b = or_elim A B C f g (or_intror A B b). -Hypothesis - or_dep_elim : + Hypothesis + or_dep_elim : forall (A B:Prop) (P:or A B -> Prop), (forall a:A, P (or_introl A B a)) -> (forall b:B, P (or_intror A B b)) -> forall b:or A B, P b. - -Hypothesis em : forall A:Prop, or A (~ A). -Variable B : Prop. -Variables b1 b2 : B. - -(** [p2b] and [b2p] form a retract if [~b1=b2] *) - -Definition p2b A := or_elim A (~ A) B (fun _ => b1) (fun _ => b2) (em A). -Definition b2p b := b1 = b. - -Lemma p2p1 : forall A:Prop, A -> b2p (p2b A). -Proof. - unfold p2b in |- *; intro A; apply or_dep_elim with (b := em A); - unfold b2p in |- *; intros. - apply (or_elim_redl A (~ A) B (fun _ => b1) (fun _ => b2)). - destruct (b H). -Qed. -Lemma p2p2 : b1 <> b2 -> forall A:Prop, b2p (p2b A) -> A. -Proof. - intro not_eq_b1_b2. - unfold p2b in |- *; intro A; apply or_dep_elim with (b := em A); - unfold b2p in |- *; intros. - assumption. - destruct not_eq_b1_b2. - rewrite <- (or_elim_redr A (~ A) B (fun _ => b1) (fun _ => b2)) in H. - assumption. -Qed. - -(** Using excluded-middle a second time, we get proof-irrelevance *) - -Theorem proof_irrelevance_cc : b1 = b2. -Proof. - refine (or_elim _ _ _ _ _ (em (b1 = b2))); intro H. + + Hypothesis em : forall A:Prop, or A (~ A). + Variable B : Prop. + Variables b1 b2 : B. + + (** [p2b] and [b2p] form a retract if [~b1=b2] *) + + Definition p2b A := or_elim A (~ A) B (fun _ => b1) (fun _ => b2) (em A). + Definition b2p b := b1 = b. + + Lemma p2p1 : forall A:Prop, A -> b2p (p2b A). + Proof. + unfold p2b in |- *; intro A; apply or_dep_elim with (b := em A); + unfold b2p in |- *; intros. + apply (or_elim_redl A (~ A) B (fun _ => b1) (fun _ => b2)). + destruct (b H). + Qed. + + Lemma p2p2 : b1 <> b2 -> forall A:Prop, b2p (p2b A) -> A. + Proof. + intro not_eq_b1_b2. + unfold p2b in |- *; intro A; apply or_dep_elim with (b := em A); + unfold b2p in |- *; intros. + assumption. + destruct not_eq_b1_b2. + rewrite <- (or_elim_redr A (~ A) B (fun _ => b1) (fun _ => b2)) in H. + assumption. + Qed. + + (** Using excluded-middle a second time, we get proof-irrelevance *) + + Theorem proof_irrelevance_cc : b1 = b2. + Proof. + refine (or_elim _ _ _ _ _ (em (b1 = b2))); intro H. trivial. - apply (paradox B p2b b2p (p2p2 H) p2p1). -Qed. + apply (paradox B p2b b2p (p2p2 H) p2p1). + Qed. End Proof_irrelevance_EM_CC. @@ -357,7 +360,7 @@ End Proof_irrelevance_EM_CC. *) (************************************************************************) -(** **** B. 5. CIC |- excluded-middle -> proof-irrelevance *) +(** ** CIC |- excluded-middle -> proof-irrelevance *) (** Since, dependent elimination is derivable in the Calculus of @@ -367,18 +370,19 @@ End Proof_irrelevance_EM_CC. Section Proof_irrelevance_CCI. -Hypothesis em : forall A:Prop, A \/ ~ A. - -Definition or_elim_redl (A B C:Prop) (f:A -> C) (g:B -> C) - (a:A) : f a = or_ind f g (or_introl B a) := refl_equal (f a). -Definition or_elim_redr (A B C:Prop) (f:A -> C) (g:B -> C) - (b:B) : g b = or_ind f g (or_intror A b) := refl_equal (g b). -Scheme or_indd := Induction for or Sort Prop. - -Theorem proof_irrelevance_cci : forall (B:Prop) (b1 b2:B), b1 = b2. -Proof - proof_irrelevance_cc or or_introl or_intror or_ind or_elim_redl - or_elim_redr or_indd em. + Hypothesis em : forall A:Prop, A \/ ~ A. + + Definition or_elim_redl (A B C:Prop) (f:A -> C) (g:B -> C) + (a:A) : f a = or_ind f g (or_introl B a) := refl_equal (f a). + Definition or_elim_redr (A B C:Prop) (f:A -> C) (g:B -> C) + (b:B) : g b = or_ind f g (or_intror A b) := refl_equal (g b). + Scheme or_indd := Induction for or Sort Prop. + + Theorem proof_irrelevance_cci : forall (B:Prop) (b1 b2:B), b1 = b2. + Proof. + exact (proof_irrelevance_cc or or_introl or_intror or_ind or_elim_redl + or_elim_redr or_indd em). + Qed. End Proof_irrelevance_CCI. @@ -388,16 +392,16 @@ End Proof_irrelevance_CCI. [em : forall A:Prop, {A}+{~A}] in the Set-impredicative CCI. *) -(** *** C. Weak classical axioms *) +(** * Weak classical axioms *) (** We show the following increasing in the strength of axioms: - weak excluded-middle - - right distributivity of implication over disjunction and Gödel-Dummet axiom + - right distributivity of implication over disjunction and Gödel-Dummet axiom - independence of general premises and drinker's paradox - excluded-middle *) -(** **** C. 1. Weak excluded-middle *) +(** ** Weak excluded-middle *) (** The weak classical logic based on [~~A \/ ~A] is referred to with name KC in {[ChagrovZakharyaschev97]] @@ -411,20 +415,20 @@ Definition weak_excluded_middle := (** The interest in the equivalent variant [weak_generalized_excluded_middle] is that it holds even in logic - without a primitive [False] connective (like Gödel-Dummett axiom) *) + without a primitive [False] connective (like Gödel-Dummett axiom) *) Definition weak_generalized_excluded_middle := forall A B:Prop, ((A -> B) -> B) \/ (A -> B). -(** **** C. 2. Gödel-Dummett axiom *) +(** ** Gödel-Dummett axiom *) -(** [(A->B) \/ (B->A)] is studied in [[Dummett59]] and is based on [[Gödel33]]. +(** [(A->B) \/ (B->A)] is studied in [[Dummett59]] and is based on [[Gödel33]]. [[Dummett59]] Michael A. E. Dummett. "A Propositional Calculus with a Denumerable Matrix", In the Journal of Symbolic Logic, Vol 24 No. 2(1959), pp 97-103. - [[Gödel33]] Kurt Gödel. "Zum intuitionistischen Aussagenkalkül", + [[Gödel33]] Kurt Gödel. "Zum intuitionistischen Aussagenkalkül", Ergeb. Math. Koll. 4 (1933), pp. 34-38. *) @@ -432,7 +436,7 @@ Definition GodelDummett := forall A B:Prop, (A -> B) \/ (B -> A). Lemma excluded_middle_Godel_Dummett : excluded_middle -> GodelDummett. Proof. -intros EM A B. destruct (EM B) as [HB|HnotB]. + intros EM A B. destruct (EM B) as [HB|HnotB]. left; intros _; exact HB. right; intros HB; destruct (HnotB HB). Qed. @@ -446,15 +450,15 @@ Definition RightDistributivityImplicationOverDisjunction := Lemma Godel_Dummett_iff_right_distr_implication_over_disjunction : GodelDummett <-> RightDistributivityImplicationOverDisjunction. Proof. -split. - intros GD A B C HCAB. - destruct (GD B A) as [HBA|HAB]; [left|right]; intro HC; - destruct (HCAB HC) as [HA|HB]; [ | apply HBA | apply HAB | ]; assumption. - intros Distr A B. - destruct (Distr A B (A\/B)) as [HABA|HABB]. - intro HAB; exact HAB. - right; intro HB; apply HABA; right; assumption. - left; intro HA; apply HABB; left; assumption. + split. + intros GD A B C HCAB. + destruct (GD B A) as [HBA|HAB]; [left|right]; intro HC; + destruct (HCAB HC) as [HA|HB]; [ | apply HBA | apply HAB | ]; assumption. + intros Distr A B. + destruct (Distr A B (A\/B)) as [HABA|HABB]. + intro HAB; exact HAB. + right; intro HB; apply HABA; right; assumption. + left; intro HA; apply HABB; left; assumption. Qed. (** [(A->B) \/ (B->A)] is stronger than the weak excluded middle *) @@ -462,12 +466,12 @@ Qed. Lemma Godel_Dummett_weak_excluded_middle : GodelDummett -> weak_excluded_middle. Proof. -intros GD A. destruct (GD (~A) A) as [HnotAA|HAnotA]. - left; intro HnotA; apply (HnotA (HnotAA HnotA)). - right; intro HA; apply (HAnotA HA HA). + intros GD A. destruct (GD (~A) A) as [HnotAA|HAnotA]. + left; intro HnotA; apply (HnotA (HnotAA HnotA)). + right; intro HA; apply (HAnotA HA HA). Qed. -(** **** C. 3. Independence of general premises and drinker's paradox *) +(** ** Independence of general premises and drinker's paradox *) (** Independence of general premises is the unconstrained, non constructive, version of the Independence of Premises as @@ -475,13 +479,13 @@ Qed. It is a generalization to predicate logic of the right distributivity of implication over disjunction (hence of - Gödel-Dummett axiom) whose own constructive form (obtained by a + Gödel-Dummett axiom) whose own constructive form (obtained by a restricting the third formula to be negative) is called Kreisel-Putnam principle [[KreiselPutnam57]]. [[KreiselPutnam57]], Georg Kreisel and Hilary Putnam. "Eine - Unableitsbarkeitsbeweismethode für den intuitionistischen - Aussagenkalkül". Archiv für Mathematische Logik und + Unableitsbarkeitsbeweismethode für den intuitionistischen + Aussagenkalkül". Archiv für Mathematische Logik und Graundlagenforschung, 3:74- 78, 1957. [[Troelstra73]], Anne Troelstra, editor. Metamathematical @@ -499,33 +503,33 @@ Lemma independence_general_premises_right_distr_implication_over_disjunction : IndependenceOfGeneralPremises -> RightDistributivityImplicationOverDisjunction. Proof. -intros IP A B C HCAB. -destruct (IP bool (fun b => if b then A else B) C true) as ([|],H). - intro HC; destruct (HCAB HC); [exists true|exists false]; assumption. - left; assumption. - right; assumption. + intros IP A B C HCAB. + destruct (IP bool (fun b => if b then A else B) C true) as ([|],H). + intro HC; destruct (HCAB HC); [exists true|exists false]; assumption. + left; assumption. + right; assumption. Qed. Lemma independence_general_premises_Godel_Dummett : IndependenceOfGeneralPremises -> GodelDummett. Proof. -destruct Godel_Dummett_iff_right_distr_implication_over_disjunction. -auto using independence_general_premises_right_distr_implication_over_disjunction. + destruct Godel_Dummett_iff_right_distr_implication_over_disjunction. + auto using independence_general_premises_right_distr_implication_over_disjunction. Qed. (** Independence of general premises is equivalent to the drinker's paradox *) Definition DrinkerParadox := forall (A:Type) (P:A -> Prop), - inhabited A -> exists x, (exists x, P x) -> P x. + inhabited A -> exists x, (exists x, P x) -> P x. Lemma independence_general_premises_drinker : IndependenceOfGeneralPremises <-> DrinkerParadox. Proof. -split. - intros IP A P InhA; apply (IP A P (exists x, P x) InhA); intro Hx; exact Hx. - intros Drinker A P Q InhA H; destruct (Drinker A P InhA) as (x,Hx). - exists x; intro HQ; apply (Hx (H HQ)). + split. + intros IP A P InhA; apply (IP A P (exists x, P x) InhA); intro Hx; exact Hx. + intros Drinker A P Q InhA H; destruct (Drinker A P InhA) as (x,Hx). + exists x; intro HQ; apply (Hx (H HQ)). Qed. (** Independence of general premises is weaker than (generalized) @@ -537,9 +541,9 @@ Definition generalized_excluded_middle := Lemma excluded_middle_independence_general_premises : generalized_excluded_middle -> DrinkerParadox. Proof. -intros GEM A P x0. -destruct (GEM (exists x, P x) (P x0)) as [(x,Hx)|Hnot]. - exists x; intro; exact Hx. - exists x0; exact Hnot. + intros GEM A P x0. + destruct (GEM (exists x, P x) (P x0)) as [(x,Hx)|Hnot]. + exists x; intro; exact Hx. + exists x0; exact Hnot. Qed. diff --git a/theories/Logic/Diaconescu.v b/theories/Logic/Diaconescu.v index 19d5d7ec..5f139f35 100644 --- a/theories/Logic/Diaconescu.v +++ b/theories/Logic/Diaconescu.v @@ -7,7 +7,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Diaconescu.v 8892 2006-06-04 17:59:53Z herbelin $ i*) +(*i $Id: Diaconescu.v 9245 2006-10-17 12:53:34Z notin $ i*) (** Diaconescu showed that the Axiom of Choice entails Excluded-Middle in topoi [Diaconescu75]. Lacas and Werner adapted the proof to show @@ -44,7 +44,7 @@ *) (**********************************************************************) -(** *** A. Pred. Ext. + Rel. Axiom of Choice -> Excluded-Middle *) +(** * Pred. Ext. + Rel. Axiom of Choice -> Excluded-Middle *) Section PredExt_RelChoice_imp_EM. @@ -156,7 +156,7 @@ Qed. End PredExt_RelChoice_imp_EM. (**********************************************************************) -(** *** B. Proof-Irrel. + Rel. Axiom of Choice -> Excl.-Middle for Equality *) +(** * B. Proof-Irrel. + Rel. Axiom of Choice -> Excl.-Middle for Equality *) (** This is an adaptation of Diaconescu's paradox exploiting that proof-irrelevance is some form of extensionality *) @@ -263,7 +263,7 @@ Qed. End ProofIrrel_RelChoice_imp_EqEM. (**********************************************************************) -(** *** B. Extensional Hilbert's epsilon description operator -> Excluded-Middle *) +(** * Extensional Hilbert's epsilon description operator -> Excluded-Middle *) (** Proof sketch from Bell [Bell93] (with thanks to P. Castéran) *) @@ -285,20 +285,20 @@ Notation Local eps := (epsilon bool true) (only parsing). Theorem extensional_epsilon_imp_EM : forall P:Prop, P \/ ~ P. Proof. -intro P. -pose (B := fun y => y=false \/ P). -pose (C := fun y => y=true \/ P). -assert (B (eps B)) as [Hfalse|HP] - by (apply epsilon_spec; exists false; left; reflexivity). -assert (C (eps C)) as [Htrue|HP] - by (apply epsilon_spec; exists true; left; reflexivity). - right; intro HP. - assert (forall y, B y <-> C y) by (intro y; split; intro; right; assumption). - rewrite epsilon_extensionality with (1:=H) in Hfalse. - rewrite Htrue in Hfalse. - discriminate. -auto. -auto. + intro P. + pose (B := fun y => y=false \/ P). + pose (C := fun y => y=true \/ P). + assert (B (eps B)) as [Hfalse|HP] + by (apply epsilon_spec; exists false; left; reflexivity). + assert (C (eps C)) as [Htrue|HP] + by (apply epsilon_spec; exists true; left; reflexivity). + right; intro HP. + assert (forall y, B y <-> C y) by (intro y; split; intro; right; assumption). + rewrite epsilon_extensionality with (1:=H) in Hfalse. + rewrite Htrue in Hfalse. + discriminate. + auto. + auto. Qed. End ExtensionalEpsilon_imp_EM. diff --git a/theories/Logic/EqdepFacts.v b/theories/Logic/EqdepFacts.v index 7963555a..a257ef55 100644 --- a/theories/Logic/EqdepFacts.v +++ b/theories/Logic/EqdepFacts.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: EqdepFacts.v 8674 2006-03-30 06:56:50Z herbelin $ i*) +(*i $Id: EqdepFacts.v 9245 2006-10-17 12:53:34Z notin $ i*) (** This file defines dependent equality and shows its equivalence with equality on dependent pairs (inhabiting sigma-types). It derives @@ -32,70 +32,70 @@ Table of contents: -A. Definition of dependent equality and equivalence with equality +1. Definition of dependent equality and equivalence with equality -B. Eq_rect_eq <-> Eq_dep_eq <-> UIP <-> UIP_refl <-> K +2. Eq_rect_eq <-> Eq_dep_eq <-> UIP <-> UIP_refl <-> K -C. Definition of the functor that builds properties of dependent +3. Definition of the functor that builds properties of dependent equalities assuming axiom eq_rect_eq *) (************************************************************************) -(** *** A. Definition of dependent equality and equivalence with equality of dependent pairs *) +(** * Definition of dependent equality and equivalence with equality of dependent pairs *) Section Dependent_Equality. + + Variable U : Type. + Variable P : U -> Type. -Variable U : Type. -Variable P : U -> Type. + (** Dependent equality *) -(** Dependent equality *) - -Inductive eq_dep (p:U) (x:P p) : forall q:U, P q -> Prop := + Inductive eq_dep (p:U) (x:P p) : forall q:U, P q -> Prop := eq_dep_intro : eq_dep p x p x. -Hint Constructors eq_dep: core v62. + Hint Constructors eq_dep: core v62. -Lemma eq_dep_refl : forall (p:U) (x:P p), eq_dep p x p x. -Proof eq_dep_intro. + Lemma eq_dep_refl : forall (p:U) (x:P p), eq_dep p x p x. + Proof eq_dep_intro. -Lemma eq_dep_sym : - forall (p q:U) (x:P p) (y:P q), eq_dep p x q y -> eq_dep q y p x. -Proof. - destruct 1; auto. -Qed. -Hint Immediate eq_dep_sym: core v62. + Lemma eq_dep_sym : + forall (p q:U) (x:P p) (y:P q), eq_dep p x q y -> eq_dep q y p x. + Proof. + destruct 1; auto. + Qed. + Hint Immediate eq_dep_sym: core v62. -Lemma eq_dep_trans : - forall (p q r:U) (x:P p) (y:P q) (z:P r), - eq_dep p x q y -> eq_dep q y r z -> eq_dep p x r z. -Proof. - destruct 1; auto. -Qed. + Lemma eq_dep_trans : + forall (p q r:U) (x:P p) (y:P q) (z:P r), + eq_dep p x q y -> eq_dep q y r z -> eq_dep p x r z. + Proof. + destruct 1; auto. + Qed. -Scheme eq_indd := Induction for eq Sort Prop. + Scheme eq_indd := Induction for eq Sort Prop. -(** Equivalent definition of dependent equality expressed as a non - dependent inductive type *) + (** Equivalent definition of dependent equality expressed as a non + dependent inductive type *) -Inductive eq_dep1 (p:U) (x:P p) (q:U) (y:P q) : Prop := + Inductive eq_dep1 (p:U) (x:P p) (q:U) (y:P q) : Prop := eq_dep1_intro : forall h:q = p, x = eq_rect q P y p h -> eq_dep1 p x q y. -Lemma eq_dep1_dep : - forall (p:U) (x:P p) (q:U) (y:P q), eq_dep1 p x q y -> eq_dep p x q y. -Proof. - destruct 1 as (eq_qp, H). - destruct eq_qp using eq_indd. - rewrite H. - apply eq_dep_intro. -Qed. - -Lemma eq_dep_dep1 : - forall (p q:U) (x:P p) (y:P q), eq_dep p x q y -> eq_dep1 p x q y. -Proof. - destruct 1. - apply eq_dep1_intro with (refl_equal p). - simpl in |- *; trivial. -Qed. + Lemma eq_dep1_dep : + forall (p:U) (x:P p) (q:U) (y:P q), eq_dep1 p x q y -> eq_dep p x q y. + Proof. + destruct 1 as (eq_qp, H). + destruct eq_qp using eq_indd. + rewrite H. + apply eq_dep_intro. + Qed. + + Lemma eq_dep_dep1 : + forall (p q:U) (x:P p) (y:P q), eq_dep p x q y -> eq_dep1 p x q y. + Proof. + destruct 1. + apply eq_dep1_intro with (refl_equal p). + simpl in |- *; trivial. + Qed. End Dependent_Equality. @@ -105,8 +105,8 @@ Implicit Arguments eq_dep1 [U P]. (** Dependent equality is equivalent to equality on dependent pairs *) Lemma eq_sigS_eq_dep : - forall (U:Set) (P:U -> Set) (p q:U) (x:P p) (y:P q), - existS P p x = existS P q y -> eq_dep p x q y. + forall (U:Set) (P:U -> Set) (p q:U) (x:P p) (y:P q), + existS P p x = existS P q y -> eq_dep p x q y. Proof. intros. dependent rewrite H. @@ -114,10 +114,10 @@ Proof. Qed. Lemma equiv_eqex_eqdep : - forall (U:Set) (P:U -> Set) (p q:U) (x:P p) (y:P q), + forall (U:Set) (P:U -> Set) (p q:U) (x:P p) (y:P q), existS P p x = existS P q y <-> eq_dep p x q y. Proof. -split. + split. (* -> *) apply eq_sigS_eq_dep. (* <- *) @@ -125,8 +125,8 @@ split. Qed. Lemma eq_sigT_eq_dep : - forall (U:Type) (P:U -> Type) (p q:U) (x:P p) (y:P q), - existT P p x = existT P q y -> eq_dep p x q y. + forall (U:Type) (P:U -> Type) (p q:U) (x:P p) (y:P q), + existT P p x = existT P q y -> eq_dep p x q y. Proof. intros. dependent rewrite H. @@ -134,8 +134,8 @@ Proof. Qed. Lemma eq_dep_eq_sigT : - forall (U:Type) (P:U -> Type) (p q:U) (x:P p) (y:P q), - eq_dep p x q y -> existT P p x = existT P q y. + forall (U:Type) (P:U -> Type) (p q:U) (x:P p) (y:P q), + eq_dep p x q y -> existT P p x = existT P q y. Proof. destruct 1; reflexivity. Qed. @@ -146,90 +146,90 @@ Hint Resolve eq_dep_intro: core v62. Hint Immediate eq_dep_sym: core v62. (************************************************************************) -(** *** B. Eq_rect_eq <-> Eq_dep_eq <-> UIP <-> UIP_refl <-> K *) +(** * Eq_rect_eq <-> Eq_dep_eq <-> UIP <-> UIP_refl <-> K *) Section Equivalences. - -Variable U:Type. - -(** Invariance by Substitution of Reflexive Equality Proofs *) - -Definition Eq_rect_eq := - forall (p:U) (Q:U -> Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h. - -(** Injectivity of Dependent Equality *) - -Definition Eq_dep_eq := - forall (P:U->Type) (p:U) (x y:P p), eq_dep p x p y -> x = y. - -(** Uniqueness of Identity Proofs (UIP) *) - -Definition UIP_ := - forall (x y:U) (p1 p2:x = y), p1 = p2. - -(** Uniqueness of Reflexive Identity Proofs *) - -Definition UIP_refl_ := - forall (x:U) (p:x = x), p = refl_equal x. - -(** Streicher's axiom K *) - -Definition Streicher_K_ := - forall (x:U) (P:x = x -> Prop), P (refl_equal x) -> forall p:x = x, P p. - -(** Injectivity of Dependent Equality is a consequence of *) -(** Invariance by Substitution of Reflexive Equality Proof *) - -Lemma eq_rect_eq__eq_dep1_eq : - Eq_rect_eq -> forall (P:U->Type) (p:U) (x y:P p), eq_dep1 p x p y -> x = y. -Proof. - intro eq_rect_eq. - simple destruct 1; intro. - rewrite <- eq_rect_eq; auto. -Qed. - -Lemma eq_rect_eq__eq_dep_eq : Eq_rect_eq -> Eq_dep_eq. -Proof. - intros eq_rect_eq; red; intros. - apply (eq_rect_eq__eq_dep1_eq eq_rect_eq); apply eq_dep_dep1; trivial. -Qed. - -(** Uniqueness of Identity Proofs (UIP) is a consequence of *) -(** Injectivity of Dependent Equality *) - -Lemma eq_dep_eq__UIP : Eq_dep_eq -> UIP_. -Proof. - intro eq_dep_eq; red. - intros; apply eq_dep_eq with (P := fun y => x = y). - elim p2 using eq_indd. - elim p1 using eq_indd. - apply eq_dep_intro. -Qed. - -(** Uniqueness of Reflexive Identity Proofs is a direct instance of UIP *) - -Lemma UIP__UIP_refl : UIP_ -> UIP_refl_. -Proof. - intro UIP; red; intros; apply UIP. -Qed. - -(** Streicher's axiom K is a direct consequence of Uniqueness of - Reflexive Identity Proofs *) - -Lemma UIP_refl__Streicher_K : UIP_refl_ -> Streicher_K_. -Proof. - intro UIP_refl; red; intros; rewrite UIP_refl; assumption. -Qed. - -(** We finally recover from K the Invariance by Substitution of - Reflexive Equality Proofs *) - -Lemma Streicher_K__eq_rect_eq : Streicher_K_ -> Eq_rect_eq. -Proof. - intro Streicher_K; red; intros. - apply Streicher_K with (p := h). - reflexivity. -Qed. + + Variable U:Type. + + (** Invariance by Substitution of Reflexive Equality Proofs *) + + Definition Eq_rect_eq := + forall (p:U) (Q:U -> Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h. + + (** Injectivity of Dependent Equality *) + + Definition Eq_dep_eq := + forall (P:U->Type) (p:U) (x y:P p), eq_dep p x p y -> x = y. + + (** Uniqueness of Identity Proofs (UIP) *) + + Definition UIP_ := + forall (x y:U) (p1 p2:x = y), p1 = p2. + + (** Uniqueness of Reflexive Identity Proofs *) + + Definition UIP_refl_ := + forall (x:U) (p:x = x), p = refl_equal x. + + (** Streicher's axiom K *) + + Definition Streicher_K_ := + forall (x:U) (P:x = x -> Prop), P (refl_equal x) -> forall p:x = x, P p. + + (** Injectivity of Dependent Equality is a consequence of *) + (** Invariance by Substitution of Reflexive Equality Proof *) + + Lemma eq_rect_eq__eq_dep1_eq : + Eq_rect_eq -> forall (P:U->Type) (p:U) (x y:P p), eq_dep1 p x p y -> x = y. + Proof. + intro eq_rect_eq. + simple destruct 1; intro. + rewrite <- eq_rect_eq; auto. + Qed. + + Lemma eq_rect_eq__eq_dep_eq : Eq_rect_eq -> Eq_dep_eq. + Proof. + intros eq_rect_eq; red; intros. + apply (eq_rect_eq__eq_dep1_eq eq_rect_eq); apply eq_dep_dep1; trivial. + Qed. + + (** Uniqueness of Identity Proofs (UIP) is a consequence of *) + (** Injectivity of Dependent Equality *) + + Lemma eq_dep_eq__UIP : Eq_dep_eq -> UIP_. + Proof. + intro eq_dep_eq; red. + intros; apply eq_dep_eq with (P := fun y => x = y). + elim p2 using eq_indd. + elim p1 using eq_indd. + apply eq_dep_intro. + Qed. + + (** Uniqueness of Reflexive Identity Proofs is a direct instance of UIP *) + + Lemma UIP__UIP_refl : UIP_ -> UIP_refl_. + Proof. + intro UIP; red; intros; apply UIP. + Qed. + + (** Streicher's axiom K is a direct consequence of Uniqueness of + Reflexive Identity Proofs *) + + Lemma UIP_refl__Streicher_K : UIP_refl_ -> Streicher_K_. + Proof. + intro UIP_refl; red; intros; rewrite UIP_refl; assumption. + Qed. + + (** We finally recover from K the Invariance by Substitution of + Reflexive Equality Proofs *) + + Lemma Streicher_K__eq_rect_eq : Streicher_K_ -> Eq_rect_eq. + Proof. + intro Streicher_K; red; intros. + apply Streicher_K with (p := h). + reflexivity. + Qed. (** Remark: It is reasonable to think that [eq_rect_eq] is strictly stronger than [eq_rec_eq] (which is [eq_rect_eq] restricted on [Set]): @@ -246,37 +246,37 @@ Qed. End Equivalences. Section Corollaries. - -Variable U:Type. -Variable V:Set. - -(** UIP implies the injectivity of equality on dependent pairs in Type *) - -Definition Inj_dep_pairT := - forall (P:U -> Type) (p:U) (x y:P p), - existT P p x = existT P p y -> x = y. - -Lemma eq_dep_eq__inj_pairT2 : Eq_dep_eq U -> Inj_dep_pairT. + + Variable U:Type. + Variable V:Set. + + (** UIP implies the injectivity of equality on dependent pairs in Type *) + + Definition Inj_dep_pairT := + forall (P:U -> Type) (p:U) (x y:P p), + existT P p x = existT P p y -> x = y. + + Lemma eq_dep_eq__inj_pairT2 : Eq_dep_eq U -> Inj_dep_pairT. + Proof. + intro eq_dep_eq; red; intros. + apply eq_dep_eq. + apply eq_sigT_eq_dep. + assumption. + Qed. + + (** UIP implies the injectivity of equality on dependent pairs in Set *) + + Definition Inj_dep_pairS := + forall (P:V -> Set) (p:V) (x y:P p), existS P p x = existS P p y -> x = y. + + Lemma eq_dep_eq__inj_pair2 : Eq_dep_eq V -> Inj_dep_pairS. Proof. intro eq_dep_eq; red; intros. apply eq_dep_eq. - apply eq_sigT_eq_dep. + apply eq_sigS_eq_dep. assumption. Qed. -(** UIP implies the injectivity of equality on dependent pairs in Set *) - -Definition Inj_dep_pairS := - forall (P:V -> Set) (p:V) (x y:P p), existS P p x = existS P p y -> x = y. - -Lemma eq_dep_eq__inj_pair2 : Eq_dep_eq V -> Inj_dep_pairS. -Proof. - intro eq_dep_eq; red; intros. - apply eq_dep_eq. - apply eq_sigS_eq_dep. - assumption. -Qed. - End Corollaries. (************************************************************************) @@ -286,16 +286,16 @@ Module Type EqdepElimination. Axiom eq_rect_eq : forall (U:Type) (p:U) (Q:U -> Type) (x:Q p) (h:p = p), - x = eq_rect p Q x p h. + x = eq_rect p Q x p h. End EqdepElimination. Module EqdepTheory (M:EqdepElimination). - -Section Axioms. - -Variable U:Type. - + + Section Axioms. + + Variable U:Type. + (** Invariance by Substitution of Reflexive Equality Proofs *) Lemma eq_rect_eq : diff --git a/theories/Logic/Eqdep_dec.v b/theories/Logic/Eqdep_dec.v index 7d71a1a6..740fcfcf 100644 --- a/theories/Logic/Eqdep_dec.v +++ b/theories/Logic/Eqdep_dec.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Eqdep_dec.v 8136 2006-03-05 21:57:47Z herbelin $ i*) +(*i $Id: Eqdep_dec.v 9245 2006-10-17 12:53:34Z notin $ i*) (** We prove that there is only one proof of [x=x], i.e [refl_equal x]. This holds if the equality upon the set of [x] is decidable. @@ -20,149 +20,153 @@ Table of contents: -A. Streicher's K and injectivity of dependent pair hold on decidable types +1. Streicher's K and injectivity of dependent pair hold on decidable types -B.1. Definition of the functor that builds properties of dependent equalities +1.1. Definition of the functor that builds properties of dependent equalities from a proof of decidability of equality for a set in Type -B.2. Definition of the functor that builds properties of dependent equalities +1.2. Definition of the functor that builds properties of dependent equalities from a proof of decidability of equality for a set in Set *) (************************************************************************) -(** *** A. Streicher's K and injectivity of dependent pair hold on decidable types *) +(** * Streicher's K and injectivity of dependent pair hold on decidable types *) Set Implicit Arguments. Section EqdepDec. Variable A : Type. - + Let comp (x y y':A) (eq1:x = y) (eq2:x = y') : y = y' := eq_ind _ (fun a => a = y') eq2 _ eq1. Remark trans_sym_eq : forall (x y:A) (u:x = y), comp u u = refl_equal y. -intros. -case u; trivial. -Qed. - - + Proof. + intros. + case u; trivial. + Qed. Variable eq_dec : forall x y:A, x = y \/ x <> y. - + Variable x : A. - Let nu (y:A) (u:x = y) : x = y := match eq_dec x y with - | or_introl eqxy => eqxy - | or_intror neqxy => False_ind _ (neqxy u) + | or_introl eqxy => eqxy + | or_intror neqxy => False_ind _ (neqxy u) end. Let nu_constant : forall (y:A) (u v:x = y), nu u = nu v. -intros. -unfold nu in |- *. -case (eq_dec x y); intros. -reflexivity. - -case n; trivial. -Qed. + intros. + unfold nu in |- *. + case (eq_dec x y); intros. + reflexivity. + + case n; trivial. + Qed. Let nu_inv (y:A) (v:x = y) : x = y := comp (nu (refl_equal x)) v. - + Remark nu_left_inv : forall (y:A) (u:x = y), nu_inv (nu u) = u. -intros. -case u; unfold nu_inv in |- *. -apply trans_sym_eq. -Qed. + Proof. + intros. + case u; unfold nu_inv in |- *. + apply trans_sym_eq. + Qed. Theorem eq_proofs_unicity : forall (y:A) (p1 p2:x = y), p1 = p2. -intros. -elim nu_left_inv with (u := p1). -elim nu_left_inv with (u := p2). -elim nu_constant with y p1 p2. -reflexivity. -Qed. + Proof. + intros. + elim nu_left_inv with (u := p1). + elim nu_left_inv with (u := p2). + elim nu_constant with y p1 p2. + reflexivity. + Qed. - Theorem K_dec : - forall P:x = x -> Prop, P (refl_equal x) -> forall p:x = x, P p. -intros. -elim eq_proofs_unicity with x (refl_equal x) p. -trivial. -Qed. + Theorem K_dec : + forall P:x = x -> Prop, P (refl_equal x) -> forall p:x = x, P p. + Proof. + intros. + elim eq_proofs_unicity with x (refl_equal x) p. + trivial. + Qed. (** The corollary *) Let proj (P:A -> Prop) (exP:ex P) (def:P x) : P x := match exP with - | ex_intro x' prf => + | ex_intro x' prf => match eq_dec x' x with - | or_introl eqprf => eq_ind x' P prf x eqprf - | _ => def + | or_introl eqprf => eq_ind x' P prf x eqprf + | _ => def end end. Theorem inj_right_pair : - forall (P:A -> Prop) (y y':P x), - ex_intro P x y = ex_intro P x y' -> y = y'. -intros. -cut (proj (ex_intro P x y) y = proj (ex_intro P x y') y). -simpl in |- *. -case (eq_dec x x). -intro e. -elim e using K_dec; trivial. - -intros. -case n; trivial. - -case H. -reflexivity. -Qed. + forall (P:A -> Prop) (y y':P x), + ex_intro P x y = ex_intro P x y' -> y = y'. + Proof. + intros. + cut (proj (ex_intro P x y) y = proj (ex_intro P x y') y). + simpl in |- *. + case (eq_dec x x). + intro e. + elim e using K_dec; trivial. + + intros. + case n; trivial. + + case H. + reflexivity. + Qed. End EqdepDec. Require Import EqdepFacts. - (** We deduce axiom [K] for (decidable) types *) - Theorem K_dec_type : - forall A:Type, - (forall x y:A, {x = y} + {x <> y}) -> - forall (x:A) (P:x = x -> Prop), P (refl_equal x) -> forall p:x = x, P p. -intros A eq_dec x P H p. -elim p using K_dec; intros. -case (eq_dec x0 y); [left|right]; assumption. -trivial. +(** We deduce axiom [K] for (decidable) types *) +Theorem K_dec_type : + forall A:Type, + (forall x y:A, {x = y} + {x <> y}) -> + forall (x:A) (P:x = x -> Prop), P (refl_equal x) -> forall p:x = x, P p. +Proof. + intros A eq_dec x P H p. + elim p using K_dec; intros. + case (eq_dec x0 y); [left|right]; assumption. + trivial. Qed. - Theorem K_dec_set : - forall A:Set, - (forall x y:A, {x = y} + {x <> y}) -> - forall (x:A) (P:x = x -> Prop), P (refl_equal x) -> forall p:x = x, P p. - Proof fun A => K_dec_type (A:=A). - - (** We deduce the [eq_rect_eq] axiom for (decidable) types *) - Theorem eq_rect_eq_dec : - forall A:Type, - (forall x y:A, {x = y} + {x <> y}) -> - forall (p:A) (Q:A -> Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h. -intros A eq_dec. -apply (Streicher_K__eq_rect_eq A (K_dec_type eq_dec)). +Theorem K_dec_set : + forall A:Set, + (forall x y:A, {x = y} + {x <> y}) -> + forall (x:A) (P:x = x -> Prop), P (refl_equal x) -> forall p:x = x, P p. +Proof fun A => K_dec_type (A:=A). + +(** We deduce the [eq_rect_eq] axiom for (decidable) types *) +Theorem eq_rect_eq_dec : + forall A:Type, + (forall x y:A, {x = y} + {x <> y}) -> + forall (p:A) (Q:A -> Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h. +Proof. + intros A eq_dec. + apply (Streicher_K__eq_rect_eq A (K_dec_type eq_dec)). Qed. Unset Implicit Arguments. (************************************************************************) -(** *** B.1. Definition of the functor that builds properties of dependent equalities on decidable sets in Type *) +(** ** Definition of the functor that builds properties of dependent equalities on decidable sets in Type *) (** The signature of decidable sets in [Type] *) Module Type DecidableType. - + Parameter U:Type. Axiom eq_dec : forall x y:U, {x = y} + {x <> y}. @@ -215,16 +219,17 @@ Module DecidableEqDep (M:DecidableType). Lemma inj_pairP2 : forall (P:U -> Prop) (x:U) (p q:P x), ex_intro P x p = ex_intro P x q -> p = q. - intros. - apply inj_right_pair with (A:=U). - intros x0 y0; case (eq_dec x0 y0); [left|right]; assumption. - assumption. + Proof. + intros. + apply inj_right_pair with (A:=U). + intros x0 y0; case (eq_dec x0 y0); [left|right]; assumption. + assumption. Qed. End DecidableEqDep. (************************************************************************) -(** *** B.2 Definition of the functor that builds properties of dependent equalities on decidable sets in Set *) +(** ** B Definition of the functor that builds properties of dependent equalities on decidable sets in Set *) (** The signature of decidable sets in [Set] *) diff --git a/theories/Logic/JMeq.v b/theories/Logic/JMeq.v index 4d365e32..6a723e43 100644 --- a/theories/Logic/JMeq.v +++ b/theories/Logic/JMeq.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: JMeq.v 6009 2004-08-03 17:42:55Z herbelin $ i*) +(*i $Id: JMeq.v 9077 2006-08-24 08:44:32Z herbelin $ i*) (** John Major's Equality as proposed by Conor McBride @@ -19,56 +19,65 @@ Set Implicit Arguments. -Inductive JMeq (A:Set) (x:A) : forall B:Set, B -> Prop := +Inductive JMeq (A:Type) (x:A) : forall B:Type, B -> Prop := JMeq_refl : JMeq x x. -Reset JMeq_ind. +Reset JMeq_rect. Hint Resolve JMeq_refl. -Lemma sym_JMeq : forall (A B:Set) (x:A) (y:B), JMeq x y -> JMeq y x. +Lemma sym_JMeq : forall (A B:Type) (x:A) (y:B), JMeq x y -> JMeq y x. destruct 1; trivial. Qed. Hint Immediate sym_JMeq. Lemma trans_JMeq : - forall (A B C:Set) (x:A) (y:B) (z:C), JMeq x y -> JMeq y z -> JMeq x z. + forall (A B C:Type) (x:A) (y:B) (z:C), JMeq x y -> JMeq y z -> JMeq x z. destruct 1; trivial. Qed. -Axiom JMeq_eq : forall (A:Set) (x y:A), JMeq x y -> x = y. +Axiom JMeq_eq : forall (A:Type) (x y:A), JMeq x y -> x = y. -Lemma JMeq_ind : forall (A:Set) (x y:A) (P:A -> Prop), P x -> JMeq x y -> P y. +Lemma JMeq_ind : forall (A:Type) (x y:A) (P:A -> Prop), P x -> JMeq x y -> P y. intros A x y P H H'; case JMeq_eq with (1 := H'); trivial. Qed. -Lemma JMeq_rec : forall (A:Set) (x y:A) (P:A -> Set), P x -> JMeq x y -> P y. +Lemma JMeq_rec : forall (A:Type) (x y:A) (P:A -> Set), P x -> JMeq x y -> P y. +intros A x y P H H'; case JMeq_eq with (1 := H'); trivial. +Qed. + +Lemma JMeq_rect : forall (A:Type) (x y:A) (P:A->Type), P x -> JMeq x y -> P y. intros A x y P H H'; case JMeq_eq with (1 := H'); trivial. Qed. Lemma JMeq_ind_r : - forall (A:Set) (x y:A) (P:A -> Prop), P y -> JMeq x y -> P x. + forall (A:Type) (x y:A) (P:A -> Prop), P y -> JMeq x y -> P x. intros A x y P H H'; case JMeq_eq with (1 := sym_JMeq H'); trivial. Qed. Lemma JMeq_rec_r : - forall (A:Set) (x y:A) (P:A -> Set), P y -> JMeq x y -> P x. + forall (A:Type) (x y:A) (P:A -> Set), P y -> JMeq x y -> P x. +intros A x y P H H'; case JMeq_eq with (1 := sym_JMeq H'); trivial. +Qed. + +Lemma JMeq_rect_r : + forall (A:Type) (x y:A) (P:A -> Type), P y -> JMeq x y -> P x. intros A x y P H H'; case JMeq_eq with (1 := sym_JMeq H'); trivial. Qed. -(** [JMeq] is equivalent to [(eq_dep Set [X]X)] *) +(** [JMeq] is equivalent to [(eq_dep Type [X]X)] *) Require Import Eqdep. Lemma JMeq_eq_dep : - forall (A B:Set) (x:A) (y:B), JMeq x y -> eq_dep Set (fun X => X) A x B y. + forall (A B:Type) (x:A) (y:B), JMeq x y -> eq_dep Type (fun X => X) A x B y. Proof. destruct 1. apply eq_dep_intro. Qed. Lemma eq_dep_JMeq : - forall (A B:Set) (x:A) (y:B), eq_dep Set (fun X => X) A x B y -> JMeq x y. + forall (A B:Type) (x:A) (y:B), eq_dep Type (fun X => X) A x B y -> JMeq x y. Proof. destruct 1. apply JMeq_refl. diff --git a/theories/NArith/NArith.v b/theories/NArith/NArith.v index 2f066efa..019ef5f7 100644 --- a/theories/NArith/NArith.v +++ b/theories/NArith/NArith.v @@ -6,9 +6,11 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: NArith.v 5920 2004-07-16 20:01:26Z herbelin $ *) +(* $Id: NArith.v 9210 2006-10-05 10:12:15Z barras $ *) (** Library for binary natural numbers *) Require Export BinPos. -Require Export BinNat.
\ No newline at end of file +Require Export BinNat. + +Require Export NArithRing. diff --git a/theories/QArith/QArith_base.v b/theories/QArith/QArith_base.v index 335466a6..66d16cfe 100644 --- a/theories/QArith/QArith_base.v +++ b/theories/QArith/QArith_base.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: QArith_base.v 8989 2006-06-25 22:17:49Z letouzey $ i*) +(*i $Id: QArith_base.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Export ZArith. Require Export ZArithRing. @@ -87,7 +87,7 @@ Qed. Hint Unfold Qeq Qlt Qle: qarith. Hint Extern 5 (?X1 <> ?X2) => intro; discriminate: qarith. -(** Properties of equality. *) +(** * Properties of equality. *) Theorem Qeq_refl : forall x, x == x. Proof. @@ -104,8 +104,10 @@ Proof. unfold Qeq in |- *; intros. apply Zmult_reg_l with (QDen y). auto with qarith. -ring; rewrite H; ring. -rewrite Zmult_assoc; rewrite H0; ring. +transitivity (Qnum x * QDen y * QDen z)%Z; try ring. +rewrite H. +transitivity (Qnum y * QDen z * QDen x)%Z; try ring. +rewrite H0; ring. Qed. (** Furthermore, this equality is decidable: *) @@ -128,6 +130,9 @@ Hint Resolve (Seq_refl Q Qeq Q_Setoid): qarith. Hint Resolve (Seq_sym Q Qeq Q_Setoid): qarith. Hint Resolve (Seq_trans Q Qeq Q_Setoid): qarith. + +(** * Addition, multiplication and opposite *) + (** The addition, multiplication and opposite are defined in the straightforward way: *) @@ -160,133 +165,138 @@ Infix "/" := Qdiv : Q_scope. Notation " ' x " := (Zpos x) (at level 20, no associativity) : Z_scope. -(** Setoid compatibility results *) + +(** * Setoid compatibility results *) Add Morphism Qplus : Qplus_comp. Proof. -unfold Qeq, Qplus; simpl. -Open Scope Z_scope. -intros (p1, p2) (q1, q2) H (r1, r2) (s1, s2) H0; simpl in *. -simpl_mult; ring. -replace (p1 * ('s2 * 'q2)) with (p1 * 'q2 * 's2) by ring. -rewrite H. -replace ('s2 * ('q2 * r1)) with (r1 * 's2 * 'q2) by ring. -rewrite H0. -ring. -Open Scope Q_scope. + unfold Qeq, Qplus; simpl. + Open Scope Z_scope. + intros (p1, p2) (q1, q2) H (r1, r2) (s1, s2) H0; simpl in *. + simpl_mult; ring_simplify. + replace (p1 * 'r2 * 'q2) with (p1 * 'q2 * 'r2) by ring. + rewrite H. + replace (r1 * 'p2 * 'q2 * 's2) with (r1 * 's2 * 'p2 * 'q2) by ring. + rewrite H0. + ring. + Close Scope Z_scope. Qed. Add Morphism Qopp : Qopp_comp. Proof. -unfold Qeq, Qopp; simpl. -intros; ring; rewrite H; ring. + unfold Qeq, Qopp; simpl. + Open Scope Z_scope. + intros. + replace (- Qnum x1 * ' Qden x2) with (- (Qnum x1 * ' Qden x2)) by ring. + rewrite H in |- *; ring. + Close Scope Z_scope. Qed. Add Morphism Qminus : Qminus_comp. Proof. -intros. -unfold Qminus. -rewrite H; rewrite H0; auto with qarith. + intros. + unfold Qminus. + rewrite H; rewrite H0; auto with qarith. Qed. Add Morphism Qmult : Qmult_comp. Proof. -unfold Qeq; simpl. -Open Scope Z_scope. -intros (p1, p2) (q1, q2) H (r1, r2) (s1, s2) H0; simpl in *. -intros; simpl_mult; ring. -replace ('p2 * (q1 * s1)) with (q1 * 'p2 * s1) by ring. -rewrite <- H. -replace ('s2 * ('q2 * r1)) with (r1 * 's2 * 'q2) by ring. -rewrite H0. -ring. -Open Scope Q_scope. + unfold Qeq; simpl. + Open Scope Z_scope. + intros (p1, p2) (q1, q2) H (r1, r2) (s1, s2) H0; simpl in *. + intros; simpl_mult; ring_simplify. + replace (q1 * s1 * 'p2) with (q1 * 'p2 * s1) by ring. + rewrite <- H. + replace (p1 * r1 * 'q2 * 's2) with (r1 * 's2 * p1 * 'q2) by ring. + rewrite H0. + ring. + Close Scope Z_scope. Qed. Add Morphism Qinv : Qinv_comp. Proof. -unfold Qeq, Qinv; simpl. -Open Scope Z_scope. -intros (p1, p2) (q1, q2); simpl. -case p1; simpl. -intros. -assert (q1 = 0). - elim (Zmult_integral q1 ('p2)); auto with zarith. - intros; discriminate. -subst; auto. -case q1; simpl; intros; try discriminate. -rewrite (Pmult_comm p2 p); rewrite (Pmult_comm q2 p0); auto. -case q1; simpl; intros; try discriminate. -rewrite (Pmult_comm p2 p); rewrite (Pmult_comm q2 p0); auto. -Open Scope Q_scope. + unfold Qeq, Qinv; simpl. + Open Scope Z_scope. + intros (p1, p2) (q1, q2); simpl. + case p1; simpl. + intros. + assert (q1 = 0). + elim (Zmult_integral q1 ('p2)); auto with zarith. + intros; discriminate. + subst; auto. + case q1; simpl; intros; try discriminate. + rewrite (Pmult_comm p2 p); rewrite (Pmult_comm q2 p0); auto. + case q1; simpl; intros; try discriminate. + rewrite (Pmult_comm p2 p); rewrite (Pmult_comm q2 p0); auto. + Close Scope Z_scope. Qed. Add Morphism Qdiv : Qdiv_comp. Proof. -intros; unfold Qdiv. -rewrite H; rewrite H0; auto with qarith. + intros; unfold Qdiv. + rewrite H; rewrite H0; auto with qarith. Qed. Add Morphism Qle with signature Qeq ==> Qeq ==> iff as Qle_comp. Proof. -cut (forall x1 x2, x1==x2 -> forall x3 x4, x3==x4 -> x1<=x3 -> x2<=x4). -split; apply H; assumption || (apply Qeq_sym ; assumption). - -unfold Qeq, Qle; simpl. -Open Scope Z_scope. -intros (p1, p2) (q1, q2) H (r1, r2) (s1, s2) H0 H1; simpl in *. -apply Zmult_le_reg_r with ('p2). -unfold Zgt; auto. -replace (q1 * 's2 * 'p2) with (q1 * 'p2 * 's2) by ring. -rewrite <- H. -apply Zmult_le_reg_r with ('r2). -unfold Zgt; auto. -replace (s1 * 'q2 * 'p2 * 'r2) with (s1 * 'r2 * 'q2 * 'p2) by ring. -rewrite <- H0. -replace (p1 * 'q2 * 's2 * 'r2) with ('q2 * 's2 * (p1 * 'r2)) by ring. -replace (r1 * 's2 * 'q2 * 'p2) with ('q2 * 's2 * (r1 * 'p2)) by ring. -auto with zarith. -Open Scope Q_scope. + cut (forall x1 x2, x1==x2 -> forall x3 x4, x3==x4 -> x1<=x3 -> x2<=x4). + split; apply H; assumption || (apply Qeq_sym ; assumption). + + unfold Qeq, Qle; simpl. + Open Scope Z_scope. + intros (p1, p2) (q1, q2) H (r1, r2) (s1, s2) H0 H1; simpl in *. + apply Zmult_le_reg_r with ('p2). + unfold Zgt; auto. + replace (q1 * 's2 * 'p2) with (q1 * 'p2 * 's2) by ring. + rewrite <- H. + apply Zmult_le_reg_r with ('r2). + unfold Zgt; auto. + replace (s1 * 'q2 * 'p2 * 'r2) with (s1 * 'r2 * 'q2 * 'p2) by ring. + rewrite <- H0. + replace (p1 * 'q2 * 's2 * 'r2) with ('q2 * 's2 * (p1 * 'r2)) by ring. + replace (r1 * 's2 * 'q2 * 'p2) with ('q2 * 's2 * (r1 * 'p2)) by ring. + auto with zarith. + Close Scope Z_scope. Qed. Add Morphism Qlt with signature Qeq ==> Qeq ==> iff as Qlt_comp. Proof. -cut (forall x1 x2, x1==x2 -> forall x3 x4, x3==x4 -> x1<x3 -> x2<x4). -split; apply H; assumption || (apply Qeq_sym ; assumption). - -unfold Qeq, Qlt; simpl. -Open Scope Z_scope. -intros (p1, p2) (q1, q2) H (r1, r2) (s1, s2) H0 H1; simpl in *. -apply Zgt_lt. -generalize (Zlt_gt _ _ H1); clear H1; intro H1. -apply Zmult_gt_reg_r with ('p2); auto with zarith. -replace (q1 * 's2 * 'p2) with (q1 * 'p2 * 's2) by ring. -rewrite <- H. -apply Zmult_gt_reg_r with ('r2); auto with zarith. -replace (s1 * 'q2 * 'p2 * 'r2) with (s1 * 'r2 * 'q2 * 'p2) by ring. -rewrite <- H0. -replace (p1 * 'q2 * 's2 * 'r2) with ('q2 * 's2 * (p1 * 'r2)) by ring. -replace (r1 * 's2 * 'q2 * 'p2) with ('q2 * 's2 * (r1 * 'p2)) by ring. -apply Zlt_gt. -apply Zmult_gt_0_lt_compat_l; auto with zarith. -Open Scope Q_scope. + cut (forall x1 x2, x1==x2 -> forall x3 x4, x3==x4 -> x1<x3 -> x2<x4). + split; apply H; assumption || (apply Qeq_sym ; assumption). + + unfold Qeq, Qlt; simpl. + Open Scope Z_scope. + intros (p1, p2) (q1, q2) H (r1, r2) (s1, s2) H0 H1; simpl in *. + apply Zgt_lt. + generalize (Zlt_gt _ _ H1); clear H1; intro H1. + apply Zmult_gt_reg_r with ('p2); auto with zarith. + replace (q1 * 's2 * 'p2) with (q1 * 'p2 * 's2) by ring. + rewrite <- H. + apply Zmult_gt_reg_r with ('r2); auto with zarith. + replace (s1 * 'q2 * 'p2 * 'r2) with (s1 * 'r2 * 'q2 * 'p2) by ring. + rewrite <- H0. + replace (p1 * 'q2 * 's2 * 'r2) with ('q2 * 's2 * (p1 * 'r2)) by ring. + replace (r1 * 's2 * 'q2 * 'p2) with ('q2 * 's2 * (r1 * 'p2)) by ring. + apply Zlt_gt. + apply Zmult_gt_0_lt_compat_l; auto with zarith. + Close Scope Z_scope. Qed. Lemma Qcompare_egal_dec: forall n m p q : Q, - (n<m -> p<q) -> (n==m -> p==q) -> (n>m -> p>q) -> ((n?=m) = (p?=q)). + (n<m -> p<q) -> (n==m -> p==q) -> (n>m -> p>q) -> ((n?=m) = (p?=q)). Proof. -intros. -do 2 rewrite Qeq_alt in H0. -unfold Qeq, Qlt, Qcompare in *. -apply Zcompare_egal_dec; auto. -omega. + intros. + do 2 rewrite Qeq_alt in H0. + unfold Qeq, Qlt, Qcompare in *. + apply Zcompare_egal_dec; auto. + omega. Qed. Add Morphism Qcompare : Qcompare_comp. Proof. -intros; apply Qcompare_egal_dec; rewrite H; rewrite H0; auto. + intros; apply Qcompare_egal_dec; rewrite H; rewrite H0; auto. Qed. @@ -294,382 +304,387 @@ Qed. Lemma Q_apart_0_1 : ~ 1 == 0. Proof. - unfold Qeq; auto with qarith. + unfold Qeq; auto with qarith. Qed. +(** * Properties of [Qadd] *) + (** Addition is associative: *) Theorem Qplus_assoc : forall x y z, x+(y+z)==(x+y)+z. Proof. - intros (x1, x2) (y1, y2) (z1, z2). - unfold Qeq, Qplus; simpl; simpl_mult; ring. + intros (x1, x2) (y1, y2) (z1, z2). + unfold Qeq, Qplus; simpl; simpl_mult; ring. Qed. (** [0] is a neutral element for addition: *) Lemma Qplus_0_l : forall x, 0+x == x. Proof. - intros (x1, x2); unfold Qeq, Qplus; simpl; ring. + intros (x1, x2); unfold Qeq, Qplus; simpl; ring. Qed. Lemma Qplus_0_r : forall x, x+0 == x. Proof. - intros (x1, x2); unfold Qeq, Qplus; simpl. - rewrite Pmult_comm; simpl; ring. + intros (x1, x2); unfold Qeq, Qplus; simpl. + rewrite Pmult_comm; simpl; ring. Qed. (** Commutativity of addition: *) Theorem Qplus_comm : forall x y, x+y == y+x. Proof. - intros (x1, x2); unfold Qeq, Qplus; simpl. - intros; rewrite Pmult_comm; ring. + intros (x1, x2); unfold Qeq, Qplus; simpl. + intros; rewrite Pmult_comm; ring. Qed. -(** Properties of [Qopp] *) + +(** * Properties of [Qopp] *) Lemma Qopp_involutive : forall q, - -q == q. Proof. - red; simpl; intros; ring. + red; simpl; intros; ring. Qed. Theorem Qplus_opp_r : forall q, q+(-q) == 0. Proof. - red; simpl; intro; ring. + red; simpl; intro; ring. Qed. + +(** * Properties of [Qmult] *) + (** Multiplication is associative: *) Theorem Qmult_assoc : forall n m p, n*(m*p)==(n*m)*p. Proof. - intros; red; simpl; rewrite Pmult_assoc; ring. + intros; red; simpl; rewrite Pmult_assoc; ring. Qed. (** [1] is a neutral element for multiplication: *) Lemma Qmult_1_l : forall n, 1*n == n. Proof. - intro; red; simpl; destruct (Qnum n); auto. + intro; red; simpl; destruct (Qnum n); auto. Qed. Theorem Qmult_1_r : forall n, n*1==n. Proof. - intro; red; simpl. - rewrite Zmult_1_r with (n := Qnum n). - rewrite Pmult_comm; simpl; trivial. + intro; red; simpl. + rewrite Zmult_1_r with (n := Qnum n). + rewrite Pmult_comm; simpl; trivial. Qed. (** Commutativity of multiplication *) Theorem Qmult_comm : forall x y, x*y==y*x. Proof. - intros; red; simpl; rewrite Pmult_comm; ring. + intros; red; simpl; rewrite Pmult_comm; ring. Qed. -(** Distributivity *) +(** Distributivity over [Qadd] *) Theorem Qmult_plus_distr_r : forall x y z, x*(y+z)==(x*y)+(x*z). Proof. -intros (x1, x2) (y1, y2) (z1, z2). -unfold Qeq, Qmult, Qplus; simpl; simpl_mult; ring. + intros (x1, x2) (y1, y2) (z1, z2). + unfold Qeq, Qmult, Qplus; simpl; simpl_mult; ring. Qed. Theorem Qmult_plus_distr_l : forall x y z, (x+y)*z==(x*z)+(y*z). Proof. -intros (x1, x2) (y1, y2) (z1, z2). -unfold Qeq, Qmult, Qplus; simpl; simpl_mult; ring. + intros (x1, x2) (y1, y2) (z1, z2). + unfold Qeq, Qmult, Qplus; simpl; simpl_mult; ring. Qed. (** Integrality *) Theorem Qmult_integral : forall x y, x*y==0 -> x==0 \/ y==0. Proof. - intros (x1,x2) (y1,y2). - unfold Qeq, Qmult; simpl; intros. - destruct (Zmult_integral (x1*1)%Z (y1*1)%Z); auto. - rewrite <- H; ring. + intros (x1,x2) (y1,y2). + unfold Qeq, Qmult; simpl; intros. + destruct (Zmult_integral (x1*1)%Z (y1*1)%Z); auto. + rewrite <- H; ring. Qed. Theorem Qmult_integral_l : forall x y, ~ x == 0 -> x*y == 0 -> y == 0. Proof. - intros (x1, x2) (y1, y2). - unfold Qeq, Qmult; simpl; intros. - apply Zmult_integral_l with x1; auto with zarith. - rewrite <- H0; ring. + intros (x1, x2) (y1, y2). + unfold Qeq, Qmult; simpl; intros. + apply Zmult_integral_l with x1; auto with zarith. + rewrite <- H0; ring. Qed. -(** Inverse and division. *) +(** * Inverse and division. *) Theorem Qmult_inv_r : forall x, ~ x == 0 -> x*(/x) == 1. Proof. - intros (x1, x2); unfold Qeq, Qdiv, Qmult; case x1; simpl; - intros; simpl_mult; try ring. - elim H; auto. + intros (x1, x2); unfold Qeq, Qdiv, Qmult; case x1; simpl; + intros; simpl_mult; try ring. + elim H; auto. Qed. Lemma Qinv_mult_distr : forall p q, / (p * q) == /p * /q. Proof. -intros (x1,x2) (y1,y2); unfold Qeq, Qinv, Qmult; simpl. -destruct x1; simpl; auto; - destruct y1; simpl; auto. + intros (x1,x2) (y1,y2); unfold Qeq, Qinv, Qmult; simpl. + destruct x1; simpl; auto; + destruct y1; simpl; auto. Qed. Theorem Qdiv_mult_l : forall x y, ~ y == 0 -> (x*y)/y == x. Proof. - intros; unfold Qdiv. - rewrite <- (Qmult_assoc x y (Qinv y)). - rewrite (Qmult_inv_r y H). - apply Qmult_1_r. + intros; unfold Qdiv. + rewrite <- (Qmult_assoc x y (Qinv y)). + rewrite (Qmult_inv_r y H). + apply Qmult_1_r. Qed. Theorem Qmult_div_r : forall x y, ~ y == 0 -> y*(x/y) == x. Proof. - intros; unfold Qdiv. - rewrite (Qmult_assoc y x (Qinv y)). - rewrite (Qmult_comm y x). - fold (Qdiv (Qmult x y) y). - apply Qdiv_mult_l; auto. + intros; unfold Qdiv. + rewrite (Qmult_assoc y x (Qinv y)). + rewrite (Qmult_comm y x). + fold (Qdiv (Qmult x y) y). + apply Qdiv_mult_l; auto. Qed. -(** Properties of order upon Q. *) +(** * Properties of order upon Q. *) Lemma Qle_refl : forall x, x<=x. Proof. -unfold Qle; auto with zarith. + unfold Qle; auto with zarith. Qed. Lemma Qle_antisym : forall x y, x<=y -> y<=x -> x==y. Proof. -unfold Qle, Qeq; auto with zarith. + unfold Qle, Qeq; auto with zarith. Qed. Lemma Qle_trans : forall x y z, x<=y -> y<=z -> x<=z. Proof. -unfold Qle; intros (x1, x2) (y1, y2) (z1, z2); simpl; intros. -Open Scope Z_scope. -apply Zmult_le_reg_r with ('y2). -red; trivial. -apply Zle_trans with (y1 * 'x2 * 'z2). -replace (x1 * 'z2 * 'y2) with (x1 * 'y2 * 'z2) by ring. -apply Zmult_le_compat_r; auto with zarith. -replace (y1 * 'x2 * 'z2) with (y1 * 'z2 * 'x2) by ring. -replace (z1 * 'x2 * 'y2) with (z1 * 'y2 * 'x2) by ring. -apply Zmult_le_compat_r; auto with zarith. -Open Scope Q_scope. + unfold Qle; intros (x1, x2) (y1, y2) (z1, z2); simpl; intros. + Open Scope Z_scope. + apply Zmult_le_reg_r with ('y2). + red; trivial. + apply Zle_trans with (y1 * 'x2 * 'z2). + replace (x1 * 'z2 * 'y2) with (x1 * 'y2 * 'z2) by ring. + apply Zmult_le_compat_r; auto with zarith. + replace (y1 * 'x2 * 'z2) with (y1 * 'z2 * 'x2) by ring. + replace (z1 * 'x2 * 'y2) with (z1 * 'y2 * 'x2) by ring. + apply Zmult_le_compat_r; auto with zarith. + Close Scope Z_scope. Qed. Lemma Qlt_not_eq : forall x y, x<y -> ~ x==y. Proof. -unfold Qlt, Qeq; auto with zarith. + unfold Qlt, Qeq; auto with zarith. Qed. (** Large = strict or equal *) Lemma Qlt_le_weak : forall x y, x<y -> x<=y. Proof. -unfold Qle, Qlt; auto with zarith. + unfold Qle, Qlt; auto with zarith. Qed. Lemma Qle_lt_trans : forall x y z, x<=y -> y<z -> x<z. Proof. -unfold Qle, Qlt; intros (x1, x2) (y1, y2) (z1, z2); simpl; intros. -Open Scope Z_scope. -apply Zgt_lt. -apply Zmult_gt_reg_r with ('y2). -red; trivial. -apply Zgt_le_trans with (y1 * 'x2 * 'z2). -replace (y1 * 'x2 * 'z2) with (y1 * 'z2 * 'x2) by ring. -replace (z1 * 'x2 * 'y2) with (z1 * 'y2 * 'x2) by ring. -apply Zmult_gt_compat_r; auto with zarith. -replace (x1 * 'z2 * 'y2) with (x1 * 'y2 * 'z2) by ring. -apply Zmult_le_compat_r; auto with zarith. -Open Scope Q_scope. + unfold Qle, Qlt; intros (x1, x2) (y1, y2) (z1, z2); simpl; intros. + Open Scope Z_scope. + apply Zgt_lt. + apply Zmult_gt_reg_r with ('y2). + red; trivial. + apply Zgt_le_trans with (y1 * 'x2 * 'z2). + replace (y1 * 'x2 * 'z2) with (y1 * 'z2 * 'x2) by ring. + replace (z1 * 'x2 * 'y2) with (z1 * 'y2 * 'x2) by ring. + apply Zmult_gt_compat_r; auto with zarith. + replace (x1 * 'z2 * 'y2) with (x1 * 'y2 * 'z2) by ring. + apply Zmult_le_compat_r; auto with zarith. + Close Scope Z_scope. Qed. Lemma Qlt_le_trans : forall x y z, x<y -> y<=z -> x<z. Proof. -unfold Qle, Qlt; intros (x1, x2) (y1, y2) (z1, z2); simpl; intros. -Open Scope Z_scope. -apply Zgt_lt. -apply Zmult_gt_reg_r with ('y2). -red; trivial. -apply Zle_gt_trans with (y1 * 'x2 * 'z2). -replace (y1 * 'x2 * 'z2) with (y1 * 'z2 * 'x2) by ring. -replace (z1 * 'x2 * 'y2) with (z1 * 'y2 * 'x2) by ring. -apply Zmult_le_compat_r; auto with zarith. -replace (x1 * 'z2 * 'y2) with (x1 * 'y2 * 'z2) by ring. -apply Zmult_gt_compat_r; auto with zarith. -Open Scope Q_scope. + unfold Qle, Qlt; intros (x1, x2) (y1, y2) (z1, z2); simpl; intros. + Open Scope Z_scope. + apply Zgt_lt. + apply Zmult_gt_reg_r with ('y2). + red; trivial. + apply Zle_gt_trans with (y1 * 'x2 * 'z2). + replace (y1 * 'x2 * 'z2) with (y1 * 'z2 * 'x2) by ring. + replace (z1 * 'x2 * 'y2) with (z1 * 'y2 * 'x2) by ring. + apply Zmult_le_compat_r; auto with zarith. + replace (x1 * 'z2 * 'y2) with (x1 * 'y2 * 'z2) by ring. + apply Zmult_gt_compat_r; auto with zarith. + Close Scope Z_scope. Qed. Lemma Qlt_trans : forall x y z, x<y -> y<z -> x<z. Proof. -intros. -apply Qle_lt_trans with y; auto. -apply Qlt_le_weak; auto. + intros. + apply Qle_lt_trans with y; auto. + apply Qlt_le_weak; auto. Qed. (** [x<y] iff [~(y<=x)] *) Lemma Qnot_lt_le : forall x y, ~ x<y -> y<=x. Proof. -unfold Qle, Qlt; auto with zarith. + unfold Qle, Qlt; auto with zarith. Qed. Lemma Qnot_le_lt : forall x y, ~ x<=y -> y<x. Proof. -unfold Qle, Qlt; auto with zarith. + unfold Qle, Qlt; auto with zarith. Qed. Lemma Qlt_not_le : forall x y, x<y -> ~ y<=x. Proof. -unfold Qle, Qlt; auto with zarith. + unfold Qle, Qlt; auto with zarith. Qed. Lemma Qle_not_lt : forall x y, x<=y -> ~ y<x. Proof. -unfold Qle, Qlt; auto with zarith. + unfold Qle, Qlt; auto with zarith. Qed. Lemma Qle_lt_or_eq : forall x y, x<=y -> x<y \/ x==y. Proof. -unfold Qle, Qlt, Qeq; intros; apply Zle_lt_or_eq; auto. + unfold Qle, Qlt, Qeq; intros; apply Zle_lt_or_eq; auto. Qed. (** Some decidability results about orders. *) Lemma Q_dec : forall x y, {x<y} + {y<x} + {x==y}. Proof. -unfold Qlt, Qle, Qeq; intros. -exact (Z_dec' (Qnum x * QDen y) (Qnum y * QDen x)). + unfold Qlt, Qle, Qeq; intros. + exact (Z_dec' (Qnum x * QDen y) (Qnum y * QDen x)). Defined. Lemma Qlt_le_dec : forall x y, {x<y} + {y<=x}. Proof. -unfold Qlt, Qle; intros. -exact (Z_lt_le_dec (Qnum x * QDen y) (Qnum y * QDen x)). + unfold Qlt, Qle; intros. + exact (Z_lt_le_dec (Qnum x * QDen y) (Qnum y * QDen x)). Defined. (** Compatibility of operations with respect to order. *) Lemma Qopp_le_compat : forall p q, p<=q -> -q <= -p. Proof. -intros (a1,a2) (b1,b2); unfold Qle, Qlt; simpl. -do 2 rewrite <- Zopp_mult_distr_l; omega. + intros (a1,a2) (b1,b2); unfold Qle, Qlt; simpl. + do 2 rewrite <- Zopp_mult_distr_l; omega. Qed. Lemma Qle_minus_iff : forall p q, p <= q <-> 0 <= q+-p. Proof. -intros (x1,x2) (y1,y2); unfold Qle; simpl. -rewrite <- Zopp_mult_distr_l. -split; omega. + intros (x1,x2) (y1,y2); unfold Qle; simpl. + rewrite <- Zopp_mult_distr_l. + split; omega. Qed. Lemma Qlt_minus_iff : forall p q, p < q <-> 0 < q+-p. Proof. -intros (x1,x2) (y1,y2); unfold Qlt; simpl. -rewrite <- Zopp_mult_distr_l. -split; omega. + intros (x1,x2) (y1,y2); unfold Qlt; simpl. + rewrite <- Zopp_mult_distr_l. + split; omega. Qed. Lemma Qplus_le_compat : - forall x y z t, x<=y -> z<=t -> x+z <= y+t. -Proof. -unfold Qplus, Qle; intros (x1, x2) (y1, y2) (z1, z2) (t1, t2); - simpl; simpl_mult. -Open Scope Z_scope. -intros. -match goal with |- ?a <= ?b => ring a; ring b end. -apply Zplus_le_compat. -replace ('t2 * ('y2 * (z1 * 'x2))) with (z1 * 't2 * ('y2 * 'x2)) by ring. -replace ('z2 * ('x2 * (t1 * 'y2))) with (t1 * 'z2 * ('y2 * 'x2)) by ring. -apply Zmult_le_compat_r; auto with zarith. -replace ('t2 * ('y2 * ('z2 * x1))) with (x1 * 'y2 * ('z2 * 't2)) by ring. -replace ('z2 * ('x2 * ('t2 * y1))) with (y1 * 'x2 * ('z2 * 't2)) by ring. -apply Zmult_le_compat_r; auto with zarith. -Open Scope Q_scope. + forall x y z t, x<=y -> z<=t -> x+z <= y+t. +Proof. + unfold Qplus, Qle; intros (x1, x2) (y1, y2) (z1, z2) (t1, t2); + simpl; simpl_mult. + Open Scope Z_scope. + intros. + match goal with |- ?a <= ?b => ring_simplify a b end. + rewrite Zplus_comm. + apply Zplus_le_compat. + match goal with |- ?a <= ?b => ring_simplify z1 t1 ('z2) ('t2) a b end. + auto with zarith. + match goal with |- ?a <= ?b => ring_simplify x1 y1 ('x2) ('y2) a b end. + auto with zarith. + Close Scope Z_scope. Qed. Lemma Qmult_le_compat_r : forall x y z, x <= y -> 0 <= z -> x*z <= y*z. Proof. -intros (a1,a2) (b1,b2) (c1,c2); unfold Qle, Qlt; simpl. -Open Scope Z_scope. -intros; simpl_mult. -replace (a1*c1*('b2*'c2)) with ((a1*'b2)*(c1*'c2)) by ring. -replace (b1*c1*('a2*'c2)) with ((b1*'a2)*(c1*'c2)) by ring. -apply Zmult_le_compat_r; auto with zarith. -Open Scope Q_scope. + intros (a1,a2) (b1,b2) (c1,c2); unfold Qle, Qlt; simpl. + Open Scope Z_scope. + intros; simpl_mult. + replace (a1*c1*('b2*'c2)) with ((a1*'b2)*(c1*'c2)) by ring. + replace (b1*c1*('a2*'c2)) with ((b1*'a2)*(c1*'c2)) by ring. + apply Zmult_le_compat_r; auto with zarith. + Close Scope Z_scope. Qed. Lemma Qmult_lt_0_le_reg_r : forall x y z, 0 < z -> x*z <= y*z -> x <= y. Proof. -intros (a1,a2) (b1,b2) (c1,c2); unfold Qle, Qlt; simpl. -Open Scope Z_scope. -simpl_mult. -replace (a1*c1*('b2*'c2)) with ((a1*'b2)*(c1*'c2)) by ring. -replace (b1*c1*('a2*'c2)) with ((b1*'a2)*(c1*'c2)) by ring. -intros; apply Zmult_le_reg_r with (c1*'c2); auto with zarith. -Open Scope Q_scope. + intros (a1,a2) (b1,b2) (c1,c2); unfold Qle, Qlt; simpl. + Open Scope Z_scope. + simpl_mult. + replace (a1*c1*('b2*'c2)) with ((a1*'b2)*(c1*'c2)) by ring. + replace (b1*c1*('a2*'c2)) with ((b1*'a2)*(c1*'c2)) by ring. + intros; apply Zmult_le_reg_r with (c1*'c2); auto with zarith. + Close Scope Z_scope. Qed. Lemma Qmult_lt_compat_r : forall x y z, 0 < z -> x < y -> x*z < y*z. Proof. -intros (a1,a2) (b1,b2) (c1,c2); unfold Qle, Qlt; simpl. -Open Scope Z_scope. -intros; simpl_mult. -replace (a1*c1*('b2*'c2)) with ((a1*'b2)*(c1*'c2)) by ring. -replace (b1*c1*('a2*'c2)) with ((b1*'a2)*(c1*'c2)) by ring. -apply Zmult_lt_compat_r; auto with zarith. -apply Zmult_lt_0_compat. -omega. -compute; auto. -Open Scope Q_scope. + intros (a1,a2) (b1,b2) (c1,c2); unfold Qle, Qlt; simpl. + Open Scope Z_scope. + intros; simpl_mult. + replace (a1*c1*('b2*'c2)) with ((a1*'b2)*(c1*'c2)) by ring. + replace (b1*c1*('a2*'c2)) with ((b1*'a2)*(c1*'c2)) by ring. + apply Zmult_lt_compat_r; auto with zarith. + apply Zmult_lt_0_compat. + omega. + compute; auto. + Close Scope Z_scope. Qed. -(** Rational to the n-th power *) +(** * Rational to the n-th power *) Fixpoint Qpower (q:Q)(n:nat) { struct n } : Q := - match n with - | O => 1 - | S n => q * (Qpower q n) - end. + match n with + | O => 1 + | S n => q * (Qpower q n) + end. Notation " q ^ n " := (Qpower q n) : Q_scope. Lemma Qpower_1 : forall n, 1^n == 1. Proof. -induction n; simpl; auto with qarith. -rewrite IHn; auto with qarith. + induction n; simpl; auto with qarith. + rewrite IHn; auto with qarith. Qed. Lemma Qpower_0 : forall n, n<>O -> 0^n == 0. Proof. -destruct n; simpl. -destruct 1; auto. -intros. -compute; auto. + destruct n; simpl. + destruct 1; auto. + intros. + compute; auto. Qed. Lemma Qpower_pos : forall p n, 0 <= p -> 0 <= p^n. Proof. -induction n; simpl; auto with qarith. -intros; compute; intro; discriminate. -intros. -apply Qle_trans with (0*(p^n)). -compute; intro; discriminate. -apply Qmult_le_compat_r; auto. + induction n; simpl; auto with qarith. + intros; compute; intro; discriminate. + intros. + apply Qle_trans with (0*(p^n)). + compute; intro; discriminate. + apply Qmult_le_compat_r; auto. Qed. Lemma Qinv_power_n : forall n p, (1#p)^n == /(inject_Z ('p))^n. Proof. -induction n. -compute; auto. -simpl. -intros; rewrite IHn; clear IHn. -unfold Qdiv; rewrite Qinv_mult_distr. -setoid_replace (1#p) with (/ inject_Z ('p)). -apply Qeq_refl. -compute; auto. + induction n. + compute; auto. + simpl. + intros; rewrite IHn; clear IHn. + unfold Qdiv; rewrite Qinv_mult_distr. + setoid_replace (1#p) with (/ inject_Z ('p)). + apply Qeq_refl. + compute; auto. Qed. diff --git a/theories/QArith/Qcanon.v b/theories/QArith/Qcanon.v index 9cbd400d..98c5ff9e 100644 --- a/theories/QArith/Qcanon.v +++ b/theories/QArith/Qcanon.v @@ -6,9 +6,11 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Qcanon.v 8989 2006-06-25 22:17:49Z letouzey $ i*) +(*i $Id: Qcanon.v 9245 2006-10-17 12:53:34Z notin $ i*) +Require Import Field. Require Import QArith. +Require Import Znumtheory. Require Import Eqdep_dec. (** [Qc] : A canonical representation of rational numbers. @@ -22,50 +24,50 @@ Arguments Scope Qcmake [Q_scope]. Open Scope Qc_scope. Lemma Qred_identity : - forall q:Q, Zgcd (Qnum q) (QDen q) = 1%Z -> Qred q = q. + forall q:Q, Zgcd (Qnum q) (QDen q) = 1%Z -> Qred q = q. Proof. -unfold Qred; intros (a,b); simpl. -generalize (Zggcd_gcd a ('b)) (Zggcd_correct_divisors a ('b)). -intros. -rewrite H1 in H; clear H1. -destruct (Zggcd a ('b)) as (g,(aa,bb)); simpl in *; subst. -destruct H0. -rewrite Zmult_1_l in H, H0. -subst; simpl; auto. + unfold Qred; intros (a,b); simpl. + generalize (Zggcd_gcd a ('b)) (Zggcd_correct_divisors a ('b)). + intros. + rewrite H1 in H; clear H1. + destruct (Zggcd a ('b)) as (g,(aa,bb)); simpl in *; subst. + destruct H0. + rewrite Zmult_1_l in H, H0. + subst; simpl; auto. Qed. Lemma Qred_identity2 : - forall q:Q, Qred q = q -> Zgcd (Qnum q) (QDen q) = 1%Z. -Proof. -unfold Qred; intros (a,b); simpl. -generalize (Zggcd_gcd a ('b)) (Zggcd_correct_divisors a ('b)) (Zgcd_is_pos a ('b)). -intros. -rewrite <- H; rewrite <- H in H1; clear H. -destruct (Zggcd a ('b)) as (g,(aa,bb)); simpl in *; subst. -injection H2; intros; clear H2. -destruct H0. -clear H0 H3. -destruct g as [|g|g]; destruct bb as [|bb|bb]; simpl in *; try discriminate. -f_equal. -apply Pmult_reg_r with bb. -injection H2; intros. -rewrite <- H0. -rewrite H; simpl; auto. -elim H1; auto. + forall q:Q, Qred q = q -> Zgcd (Qnum q) (QDen q) = 1%Z. +Proof. + unfold Qred; intros (a,b); simpl. + generalize (Zggcd_gcd a ('b)) (Zggcd_correct_divisors a ('b)) (Zgcd_is_pos a ('b)). + intros. + rewrite <- H; rewrite <- H in H1; clear H. + destruct (Zggcd a ('b)) as (g,(aa,bb)); simpl in *; subst. + injection H2; intros; clear H2. + destruct H0. + clear H0 H3. + destruct g as [|g|g]; destruct bb as [|bb|bb]; simpl in *; try discriminate. + f_equal. + apply Pmult_reg_r with bb. + injection H2; intros. + rewrite <- H0. + rewrite H; simpl; auto. + elim H1; auto. Qed. Lemma Qred_iff : forall q:Q, Qred q = q <-> Zgcd (Qnum q) (QDen q) = 1%Z. Proof. -split; intros. -apply Qred_identity2; auto. -apply Qred_identity; auto. + split; intros. + apply Qred_identity2; auto. + apply Qred_identity; auto. Qed. Lemma Qred_involutive : forall q:Q, Qred (Qred q) = Qred q. Proof. -intros; apply Qred_complete. -apply Qred_correct. + intros; apply Qred_complete. + apply Qred_correct. Qed. Definition Q2Qc (q:Q) : Qc := Qcmake (Qred q) (Qred_involutive q). @@ -74,16 +76,16 @@ Notation " !! " := Q2Qc : Qc_scope. Lemma Qc_is_canon : forall q q' : Qc, q == q' -> q = q'. Proof. -intros (q,proof_q) (q',proof_q'). -simpl. -intros H. -assert (H0:=Qred_complete _ _ H). -assert (q = q') by congruence. -subst q'. -assert (proof_q = proof_q'). - apply eq_proofs_unicity; auto; intros. - repeat decide equality. -congruence. + intros (q,proof_q) (q',proof_q'). + simpl. + intros H. + assert (H0:=Qred_complete _ _ H). + assert (q = q') by congruence. + subst q'. + assert (proof_q = proof_q'). + apply eq_proofs_unicity; auto; intros. + repeat decide equality. + congruence. Qed. Hint Resolve Qc_is_canon. @@ -105,39 +107,39 @@ Notation "p ?= q" := (Qccompare p q) : Qc_scope. Lemma Qceq_alt : forall p q, (p = q) <-> (p ?= q) = Eq. Proof. -unfold Qccompare. -intros; rewrite <- Qeq_alt. -split; auto. -intro H; rewrite H; auto with qarith. + unfold Qccompare. + intros; rewrite <- Qeq_alt. + split; auto. + intro H; rewrite H; auto with qarith. Qed. Lemma Qclt_alt : forall p q, (p<q) <-> (p?=q = Lt). Proof. -intros; exact (Qlt_alt p q). + intros; exact (Qlt_alt p q). Qed. Lemma Qcgt_alt : forall p q, (p>q) <-> (p?=q = Gt). Proof. -intros; exact (Qgt_alt p q). + intros; exact (Qgt_alt p q). Qed. Lemma Qle_alt : forall p q, (p<=q) <-> (p?=q <> Gt). Proof. -intros; exact (Qle_alt p q). + intros; exact (Qle_alt p q). Qed. Lemma Qge_alt : forall p q, (p>=q) <-> (p?=q <> Lt). Proof. -intros; exact (Qge_alt p q). + intros; exact (Qge_alt p q). Qed. (** equality on [Qc] is decidable: *) Theorem Qc_eq_dec : forall x y:Qc, {x=y} + {x<>y}. Proof. - intros. - destruct (Qeq_dec x y) as [H|H]; auto. - right; swap H; subst; auto with qarith. + intros. + destruct (Qeq_dec x y) as [H|H]; auto. + right; swap H; subst; auto with qarith. Defined. (** The addition, multiplication and opposite are defined @@ -160,8 +162,8 @@ Infix "/" := Qcdiv : Qc_scope. Lemma Q_apart_0_1 : 1 <> 0. Proof. - unfold Q2Qc. - intros H; discriminate H. + unfold Q2Qc. + intros H; discriminate H. Qed. Ltac qc := match goal with @@ -175,309 +177,309 @@ Opaque Qred. Theorem Qcplus_assoc : forall x y z, x+(y+z)=(x+y)+z. Proof. - intros; qc; apply Qplus_assoc. + intros; qc; apply Qplus_assoc. Qed. (** [0] is a neutral element for addition: *) Lemma Qcplus_0_l : forall x, 0+x = x. Proof. - intros; qc; apply Qplus_0_l. + intros; qc; apply Qplus_0_l. Qed. Lemma Qcplus_0_r : forall x, x+0 = x. Proof. - intros; qc; apply Qplus_0_r. + intros; qc; apply Qplus_0_r. Qed. (** Commutativity of addition: *) Theorem Qcplus_comm : forall x y, x+y = y+x. Proof. - intros; qc; apply Qplus_comm. + intros; qc; apply Qplus_comm. Qed. (** Properties of [Qopp] *) Lemma Qcopp_involutive : forall q, - -q = q. Proof. - intros; qc; apply Qopp_involutive. + intros; qc; apply Qopp_involutive. Qed. Theorem Qcplus_opp_r : forall q, q+(-q) = 0. Proof. - intros; qc; apply Qplus_opp_r. + intros; qc; apply Qplus_opp_r. Qed. (** Multiplication is associative: *) Theorem Qcmult_assoc : forall n m p, n*(m*p)=(n*m)*p. Proof. - intros; qc; apply Qmult_assoc. + intros; qc; apply Qmult_assoc. Qed. (** [1] is a neutral element for multiplication: *) Lemma Qcmult_1_l : forall n, 1*n = n. Proof. - intros; qc; apply Qmult_1_l. + intros; qc; apply Qmult_1_l. Qed. Theorem Qcmult_1_r : forall n, n*1=n. Proof. - intros; qc; apply Qmult_1_r. + intros; qc; apply Qmult_1_r. Qed. (** Commutativity of multiplication *) Theorem Qcmult_comm : forall x y, x*y=y*x. Proof. - intros; qc; apply Qmult_comm. + intros; qc; apply Qmult_comm. Qed. (** Distributivity *) Theorem Qcmult_plus_distr_r : forall x y z, x*(y+z)=(x*y)+(x*z). Proof. - intros; qc; apply Qmult_plus_distr_r. + intros; qc; apply Qmult_plus_distr_r. Qed. Theorem Qcmult_plus_distr_l : forall x y z, (x+y)*z=(x*z)+(y*z). Proof. - intros; qc; apply Qmult_plus_distr_l. + intros; qc; apply Qmult_plus_distr_l. Qed. (** Integrality *) Theorem Qcmult_integral : forall x y, x*y=0 -> x=0 \/ y=0. Proof. - intros. - destruct (Qmult_integral x y); try qc; auto. - injection H; clear H; intros. - rewrite <- (Qred_correct (x*y)). - rewrite <- (Qred_correct 0). - rewrite H; auto with qarith. + intros. + destruct (Qmult_integral x y); try qc; auto. + injection H; clear H; intros. + rewrite <- (Qred_correct (x*y)). + rewrite <- (Qred_correct 0). + rewrite H; auto with qarith. Qed. Theorem Qcmult_integral_l : forall x y, ~ x = 0 -> x*y = 0 -> y = 0. Proof. - intros; destruct (Qcmult_integral _ _ H0); tauto. + intros; destruct (Qcmult_integral _ _ H0); tauto. Qed. (** Inverse and division. *) Theorem Qcmult_inv_r : forall x, x<>0 -> x*(/x) = 1. Proof. - intros; qc; apply Qmult_inv_r; auto. + intros; qc; apply Qmult_inv_r; auto. Qed. Theorem Qcmult_inv_l : forall x, x<>0 -> (/x)*x = 1. Proof. - intros. - rewrite Qcmult_comm. - apply Qcmult_inv_r; auto. + intros. + rewrite Qcmult_comm. + apply Qcmult_inv_r; auto. Qed. Lemma Qcinv_mult_distr : forall p q, / (p * q) = /p * /q. Proof. - intros; qc; apply Qinv_mult_distr. + intros; qc; apply Qinv_mult_distr. Qed. Theorem Qcdiv_mult_l : forall x y, y<>0 -> (x*y)/y = x. Proof. - unfold Qcdiv. - intros. - rewrite <- Qcmult_assoc. - rewrite Qcmult_inv_r; auto. - apply Qcmult_1_r. + unfold Qcdiv. + intros. + rewrite <- Qcmult_assoc. + rewrite Qcmult_inv_r; auto. + apply Qcmult_1_r. Qed. Theorem Qcmult_div_r : forall x y, ~ y = 0 -> y*(x/y) = x. Proof. - unfold Qcdiv. - intros. - rewrite Qcmult_assoc. - rewrite Qcmult_comm. - rewrite Qcmult_assoc. - rewrite Qcmult_inv_l; auto. - apply Qcmult_1_l. + unfold Qcdiv. + intros. + rewrite Qcmult_assoc. + rewrite Qcmult_comm. + rewrite Qcmult_assoc. + rewrite Qcmult_inv_l; auto. + apply Qcmult_1_l. Qed. (** Properties of order upon Q. *) Lemma Qcle_refl : forall x, x<=x. Proof. -unfold Qcle; intros; simpl; apply Qle_refl. + unfold Qcle; intros; simpl; apply Qle_refl. Qed. Lemma Qcle_antisym : forall x y, x<=y -> y<=x -> x=y. Proof. -unfold Qcle; intros; simpl in *. -apply Qc_is_canon; apply Qle_antisym; auto. + unfold Qcle; intros; simpl in *. + apply Qc_is_canon; apply Qle_antisym; auto. Qed. Lemma Qcle_trans : forall x y z, x<=y -> y<=z -> x<=z. Proof. -unfold Qcle; intros; eapply Qle_trans; eauto. + unfold Qcle; intros; eapply Qle_trans; eauto. Qed. Lemma Qclt_not_eq : forall x y, x<y -> x<>y. Proof. -unfold Qclt; intros; simpl in *. -intro; destruct (Qlt_not_eq _ _ H). -subst; auto with qarith. + unfold Qclt; intros; simpl in *. + intro; destruct (Qlt_not_eq _ _ H). + subst; auto with qarith. Qed. (** Large = strict or equal *) Lemma Qclt_le_weak : forall x y, x<y -> x<=y. Proof. -unfold Qcle, Qclt; intros; apply Qlt_le_weak; auto. + unfold Qcle, Qclt; intros; apply Qlt_le_weak; auto. Qed. Lemma Qcle_lt_trans : forall x y z, x<=y -> y<z -> x<z. Proof. -unfold Qcle, Qclt; intros; eapply Qle_lt_trans; eauto. + unfold Qcle, Qclt; intros; eapply Qle_lt_trans; eauto. Qed. Lemma Qclt_le_trans : forall x y z, x<y -> y<=z -> x<z. Proof. -unfold Qcle, Qclt; intros; eapply Qlt_le_trans; eauto. + unfold Qcle, Qclt; intros; eapply Qlt_le_trans; eauto. Qed. Lemma Qlt_trans : forall x y z, x<y -> y<z -> x<z. Proof. -unfold Qclt; intros; eapply Qlt_trans; eauto. + unfold Qclt; intros; eapply Qlt_trans; eauto. Qed. (** [x<y] iff [~(y<=x)] *) Lemma Qcnot_lt_le : forall x y, ~ x<y -> y<=x. Proof. -unfold Qcle, Qclt; intros; apply Qnot_lt_le; auto. + unfold Qcle, Qclt; intros; apply Qnot_lt_le; auto. Qed. Lemma Qcnot_le_lt : forall x y, ~ x<=y -> y<x. Proof. -unfold Qcle, Qclt; intros; apply Qnot_le_lt; auto. + unfold Qcle, Qclt; intros; apply Qnot_le_lt; auto. Qed. Lemma Qclt_not_le : forall x y, x<y -> ~ y<=x. Proof. -unfold Qcle, Qclt; intros; apply Qlt_not_le; auto. + unfold Qcle, Qclt; intros; apply Qlt_not_le; auto. Qed. Lemma Qcle_not_lt : forall x y, x<=y -> ~ y<x. Proof. -unfold Qcle, Qclt; intros; apply Qle_not_lt; auto. + unfold Qcle, Qclt; intros; apply Qle_not_lt; auto. Qed. Lemma Qcle_lt_or_eq : forall x y, x<=y -> x<y \/ x==y. Proof. -unfold Qcle, Qclt; intros; apply Qle_lt_or_eq; auto. + unfold Qcle, Qclt; intros; apply Qle_lt_or_eq; auto. Qed. (** Some decidability results about orders. *) Lemma Qc_dec : forall x y, {x<y} + {y<x} + {x=y}. Proof. -unfold Qclt, Qcle; intros. -destruct (Q_dec x y) as [H|H]. -left; auto. -right; apply Qc_is_canon; auto. + unfold Qclt, Qcle; intros. + destruct (Q_dec x y) as [H|H]. + left; auto. + right; apply Qc_is_canon; auto. Defined. Lemma Qclt_le_dec : forall x y, {x<y} + {y<=x}. Proof. -unfold Qclt, Qcle; intros; apply Qlt_le_dec; auto. + unfold Qclt, Qcle; intros; apply Qlt_le_dec; auto. Defined. (** Compatibility of operations with respect to order. *) Lemma Qcopp_le_compat : forall p q, p<=q -> -q <= -p. Proof. -unfold Qcle, Qcopp; intros; simpl in *. -repeat rewrite Qred_correct. -apply Qopp_le_compat; auto. + unfold Qcle, Qcopp; intros; simpl in *. + repeat rewrite Qred_correct. + apply Qopp_le_compat; auto. Qed. Lemma Qcle_minus_iff : forall p q, p <= q <-> 0 <= q+-p. Proof. -unfold Qcle, Qcminus; intros; simpl in *. -repeat rewrite Qred_correct. -apply Qle_minus_iff; auto. + unfold Qcle, Qcminus; intros; simpl in *. + repeat rewrite Qred_correct. + apply Qle_minus_iff; auto. Qed. Lemma Qclt_minus_iff : forall p q, p < q <-> 0 < q+-p. Proof. -unfold Qclt, Qcplus, Qcopp; intros; simpl in *. -repeat rewrite Qred_correct. -apply Qlt_minus_iff; auto. + unfold Qclt, Qcplus, Qcopp; intros; simpl in *. + repeat rewrite Qred_correct. + apply Qlt_minus_iff; auto. Qed. Lemma Qcplus_le_compat : - forall x y z t, x<=y -> z<=t -> x+z <= y+t. + forall x y z t, x<=y -> z<=t -> x+z <= y+t. Proof. -unfold Qcplus, Qcle; intros; simpl in *. -repeat rewrite Qred_correct. -apply Qplus_le_compat; auto. + unfold Qcplus, Qcle; intros; simpl in *. + repeat rewrite Qred_correct. + apply Qplus_le_compat; auto. Qed. Lemma Qcmult_le_compat_r : forall x y z, x <= y -> 0 <= z -> x*z <= y*z. Proof. -unfold Qcmult, Qcle; intros; simpl in *. -repeat rewrite Qred_correct. -apply Qmult_le_compat_r; auto. + unfold Qcmult, Qcle; intros; simpl in *. + repeat rewrite Qred_correct. + apply Qmult_le_compat_r; auto. Qed. Lemma Qcmult_lt_0_le_reg_r : forall x y z, 0 < z -> x*z <= y*z -> x <= y. Proof. -unfold Qcmult, Qcle, Qclt; intros; simpl in *. -repeat progress rewrite Qred_correct in * |-. -eapply Qmult_lt_0_le_reg_r; eauto. + unfold Qcmult, Qcle, Qclt; intros; simpl in *. + repeat progress rewrite Qred_correct in * |-. + eapply Qmult_lt_0_le_reg_r; eauto. Qed. Lemma Qcmult_lt_compat_r : forall x y z, 0 < z -> x < y -> x*z < y*z. Proof. -unfold Qcmult, Qclt; intros; simpl in *. -repeat progress rewrite Qred_correct in *. -eapply Qmult_lt_compat_r; eauto. + unfold Qcmult, Qclt; intros; simpl in *. + repeat progress rewrite Qred_correct in *. + eapply Qmult_lt_compat_r; eauto. Qed. (** Rational to the n-th power *) Fixpoint Qcpower (q:Qc)(n:nat) { struct n } : Qc := - match n with - | O => 1 - | S n => q * (Qcpower q n) - end. + match n with + | O => 1 + | S n => q * (Qcpower q n) + end. Notation " q ^ n " := (Qcpower q n) : Qc_scope. Lemma Qcpower_1 : forall n, 1^n = 1. Proof. -induction n; simpl; auto with qarith. -rewrite IHn; auto with qarith. + induction n; simpl; auto with qarith. + rewrite IHn; auto with qarith. Qed. Lemma Qcpower_0 : forall n, n<>O -> 0^n = 0. Proof. -destruct n; simpl. -destruct 1; auto. -intros. -apply Qc_is_canon. -simpl. -compute; auto. + destruct n; simpl. + destruct 1; auto. + intros. + apply Qc_is_canon. + simpl. + compute; auto. Qed. Lemma Qpower_pos : forall p n, 0 <= p -> 0 <= p^n. Proof. -induction n; simpl; auto with qarith. -intros; compute; intro; discriminate. -intros. -apply Qcle_trans with (0*(p^n)). -compute; intro; discriminate. -apply Qcmult_le_compat_r; auto. + induction n; simpl; auto with qarith. + intros; compute; intro; discriminate. + intros. + apply Qcle_trans with (0*(p^n)). + compute; intro; discriminate. + apply Qcmult_le_compat_r; auto. Qed. (** And now everything is easier concerning tactics: *) @@ -488,10 +490,12 @@ Definition Qc_eq_bool (x y : Qc) := if Qc_eq_dec x y then true else false. Lemma Qc_eq_bool_correct : forall x y : Qc, Qc_eq_bool x y = true -> x=y. -intros x y; unfold Qc_eq_bool in |- *; case (Qc_eq_dec x y); simpl in |- *; auto. -intros _ H; inversion H. +Proof. + intros x y; unfold Qc_eq_bool in |- *; case (Qc_eq_dec x y); simpl in |- *; auto. + intros _ H; inversion H. Qed. +(* Definition Qcrt : Ring_Theory Qcplus Qcmult 1 0 Qcopp Qc_eq_bool. Proof. constructor. @@ -506,17 +510,37 @@ exact Qcmult_plus_distr_l. unfold Is_true; intros x y; generalize (Qc_eq_bool_correct x y); case (Qc_eq_bool x y); auto. Qed. - Add Ring Qc Qcplus Qcmult 1 0 Qcopp Qc_eq_bool Qcrt [ Qcmake ]. +*) +Definition Qcrt : ring_theory 0 1 Qcplus Qcmult Qcminus Qcopp (eq(A:=Qc)). +Proof. + constructor. + exact Qcplus_0_l. + exact Qcplus_comm. + exact Qcplus_assoc. + exact Qcmult_1_l. + exact Qcmult_comm. + exact Qcmult_assoc. + exact Qcmult_plus_distr_l. + reflexivity. + exact Qcplus_opp_r. +Qed. -(** A field tactic for rational numbers *) +Definition Qcft : + field_theory 0%Qc 1%Qc Qcplus Qcmult Qcminus Qcopp Qcdiv Qcinv (eq(A:=Qc)). +Proof. + constructor. + exact Qcrt. + exact Q_apart_0_1. + reflexivity. + exact Qcmult_inv_l. +Qed. -Require Import Field. +Add Field Qcfield : Qcft. -Add Field Qc Qcplus Qcmult 1 0 Qcopp Qc_eq_bool Qcinv Qcrt Qcmult_inv_l - with div:=Qcdiv. +(** A field tactic for rational numbers *) -Example test_field : forall x y : Qc, y<>0 -> (x/y)*y = x. +Example test_field : (forall x y : Qc, y<>0 -> (x/y)*y = x)%Qc. intros. field. auto. diff --git a/theories/QArith/Qreals.v b/theories/QArith/Qreals.v index 5b7480c1..6bd161f3 100644 --- a/theories/QArith/Qreals.v +++ b/theories/QArith/Qreals.v @@ -6,12 +6,12 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Qreals.v 8883 2006-05-31 21:56:37Z letouzey $ i*) +(*i $Id: Qreals.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Export Rbase. Require Export QArith_base. -(** * A field tactic for rational numbers. *) +(** A field tactic for rational numbers. *) (** Since field cannot operate on setoid datatypes (yet?), we translate Q goals into reals before applying field. *) @@ -52,8 +52,9 @@ assert ((X1 * Y2)%R = (Y1 * X2)%R). unfold X1, X2, Y1, Y2 in |- *; do 2 rewrite <- mult_IZR. apply IZR_eq; auto. clear H. -field; auto. -rewrite <- H0; field; auto. +field_simplify_eq; auto. +ring_simplify X1 Y2 (Y2 * X1)%R. +rewrite H0 in |- *; ring. Qed. Lemma Rle_Qle : forall x y : Q, (Q2R x <= Q2R y)%R -> x<=y. @@ -176,16 +177,11 @@ unfold Qinv, Q2R, Qeq in |- *; intros (x1, x2); unfold Qden, Qnum in |- *. case x1. simpl in |- *; intros; elim H; trivial. intros; field; auto. -apply Rmult_integral_contrapositive; split; auto. -apply Rmult_integral_contrapositive; split; auto. -apply Rinv_neq_0_compat; auto. -intros; field; auto. -do 2 rewrite <- mult_IZR. -simpl in |- *; rewrite Pmult_comm; auto. -apply Rmult_integral_contrapositive; split; auto. -apply Rmult_integral_contrapositive; split; auto. -apply not_O_IZR; auto with qarith. -apply Rinv_neq_0_compat; auto. +intros; + change (IZR (Zneg x2)) with (- IZR (' x2))%R in |- *; + change (IZR (Zneg p)) with (- IZR (' p))%R in |- *; + field; (*auto 8 with real.*) + repeat split; auto; auto with real. Qed. Lemma Q2R_div : @@ -210,4 +206,4 @@ Goal forall x y : Q, ~ y==0#1 -> (x/y)*y == x. intros; QField. intro; apply H; apply eqR_Qeq. rewrite H0; unfold Q2R in |- *; simpl in |- *; field; auto with real. -Abort.
\ No newline at end of file +Abort. diff --git a/theories/QArith/Qreduction.v b/theories/QArith/Qreduction.v index c503daad..340cac83 100644 --- a/theories/QArith/Qreduction.v +++ b/theories/QArith/Qreduction.v @@ -6,12 +6,12 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Qreduction.v 8989 2006-06-25 22:17:49Z letouzey $ i*) +(*i $Id: Qreduction.v 9245 2006-10-17 12:53:34Z notin $ i*) -(** * Normalisation functions for rational numbers. *) +(** Normalisation functions for rational numbers. *) Require Export QArith_base. -Require Export Znumtheory. +Require Import Znumtheory. (** First, a function that (tries to) build a positive back from a Z. *) @@ -42,104 +42,105 @@ Definition Qred (q:Q) := Lemma Qred_correct : forall q, (Qred q) == q. Proof. -unfold Qred, Qeq; intros (n,d); simpl. -generalize (Zggcd_gcd n ('d)) (Zgcd_is_pos n ('d)) - (Zgcd_is_gcd n ('d)) (Zggcd_correct_divisors n ('d)). -destruct (Zggcd n (Zpos d)) as (g,(nn,dd)); simpl. -Open Scope Z_scope. -intuition. -rewrite <- H in H0,H1; clear H. -rewrite H3; rewrite H4. -assert (0 <> g). + unfold Qred, Qeq; intros (n,d); simpl. + generalize (Zggcd_gcd n ('d)) (Zgcd_is_pos n ('d)) + (Zgcd_is_gcd n ('d)) (Zggcd_correct_divisors n ('d)). + destruct (Zggcd n (Zpos d)) as (g,(nn,dd)); simpl. + Open Scope Z_scope. + intuition. + rewrite <- H in H0,H1; clear H. + rewrite H3; rewrite H4. + assert (0 <> g). intro; subst g; discriminate. - -assert (0 < dd). + + assert (0 < dd). apply Zmult_gt_0_lt_0_reg_r with g. omega. rewrite Zmult_comm. rewrite <- H4; compute; auto. -rewrite Z2P_correct; auto. -ring. + rewrite Z2P_correct; auto. + ring. + Close Scope Z_scope. Qed. Lemma Qred_complete : forall p q, p==q -> Qred p = Qred q. Proof. -intros (a,b) (c,d). -unfold Qred, Qeq in *; simpl in *. -Open Scope Z_scope. -generalize (Zggcd_gcd a ('b)) (Zgcd_is_gcd a ('b)) - (Zgcd_is_pos a ('b)) (Zggcd_correct_divisors a ('b)). -destruct (Zggcd a (Zpos b)) as (g,(aa,bb)). -generalize (Zggcd_gcd c ('d)) (Zgcd_is_gcd c ('d)) - (Zgcd_is_pos c ('d)) (Zggcd_correct_divisors c ('d)). -destruct (Zggcd c (Zpos d)) as (g',(cc,dd)). -simpl. -intro H; rewrite <- H; clear H. -intros Hg'1 Hg'2 (Hg'3,Hg'4). -intro H; rewrite <- H; clear H. -intros Hg1 Hg2 (Hg3,Hg4). -intros. -assert (g <> 0). + intros (a,b) (c,d). + unfold Qred, Qeq in *; simpl in *. + Open Scope Z_scope. + generalize (Zggcd_gcd a ('b)) (Zgcd_is_gcd a ('b)) + (Zgcd_is_pos a ('b)) (Zggcd_correct_divisors a ('b)). + destruct (Zggcd a (Zpos b)) as (g,(aa,bb)). + generalize (Zggcd_gcd c ('d)) (Zgcd_is_gcd c ('d)) + (Zgcd_is_pos c ('d)) (Zggcd_correct_divisors c ('d)). + destruct (Zggcd c (Zpos d)) as (g',(cc,dd)). + simpl. + intro H; rewrite <- H; clear H. + intros Hg'1 Hg'2 (Hg'3,Hg'4). + intro H; rewrite <- H; clear H. + intros Hg1 Hg2 (Hg3,Hg4). + intros. + assert (g <> 0). intro; subst g; discriminate. -assert (g' <> 0). + assert (g' <> 0). intro; subst g'; discriminate. -elim (rel_prime_cross_prod aa bb cc dd). -congruence. -unfold rel_prime in |- *. -(*rel_prime*) -constructor. -exists aa; auto with zarith. -exists bb; auto with zarith. -intros. -inversion Hg1. -destruct (H6 (g*x)). -rewrite Hg3. -destruct H2 as (xa,Hxa); exists xa; rewrite Hxa; ring. -rewrite Hg4. -destruct H3 as (xb,Hxb); exists xb; rewrite Hxb; ring. -exists q. -apply Zmult_reg_l with g; auto. -pattern g at 1; rewrite H7; ring. -(* /rel_prime *) -unfold rel_prime in |- *. -(* rel_prime *) -constructor. -exists cc; auto with zarith. -exists dd; auto with zarith. -intros. -inversion Hg'1. -destruct (H6 (g'*x)). -rewrite Hg'3. -destruct H2 as (xc,Hxc); exists xc; rewrite Hxc; ring. -rewrite Hg'4. -destruct H3 as (xd,Hxd); exists xd; rewrite Hxd; ring. -exists q. -apply Zmult_reg_l with g'; auto. -pattern g' at 1; rewrite H7; ring. -(* /rel_prime *) -assert (0<bb); [|auto with zarith]. + elim (rel_prime_cross_prod aa bb cc dd). + congruence. + unfold rel_prime in |- *. + (*rel_prime*) + constructor. + exists aa; auto with zarith. + exists bb; auto with zarith. + intros. + inversion Hg1. + destruct (H6 (g*x)). + rewrite Hg3. + destruct H2 as (xa,Hxa); exists xa; rewrite Hxa; ring. + rewrite Hg4. + destruct H3 as (xb,Hxb); exists xb; rewrite Hxb; ring. + exists q. + apply Zmult_reg_l with g; auto. + pattern g at 1; rewrite H7; ring. + (* /rel_prime *) + unfold rel_prime in |- *. + (* rel_prime *) + constructor. + exists cc; auto with zarith. + exists dd; auto with zarith. + intros. + inversion Hg'1. + destruct (H6 (g'*x)). + rewrite Hg'3. + destruct H2 as (xc,Hxc); exists xc; rewrite Hxc; ring. + rewrite Hg'4. + destruct H3 as (xd,Hxd); exists xd; rewrite Hxd; ring. + exists q. + apply Zmult_reg_l with g'; auto. + pattern g' at 1; rewrite H7; ring. + (* /rel_prime *) + assert (0<bb); [|auto with zarith]. apply Zmult_gt_0_lt_0_reg_r with g. omega. rewrite Zmult_comm. rewrite <- Hg4; compute; auto. -assert (0<dd); [|auto with zarith]. + assert (0<dd); [|auto with zarith]. apply Zmult_gt_0_lt_0_reg_r with g'. omega. rewrite Zmult_comm. rewrite <- Hg'4; compute; auto. -apply Zmult_reg_l with (g'*g). -intro H2; elim (Zmult_integral _ _ H2); auto. -replace (g'*g*(aa*dd)) with ((g*aa)*(g'*dd)); [|ring]. -replace (g'*g*(bb*cc)) with ((g'*cc)*(g*bb)); [|ring]. -rewrite <- Hg3; rewrite <- Hg4; rewrite <- Hg'3; rewrite <- Hg'4; auto. -Open Scope Q_scope. + apply Zmult_reg_l with (g'*g). + intro H2; elim (Zmult_integral _ _ H2); auto. + replace (g'*g*(aa*dd)) with ((g*aa)*(g'*dd)); [|ring]. + replace (g'*g*(bb*cc)) with ((g'*cc)*(g*bb)); [|ring]. + rewrite <- Hg3; rewrite <- Hg4; rewrite <- Hg'3; rewrite <- Hg'4; auto. + Close Scope Z_scope. Qed. Add Morphism Qred : Qred_comp. Proof. -intros q q' H. -rewrite (Qred_correct q); auto. -rewrite (Qred_correct q'); auto. + intros q q' H. + rewrite (Qred_correct q); auto. + rewrite (Qred_correct q'); auto. Qed. Definition Qplus' (p q : Q) := Qred (Qplus p q). @@ -147,22 +148,22 @@ Definition Qmult' (p q : Q) := Qred (Qmult p q). Lemma Qplus'_correct : forall p q : Q, (Qplus' p q)==(Qplus p q). Proof. -intros; unfold Qplus' in |- *; apply Qred_correct; auto. + intros; unfold Qplus' in |- *; apply Qred_correct; auto. Qed. Lemma Qmult'_correct : forall p q : Q, (Qmult' p q)==(Qmult p q). Proof. -intros; unfold Qmult' in |- *; apply Qred_correct; auto. + intros; unfold Qmult' in |- *; apply Qred_correct; auto. Qed. Add Morphism Qplus' : Qplus'_comp. Proof. -intros; unfold Qplus' in |- *. -rewrite H; rewrite H0; auto with qarith. + intros; unfold Qplus' in |- *. + rewrite H; rewrite H0; auto with qarith. Qed. Add Morphism Qmult' : Qmult'_comp. -intros; unfold Qmult' in |- *. -rewrite H; rewrite H0; auto with qarith. + intros; unfold Qmult' in |- *. + rewrite H; rewrite H0; auto with qarith. Qed. diff --git a/theories/QArith/Qring.v b/theories/QArith/Qring.v index 774b20f4..9d294805 100644 --- a/theories/QArith/Qring.v +++ b/theories/QArith/Qring.v @@ -6,10 +6,9 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Qring.v 8883 2006-05-31 21:56:37Z letouzey $ i*) +(*i $Id: Qring.v 9245 2006-10-17 12:53:34Z notin $ i*) -Require Import Ring. -Require Export Setoid_ring. +Require Export Ring. Require Export QArith_base. (** * A ring tactic for rational numbers *) @@ -18,74 +17,88 @@ Definition Qeq_bool (x y : Q) := if Qeq_dec x y then true else false. Lemma Qeq_bool_correct : forall x y : Q, Qeq_bool x y = true -> x==y. -intros x y; unfold Qeq_bool in |- *; case (Qeq_dec x y); simpl in |- *; auto. -intros _ H; inversion H. +Proof. + intros x y; unfold Qeq_bool in |- *; case (Qeq_dec x y); simpl in |- *; auto. + intros _ H; inversion H. Qed. -Definition Qsrt : Setoid_Ring_Theory Qeq Qplus Qmult 1 0 Qopp Qeq_bool. +Definition Qsrt : ring_theory 0 1 Qplus Qmult Qminus Qopp Qeq. Proof. -constructor. -exact Qplus_comm. -exact Qplus_assoc. -exact Qmult_comm. -exact Qmult_assoc. -exact Qplus_0_l. -exact Qmult_1_l. -exact Qplus_opp_r. -exact Qmult_plus_distr_l. -unfold Is_true; intros x y; generalize (Qeq_bool_correct x y); - case (Qeq_bool x y); auto. + constructor. + exact Qplus_0_l. + exact Qplus_comm. + exact Qplus_assoc. + exact Qmult_1_l. + exact Qmult_comm. + exact Qmult_assoc. + exact Qmult_plus_distr_l. + reflexivity. + exact Qplus_opp_r. Qed. -Add Setoid Ring Q Qeq Q_Setoid Qplus Qmult 1 0 Qopp Qeq_bool - Qplus_comp Qmult_comp Qopp_comp Qsrt - [ Qmake (*inject_Z*) Zpos 0%Z Zneg xI xO 1%positive ]. - +Ltac isQcst t := + let t := eval hnf in t in + match t with + Qmake ?n ?d => + match isZcst n with + true => isZcst d + | _ => false + end + | _ => false + end. + +Ltac Qcst t := + match isQcst t with + true => t + | _ => NotConstant + end. + +Add Ring Qring : Qsrt (decidable Qeq_bool_correct, constants [Qcst]). (** Exemple of use: *) Section Examples. Let ex1 : forall x y z : Q, (x+y)*z == (x*z)+(y*z). -intros. -ring. + intros. + ring. Qed. Let ex2 : forall x y : Q, x+y == y+x. -intros. -ring. + intros. + ring. Qed. Let ex3 : forall x y z : Q, (x+y)+z == x+(y+z). -intros. -ring. + intros. + ring. Qed. Let ex4 : (inject_Z 1)+(inject_Z 1)==(inject_Z 2). -ring. + ring. Qed. Let ex5 : 1+1 == 2#1. -ring. + ring. Qed. Let ex6 : (1#1)+(1#1) == 2#1. -ring. + ring. Qed. Let ex7 : forall x : Q, x-x== 0#1. -intro. -ring. + intro. + ring. Qed. End Examples. Lemma Qopp_plus : forall a b, -(a+b) == -a + -b. Proof. -intros; ring. + intros; ring. Qed. Lemma Qopp_opp : forall q, - -q==q. Proof. -intros; ring. + intros; ring. Qed. diff --git a/theories/Reals/Alembert.v b/theories/Reals/Alembert.v index e6bc69b6..802bfa71 100644 --- a/theories/Reals/Alembert.v +++ b/theories/Reals/Alembert.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Alembert.v 8670 2006-03-28 22:16:14Z herbelin $ i*) +(*i $Id: Alembert.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -22,705 +22,712 @@ Open Local Scope R_scope. (***************************************************) Lemma Alembert_C1 : - forall An:nat -> R, - (forall n:nat, 0 < An n) -> - Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 -> - sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l). -intros An H H0. -cut - (sigT (fun l:R => is_lub (EUn (fun N:nat => sum_f_R0 An N)) l) -> - sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l)). -intro X; apply X. -apply completeness. -unfold Un_cv in H0; unfold bound in |- *; cut (0 < / 2); - [ intro | apply Rinv_0_lt_compat; prove_sup0 ]. -elim (H0 (/ 2) H1); intros. -exists (sum_f_R0 An x + 2 * An (S x)). -unfold is_upper_bound in |- *; intros; unfold EUn in H3; elim H3; intros. -rewrite H4; assert (H5 := lt_eq_lt_dec x1 x). -elim H5; intros. -elim a; intro. -replace (sum_f_R0 An x) with - (sum_f_R0 An x1 + sum_f_R0 (fun i:nat => An (S x1 + i)%nat) (x - S x1)). -pattern (sum_f_R0 An x1) at 1 in |- *; rewrite <- Rplus_0_r; - rewrite Rplus_assoc; apply Rplus_le_compat_l. -left; apply Rplus_lt_0_compat. -apply tech1; intros; apply H. -apply Rmult_lt_0_compat; [ prove_sup0 | apply H ]. -symmetry in |- *; apply tech2; assumption. -rewrite b; pattern (sum_f_R0 An x) at 1 in |- *; rewrite <- Rplus_0_r; - apply Rplus_le_compat_l. -left; apply Rmult_lt_0_compat; [ prove_sup0 | apply H ]. -replace (sum_f_R0 An x1) with - (sum_f_R0 An x + sum_f_R0 (fun i:nat => An (S x + i)%nat) (x1 - S x)). -apply Rplus_le_compat_l. -cut - (sum_f_R0 (fun i:nat => An (S x + i)%nat) (x1 - S x) <= - An (S x) * sum_f_R0 (fun i:nat => (/ 2) ^ i) (x1 - S x)). -intro; - apply Rle_trans with - (An (S x) * sum_f_R0 (fun i:nat => (/ 2) ^ i) (x1 - S x)). -assumption. -rewrite <- (Rmult_comm (An (S x))); apply Rmult_le_compat_l. -left; apply H. -rewrite tech3. -replace (1 - / 2) with (/ 2). -unfold Rdiv in |- *; rewrite Rinv_involutive. -pattern 2 at 3 in |- *; rewrite <- Rmult_1_r; rewrite <- (Rmult_comm 2); - apply Rmult_le_compat_l. -left; prove_sup0. -left; apply Rplus_lt_reg_r with ((/ 2) ^ S (x1 - S x)). -replace ((/ 2) ^ S (x1 - S x) + (1 - (/ 2) ^ S (x1 - S x))) with 1; - [ idtac | ring ]. -rewrite <- (Rplus_comm 1); pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; - apply Rplus_lt_compat_l. -apply pow_lt; apply Rinv_0_lt_compat; prove_sup0. -discrR. -apply Rmult_eq_reg_l with 2. -rewrite Rmult_minus_distr_l; rewrite <- Rinv_r_sym. -ring. -discrR. -discrR. -pattern 1 at 3 in |- *; replace 1 with (/ 1); - [ apply tech7; discrR | apply Rinv_1 ]. -replace (An (S x)) with (An (S x + 0)%nat). -apply (tech6 (fun i:nat => An (S x + i)%nat) (/ 2)). -left; apply Rinv_0_lt_compat; prove_sup0. -intro; cut (forall n:nat, (n >= x)%nat -> An (S n) < / 2 * An n). -intro; replace (S x + S i)%nat with (S (S x + i)). -apply H6; unfold ge in |- *; apply tech8. -apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; do 2 rewrite S_INR; ring. -intros; unfold R_dist in H2; apply Rmult_lt_reg_l with (/ An n). -apply Rinv_0_lt_compat; apply H. -do 2 rewrite (Rmult_comm (/ An n)); rewrite Rmult_assoc; - rewrite <- Rinv_r_sym. -rewrite Rmult_1_r; - replace (An (S n) * / An n) with (Rabs (Rabs (An (S n) / An n) - 0)). -apply H2; assumption. -unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; - rewrite Rabs_Rabsolu; rewrite Rabs_right. -unfold Rdiv in |- *; reflexivity. -left; unfold Rdiv in |- *; change (0 < An (S n) * / An n) in |- *; - apply Rmult_lt_0_compat; [ apply H | apply Rinv_0_lt_compat; apply H ]. -red in |- *; intro; assert (H8 := H n); rewrite H7 in H8; - elim (Rlt_irrefl _ H8). -replace (S x + 0)%nat with (S x); [ reflexivity | ring ]. -symmetry in |- *; apply tech2; assumption. -exists (sum_f_R0 An 0); unfold EUn in |- *; exists 0%nat; reflexivity. -intro X; elim X; intros. -apply existT with x; apply tech10; - [ unfold Un_growing in |- *; intro; rewrite tech5; - pattern (sum_f_R0 An n) at 1 in |- *; rewrite <- Rplus_0_r; - apply Rplus_le_compat_l; left; apply H - | apply p ]. + forall An:nat -> R, + (forall n:nat, 0 < An n) -> + Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l). +Proof. + intros An H H0. + cut + (sigT (fun l:R => is_lub (EUn (fun N:nat => sum_f_R0 An N)) l) -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l)). + intro X; apply X. + apply completeness. + unfold Un_cv in H0; unfold bound in |- *; cut (0 < / 2); + [ intro | apply Rinv_0_lt_compat; prove_sup0 ]. + elim (H0 (/ 2) H1); intros. + exists (sum_f_R0 An x + 2 * An (S x)). + unfold is_upper_bound in |- *; intros; unfold EUn in H3; elim H3; intros. + rewrite H4; assert (H5 := lt_eq_lt_dec x1 x). + elim H5; intros. + elim a; intro. + replace (sum_f_R0 An x) with + (sum_f_R0 An x1 + sum_f_R0 (fun i:nat => An (S x1 + i)%nat) (x - S x1)). + pattern (sum_f_R0 An x1) at 1 in |- *; rewrite <- Rplus_0_r; + rewrite Rplus_assoc; apply Rplus_le_compat_l. + left; apply Rplus_lt_0_compat. + apply tech1; intros; apply H. + apply Rmult_lt_0_compat; [ prove_sup0 | apply H ]. + symmetry in |- *; apply tech2; assumption. + rewrite b; pattern (sum_f_R0 An x) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l. + left; apply Rmult_lt_0_compat; [ prove_sup0 | apply H ]. + replace (sum_f_R0 An x1) with + (sum_f_R0 An x + sum_f_R0 (fun i:nat => An (S x + i)%nat) (x1 - S x)). + apply Rplus_le_compat_l. + cut + (sum_f_R0 (fun i:nat => An (S x + i)%nat) (x1 - S x) <= + An (S x) * sum_f_R0 (fun i:nat => (/ 2) ^ i) (x1 - S x)). + intro; + apply Rle_trans with + (An (S x) * sum_f_R0 (fun i:nat => (/ 2) ^ i) (x1 - S x)). + assumption. + rewrite <- (Rmult_comm (An (S x))); apply Rmult_le_compat_l. + left; apply H. + rewrite tech3. + replace (1 - / 2) with (/ 2). + unfold Rdiv in |- *; rewrite Rinv_involutive. + pattern 2 at 3 in |- *; rewrite <- Rmult_1_r; rewrite <- (Rmult_comm 2); + apply Rmult_le_compat_l. + left; prove_sup0. + left; apply Rplus_lt_reg_r with ((/ 2) ^ S (x1 - S x)). + replace ((/ 2) ^ S (x1 - S x) + (1 - (/ 2) ^ S (x1 - S x))) with 1; + [ idtac | ring ]. + rewrite <- (Rplus_comm 1); pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_lt_compat_l. + apply pow_lt; apply Rinv_0_lt_compat; prove_sup0. + discrR. + apply Rmult_eq_reg_l with 2. + rewrite Rmult_minus_distr_l; rewrite <- Rinv_r_sym. + ring. + discrR. + discrR. + pattern 1 at 3 in |- *; replace 1 with (/ 1); + [ apply tech7; discrR | apply Rinv_1 ]. + replace (An (S x)) with (An (S x + 0)%nat). + apply (tech6 (fun i:nat => An (S x + i)%nat) (/ 2)). + left; apply Rinv_0_lt_compat; prove_sup0. + intro; cut (forall n:nat, (n >= x)%nat -> An (S n) < / 2 * An n). + intro; replace (S x + S i)%nat with (S (S x + i)). + apply H6; unfold ge in |- *; apply tech8. + apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; do 2 rewrite S_INR; ring. + intros; unfold R_dist in H2; apply Rmult_lt_reg_l with (/ An n). + apply Rinv_0_lt_compat; apply H. + do 2 rewrite (Rmult_comm (/ An n)); rewrite Rmult_assoc; + rewrite <- Rinv_r_sym. + rewrite Rmult_1_r; + replace (An (S n) * / An n) with (Rabs (Rabs (An (S n) / An n) - 0)). + apply H2; assumption. + unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; + rewrite Rabs_Rabsolu; rewrite Rabs_right. + unfold Rdiv in |- *; reflexivity. + left; unfold Rdiv in |- *; change (0 < An (S n) * / An n) in |- *; + apply Rmult_lt_0_compat; [ apply H | apply Rinv_0_lt_compat; apply H ]. + red in |- *; intro; assert (H8 := H n); rewrite H7 in H8; + elim (Rlt_irrefl _ H8). + replace (S x + 0)%nat with (S x); [ reflexivity | ring ]. + symmetry in |- *; apply tech2; assumption. + exists (sum_f_R0 An 0); unfold EUn in |- *; exists 0%nat; reflexivity. + intro X; elim X; intros. + apply existT with x; apply tech10; + [ unfold Un_growing in |- *; intro; rewrite tech5; + pattern (sum_f_R0 An n) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l; left; apply H + | apply p ]. Qed. Lemma Alembert_C2 : - forall An:nat -> R, - (forall n:nat, An n <> 0) -> - Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 -> - sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l). -intros. -set (Vn := fun i:nat => (2 * Rabs (An i) + An i) / 2). -set (Wn := fun i:nat => (2 * Rabs (An i) - An i) / 2). -cut (forall n:nat, 0 < Vn n). -intro; cut (forall n:nat, 0 < Wn n). -intro; cut (Un_cv (fun n:nat => Rabs (Vn (S n) / Vn n)) 0). -intro; cut (Un_cv (fun n:nat => Rabs (Wn (S n) / Wn n)) 0). -intro; assert (H5 := Alembert_C1 Vn H1 H3). -assert (H6 := Alembert_C1 Wn H2 H4). -elim H5; intros. -elim H6; intros. -apply existT with (x - x0); unfold Un_cv in |- *; unfold Un_cv in p; - unfold Un_cv in p0; intros; cut (0 < eps / 2). -intro; elim (p (eps / 2) H8); clear p; intros. -elim (p0 (eps / 2) H8); clear p0; intros. -set (N := max x1 x2). -exists N; intros; - replace (sum_f_R0 An n) with (sum_f_R0 Vn n - sum_f_R0 Wn n). -unfold R_dist in |- *; - replace (sum_f_R0 Vn n - sum_f_R0 Wn n - (x - x0)) with - (sum_f_R0 Vn n - x + - (sum_f_R0 Wn n - x0)); [ idtac | ring ]; - apply Rle_lt_trans with - (Rabs (sum_f_R0 Vn n - x) + Rabs (- (sum_f_R0 Wn n - x0))). -apply Rabs_triang. -rewrite Rabs_Ropp; apply Rlt_le_trans with (eps / 2 + eps / 2). -apply Rplus_lt_compat. -unfold R_dist in H9; apply H9; unfold ge in |- *; apply le_trans with N; - [ unfold N in |- *; apply le_max_l | assumption ]. -unfold R_dist in H10; apply H10; unfold ge in |- *; apply le_trans with N; - [ unfold N in |- *; apply le_max_r | assumption ]. -right; symmetry in |- *; apply double_var. -symmetry in |- *; apply tech11; intro; unfold Vn, Wn in |- *; - unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ 2)); - apply Rmult_eq_reg_l with 2. -rewrite Rmult_minus_distr_l; repeat rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym. -ring. -discrR. -discrR. -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. -cut (forall n:nat, / 2 * Rabs (An n) <= Wn n <= 3 * / 2 * Rabs (An n)). -intro; cut (forall n:nat, / Wn n <= 2 * / Rabs (An n)). -intro; cut (forall n:nat, Wn (S n) / Wn n <= 3 * Rabs (An (S n) / An n)). -intro; unfold Un_cv in |- *; intros; unfold Un_cv in H0; cut (0 < eps / 3). -intro; elim (H0 (eps / 3) H8); intros. -exists x; intros. -assert (H11 := H9 n H10). -unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; - rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold R_dist in H11; - unfold Rminus in H11; rewrite Ropp_0 in H11; rewrite Rplus_0_r in H11; - rewrite Rabs_Rabsolu in H11; rewrite Rabs_right. -apply Rle_lt_trans with (3 * Rabs (An (S n) / An n)). -apply H6. -apply Rmult_lt_reg_l with (/ 3). -apply Rinv_0_lt_compat; prove_sup0. -rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]; - rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H11; - exact H11. -left; change (0 < Wn (S n) / Wn n) in |- *; unfold Rdiv in |- *; - apply Rmult_lt_0_compat. -apply H2. -apply Rinv_0_lt_compat; apply H2. -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. -intro; unfold Rdiv in |- *; rewrite Rabs_mult; rewrite <- Rmult_assoc; - replace 3 with (2 * (3 * / 2)); - [ idtac | rewrite <- Rmult_assoc; apply Rinv_r_simpl_m; discrR ]; - apply Rle_trans with (Wn (S n) * 2 * / Rabs (An n)). -rewrite Rmult_assoc; apply Rmult_le_compat_l. -left; apply H2. -apply H5. -rewrite Rabs_Rinv. -replace (Wn (S n) * 2 * / Rabs (An n)) with (2 * / Rabs (An n) * Wn (S n)); - [ idtac | ring ]; - replace (2 * (3 * / 2) * Rabs (An (S n)) * / Rabs (An n)) with - (2 * / Rabs (An n) * (3 * / 2 * Rabs (An (S n)))); - [ idtac | ring ]; apply Rmult_le_compat_l. -left; apply Rmult_lt_0_compat. -prove_sup0. -apply Rinv_0_lt_compat; apply Rabs_pos_lt; apply H. -elim (H4 (S n)); intros; assumption. -apply H. -intro; apply Rmult_le_reg_l with (Wn n). -apply H2. -rewrite <- Rinv_r_sym. -apply Rmult_le_reg_l with (Rabs (An n)). -apply Rabs_pos_lt; apply H. -rewrite Rmult_1_r; - replace (Rabs (An n) * (Wn n * (2 * / Rabs (An n)))) with - (2 * Wn n * (Rabs (An n) * / Rabs (An n))); [ idtac | ring ]; - rewrite <- Rinv_r_sym. -rewrite Rmult_1_r; apply Rmult_le_reg_l with (/ 2). -apply Rinv_0_lt_compat; prove_sup0. -rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_l; elim (H4 n); intros; assumption. -discrR. -apply Rabs_no_R0; apply H. -red in |- *; intro; assert (H6 := H2 n); rewrite H5 in H6; - elim (Rlt_irrefl _ H6). -intro; split. -unfold Wn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); - apply Rmult_le_compat_l. -left; apply Rinv_0_lt_compat; prove_sup0. -pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r; rewrite double; - unfold Rminus in |- *; rewrite Rplus_assoc; apply Rplus_le_compat_l. -apply Rplus_le_reg_l with (An n). -rewrite Rplus_0_r; rewrite (Rplus_comm (An n)); rewrite Rplus_assoc; - rewrite Rplus_opp_l; rewrite Rplus_0_r; apply RRle_abs. -unfold Wn in |- *; unfold Rdiv in |- *; repeat rewrite <- (Rmult_comm (/ 2)); - repeat rewrite Rmult_assoc; apply Rmult_le_compat_l. -left; apply Rinv_0_lt_compat; prove_sup0. -unfold Rminus in |- *; rewrite double; - replace (3 * Rabs (An n)) with (Rabs (An n) + Rabs (An n) + Rabs (An n)); - [ idtac | ring ]; repeat rewrite Rplus_assoc; repeat apply Rplus_le_compat_l. -rewrite <- Rabs_Ropp; apply RRle_abs. -cut (forall n:nat, / 2 * Rabs (An n) <= Vn n <= 3 * / 2 * Rabs (An n)). -intro; cut (forall n:nat, / Vn n <= 2 * / Rabs (An n)). -intro; cut (forall n:nat, Vn (S n) / Vn n <= 3 * Rabs (An (S n) / An n)). -intro; unfold Un_cv in |- *; intros; unfold Un_cv in H1; cut (0 < eps / 3). -intro; elim (H0 (eps / 3) H7); intros. -exists x; intros. -assert (H10 := H8 n H9). -unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; - rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold R_dist in H10; - unfold Rminus in H10; rewrite Ropp_0 in H10; rewrite Rplus_0_r in H10; - rewrite Rabs_Rabsolu in H10; rewrite Rabs_right. -apply Rle_lt_trans with (3 * Rabs (An (S n) / An n)). -apply H5. -apply Rmult_lt_reg_l with (/ 3). -apply Rinv_0_lt_compat; prove_sup0. -rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]; - rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H10; - exact H10. -left; change (0 < Vn (S n) / Vn n) in |- *; unfold Rdiv in |- *; - apply Rmult_lt_0_compat. -apply H1. -apply Rinv_0_lt_compat; apply H1. -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. -intro; unfold Rdiv in |- *; rewrite Rabs_mult; rewrite <- Rmult_assoc; - replace 3 with (2 * (3 * / 2)); - [ idtac | rewrite <- Rmult_assoc; apply Rinv_r_simpl_m; discrR ]; - apply Rle_trans with (Vn (S n) * 2 * / Rabs (An n)). -rewrite Rmult_assoc; apply Rmult_le_compat_l. -left; apply H1. -apply H4. -rewrite Rabs_Rinv. -replace (Vn (S n) * 2 * / Rabs (An n)) with (2 * / Rabs (An n) * Vn (S n)); - [ idtac | ring ]; - replace (2 * (3 * / 2) * Rabs (An (S n)) * / Rabs (An n)) with - (2 * / Rabs (An n) * (3 * / 2 * Rabs (An (S n)))); - [ idtac | ring ]; apply Rmult_le_compat_l. -left; apply Rmult_lt_0_compat. -prove_sup0. -apply Rinv_0_lt_compat; apply Rabs_pos_lt; apply H. -elim (H3 (S n)); intros; assumption. -apply H. -intro; apply Rmult_le_reg_l with (Vn n). -apply H1. -rewrite <- Rinv_r_sym. -apply Rmult_le_reg_l with (Rabs (An n)). -apply Rabs_pos_lt; apply H. -rewrite Rmult_1_r; - replace (Rabs (An n) * (Vn n * (2 * / Rabs (An n)))) with - (2 * Vn n * (Rabs (An n) * / Rabs (An n))); [ idtac | ring ]; - rewrite <- Rinv_r_sym. -rewrite Rmult_1_r; apply Rmult_le_reg_l with (/ 2). -apply Rinv_0_lt_compat; prove_sup0. -rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_l; elim (H3 n); intros; assumption. -discrR. -apply Rabs_no_R0; apply H. -red in |- *; intro; assert (H5 := H1 n); rewrite H4 in H5; - elim (Rlt_irrefl _ H5). -intro; split. -unfold Vn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); - apply Rmult_le_compat_l. -left; apply Rinv_0_lt_compat; prove_sup0. -pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r; rewrite double; - rewrite Rplus_assoc; apply Rplus_le_compat_l. -apply Rplus_le_reg_l with (- An n); rewrite Rplus_0_r; - rewrite <- (Rplus_comm (An n)); rewrite <- Rplus_assoc; - rewrite Rplus_opp_l; rewrite Rplus_0_l; rewrite <- Rabs_Ropp; - apply RRle_abs. -unfold Vn in |- *; unfold Rdiv in |- *; repeat rewrite <- (Rmult_comm (/ 2)); - repeat rewrite Rmult_assoc; apply Rmult_le_compat_l. -left; apply Rinv_0_lt_compat; prove_sup0. -unfold Rminus in |- *; rewrite double; - replace (3 * Rabs (An n)) with (Rabs (An n) + Rabs (An n) + Rabs (An n)); - [ idtac | ring ]; repeat rewrite Rplus_assoc; repeat apply Rplus_le_compat_l; - apply RRle_abs. -intro; unfold Wn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_0_r (/ 2)); - rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l. -apply Rinv_0_lt_compat; prove_sup0. -apply Rplus_lt_reg_r with (An n); rewrite Rplus_0_r; unfold Rminus in |- *; - rewrite (Rplus_comm (An n)); rewrite Rplus_assoc; - rewrite Rplus_opp_l; rewrite Rplus_0_r; - apply Rle_lt_trans with (Rabs (An n)). -apply RRle_abs. -rewrite double; pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r; - apply Rplus_lt_compat_l; apply Rabs_pos_lt; apply H. -intro; unfold Vn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_0_r (/ 2)); - rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l. -apply Rinv_0_lt_compat; prove_sup0. -apply Rplus_lt_reg_r with (- An n); rewrite Rplus_0_r; unfold Rminus in |- *; - rewrite (Rplus_comm (- An n)); rewrite Rplus_assoc; - rewrite Rplus_opp_r; rewrite Rplus_0_r; - apply Rle_lt_trans with (Rabs (An n)). -rewrite <- Rabs_Ropp; apply RRle_abs. -rewrite double; pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r; - apply Rplus_lt_compat_l; apply Rabs_pos_lt; apply H. + forall An:nat -> R, + (forall n:nat, An n <> 0) -> + Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l). +Proof. + intros. + set (Vn := fun i:nat => (2 * Rabs (An i) + An i) / 2). + set (Wn := fun i:nat => (2 * Rabs (An i) - An i) / 2). + cut (forall n:nat, 0 < Vn n). + intro; cut (forall n:nat, 0 < Wn n). + intro; cut (Un_cv (fun n:nat => Rabs (Vn (S n) / Vn n)) 0). + intro; cut (Un_cv (fun n:nat => Rabs (Wn (S n) / Wn n)) 0). + intro; assert (H5 := Alembert_C1 Vn H1 H3). + assert (H6 := Alembert_C1 Wn H2 H4). + elim H5; intros. + elim H6; intros. + apply existT with (x - x0); unfold Un_cv in |- *; unfold Un_cv in p; + unfold Un_cv in p0; intros; cut (0 < eps / 2). + intro; elim (p (eps / 2) H8); clear p; intros. + elim (p0 (eps / 2) H8); clear p0; intros. + set (N := max x1 x2). + exists N; intros; + replace (sum_f_R0 An n) with (sum_f_R0 Vn n - sum_f_R0 Wn n). + unfold R_dist in |- *; + replace (sum_f_R0 Vn n - sum_f_R0 Wn n - (x - x0)) with + (sum_f_R0 Vn n - x + - (sum_f_R0 Wn n - x0)); [ idtac | ring ]; + apply Rle_lt_trans with + (Rabs (sum_f_R0 Vn n - x) + Rabs (- (sum_f_R0 Wn n - x0))). + apply Rabs_triang. + rewrite Rabs_Ropp; apply Rlt_le_trans with (eps / 2 + eps / 2). + apply Rplus_lt_compat. + unfold R_dist in H9; apply H9; unfold ge in |- *; apply le_trans with N; + [ unfold N in |- *; apply le_max_l | assumption ]. + unfold R_dist in H10; apply H10; unfold ge in |- *; apply le_trans with N; + [ unfold N in |- *; apply le_max_r | assumption ]. + right; symmetry in |- *; apply double_var. + symmetry in |- *; apply tech11; intro; unfold Vn, Wn in |- *; + unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ 2)); + apply Rmult_eq_reg_l with 2. + rewrite Rmult_minus_distr_l; repeat rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. + ring. + discrR. + discrR. + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. + cut (forall n:nat, / 2 * Rabs (An n) <= Wn n <= 3 * / 2 * Rabs (An n)). + intro; cut (forall n:nat, / Wn n <= 2 * / Rabs (An n)). + intro; cut (forall n:nat, Wn (S n) / Wn n <= 3 * Rabs (An (S n) / An n)). + intro; unfold Un_cv in |- *; intros; unfold Un_cv in H0; cut (0 < eps / 3). + intro; elim (H0 (eps / 3) H8); intros. + exists x; intros. + assert (H11 := H9 n H10). + unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold R_dist in H11; + unfold Rminus in H11; rewrite Ropp_0 in H11; rewrite Rplus_0_r in H11; + rewrite Rabs_Rabsolu in H11; rewrite Rabs_right. + apply Rle_lt_trans with (3 * Rabs (An (S n) / An n)). + apply H6. + apply Rmult_lt_reg_l with (/ 3). + apply Rinv_0_lt_compat; prove_sup0. + rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]; + rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H11; + exact H11. + left; change (0 < Wn (S n) / Wn n) in |- *; unfold Rdiv in |- *; + apply Rmult_lt_0_compat. + apply H2. + apply Rinv_0_lt_compat; apply H2. + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. + intro; unfold Rdiv in |- *; rewrite Rabs_mult; rewrite <- Rmult_assoc; + replace 3 with (2 * (3 * / 2)); + [ idtac | rewrite <- Rmult_assoc; apply Rinv_r_simpl_m; discrR ]; + apply Rle_trans with (Wn (S n) * 2 * / Rabs (An n)). + rewrite Rmult_assoc; apply Rmult_le_compat_l. + left; apply H2. + apply H5. + rewrite Rabs_Rinv. + replace (Wn (S n) * 2 * / Rabs (An n)) with (2 * / Rabs (An n) * Wn (S n)); + [ idtac | ring ]; + replace (2 * (3 * / 2) * Rabs (An (S n)) * / Rabs (An n)) with + (2 * / Rabs (An n) * (3 * / 2 * Rabs (An (S n)))); + [ idtac | ring ]; apply Rmult_le_compat_l. + left; apply Rmult_lt_0_compat. + prove_sup0. + apply Rinv_0_lt_compat; apply Rabs_pos_lt; apply H. + elim (H4 (S n)); intros; assumption. + apply H. + intro; apply Rmult_le_reg_l with (Wn n). + apply H2. + rewrite <- Rinv_r_sym. + apply Rmult_le_reg_l with (Rabs (An n)). + apply Rabs_pos_lt; apply H. + rewrite Rmult_1_r; + replace (Rabs (An n) * (Wn n * (2 * / Rabs (An n)))) with + (2 * Wn n * (Rabs (An n) * / Rabs (An n))); [ idtac | ring ]; + rewrite <- Rinv_r_sym. + rewrite Rmult_1_r; apply Rmult_le_reg_l with (/ 2). + apply Rinv_0_lt_compat; prove_sup0. + rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_l; elim (H4 n); intros; assumption. + discrR. + apply Rabs_no_R0; apply H. + red in |- *; intro; assert (H6 := H2 n); rewrite H5 in H6; + elim (Rlt_irrefl _ H6). + intro; split. + unfold Wn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); + apply Rmult_le_compat_l. + left; apply Rinv_0_lt_compat; prove_sup0. + pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r; rewrite double; + unfold Rminus in |- *; rewrite Rplus_assoc; apply Rplus_le_compat_l. + apply Rplus_le_reg_l with (An n). + rewrite Rplus_0_r; rewrite (Rplus_comm (An n)); rewrite Rplus_assoc; + rewrite Rplus_opp_l; rewrite Rplus_0_r; apply RRle_abs. + unfold Wn in |- *; unfold Rdiv in |- *; repeat rewrite <- (Rmult_comm (/ 2)); + repeat rewrite Rmult_assoc; apply Rmult_le_compat_l. + left; apply Rinv_0_lt_compat; prove_sup0. + unfold Rminus in |- *; rewrite double; + replace (3 * Rabs (An n)) with (Rabs (An n) + Rabs (An n) + Rabs (An n)); + [ idtac | ring ]; repeat rewrite Rplus_assoc; repeat apply Rplus_le_compat_l. + rewrite <- Rabs_Ropp; apply RRle_abs. + cut (forall n:nat, / 2 * Rabs (An n) <= Vn n <= 3 * / 2 * Rabs (An n)). + intro; cut (forall n:nat, / Vn n <= 2 * / Rabs (An n)). + intro; cut (forall n:nat, Vn (S n) / Vn n <= 3 * Rabs (An (S n) / An n)). + intro; unfold Un_cv in |- *; intros; unfold Un_cv in H1; cut (0 < eps / 3). + intro; elim (H0 (eps / 3) H7); intros. + exists x; intros. + assert (H10 := H8 n H9). + unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold R_dist in H10; + unfold Rminus in H10; rewrite Ropp_0 in H10; rewrite Rplus_0_r in H10; + rewrite Rabs_Rabsolu in H10; rewrite Rabs_right. + apply Rle_lt_trans with (3 * Rabs (An (S n) / An n)). + apply H5. + apply Rmult_lt_reg_l with (/ 3). + apply Rinv_0_lt_compat; prove_sup0. + rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]; + rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H10; + exact H10. + left; change (0 < Vn (S n) / Vn n) in |- *; unfold Rdiv in |- *; + apply Rmult_lt_0_compat. + apply H1. + apply Rinv_0_lt_compat; apply H1. + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. + intro; unfold Rdiv in |- *; rewrite Rabs_mult; rewrite <- Rmult_assoc; + replace 3 with (2 * (3 * / 2)); + [ idtac | rewrite <- Rmult_assoc; apply Rinv_r_simpl_m; discrR ]; + apply Rle_trans with (Vn (S n) * 2 * / Rabs (An n)). + rewrite Rmult_assoc; apply Rmult_le_compat_l. + left; apply H1. + apply H4. + rewrite Rabs_Rinv. + replace (Vn (S n) * 2 * / Rabs (An n)) with (2 * / Rabs (An n) * Vn (S n)); + [ idtac | ring ]; + replace (2 * (3 * / 2) * Rabs (An (S n)) * / Rabs (An n)) with + (2 * / Rabs (An n) * (3 * / 2 * Rabs (An (S n)))); + [ idtac | ring ]; apply Rmult_le_compat_l. + left; apply Rmult_lt_0_compat. + prove_sup0. + apply Rinv_0_lt_compat; apply Rabs_pos_lt; apply H. + elim (H3 (S n)); intros; assumption. + apply H. + intro; apply Rmult_le_reg_l with (Vn n). + apply H1. + rewrite <- Rinv_r_sym. + apply Rmult_le_reg_l with (Rabs (An n)). + apply Rabs_pos_lt; apply H. + rewrite Rmult_1_r; + replace (Rabs (An n) * (Vn n * (2 * / Rabs (An n)))) with + (2 * Vn n * (Rabs (An n) * / Rabs (An n))); [ idtac | ring ]; + rewrite <- Rinv_r_sym. + rewrite Rmult_1_r; apply Rmult_le_reg_l with (/ 2). + apply Rinv_0_lt_compat; prove_sup0. + rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_l; elim (H3 n); intros; assumption. + discrR. + apply Rabs_no_R0; apply H. + red in |- *; intro; assert (H5 := H1 n); rewrite H4 in H5; + elim (Rlt_irrefl _ H5). + intro; split. + unfold Vn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); + apply Rmult_le_compat_l. + left; apply Rinv_0_lt_compat; prove_sup0. + pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r; rewrite double; + rewrite Rplus_assoc; apply Rplus_le_compat_l. + apply Rplus_le_reg_l with (- An n); rewrite Rplus_0_r; + rewrite <- (Rplus_comm (An n)); rewrite <- Rplus_assoc; + rewrite Rplus_opp_l; rewrite Rplus_0_l; rewrite <- Rabs_Ropp; + apply RRle_abs. + unfold Vn in |- *; unfold Rdiv in |- *; repeat rewrite <- (Rmult_comm (/ 2)); + repeat rewrite Rmult_assoc; apply Rmult_le_compat_l. + left; apply Rinv_0_lt_compat; prove_sup0. + unfold Rminus in |- *; rewrite double; + replace (3 * Rabs (An n)) with (Rabs (An n) + Rabs (An n) + Rabs (An n)); + [ idtac | ring ]; repeat rewrite Rplus_assoc; repeat apply Rplus_le_compat_l; + apply RRle_abs. + intro; unfold Wn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_0_r (/ 2)); + rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l. + apply Rinv_0_lt_compat; prove_sup0. + apply Rplus_lt_reg_r with (An n); rewrite Rplus_0_r; unfold Rminus in |- *; + rewrite (Rplus_comm (An n)); rewrite Rplus_assoc; + rewrite Rplus_opp_l; rewrite Rplus_0_r; + apply Rle_lt_trans with (Rabs (An n)). + apply RRle_abs. + rewrite double; pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_lt_compat_l; apply Rabs_pos_lt; apply H. + intro; unfold Vn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_0_r (/ 2)); + rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l. + apply Rinv_0_lt_compat; prove_sup0. + apply Rplus_lt_reg_r with (- An n); rewrite Rplus_0_r; unfold Rminus in |- *; + rewrite (Rplus_comm (- An n)); rewrite Rplus_assoc; + rewrite Rplus_opp_r; rewrite Rplus_0_r; + apply Rle_lt_trans with (Rabs (An n)). + rewrite <- Rabs_Ropp; apply RRle_abs. + rewrite double; pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_lt_compat_l; apply Rabs_pos_lt; apply H. Qed. Lemma AlembertC3_step1 : - forall (An:nat -> R) (x:R), - x <> 0 -> - (forall n:nat, An n <> 0) -> - Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 -> - sigT (fun l:R => Pser An x l). -intros; set (Bn := fun i:nat => An i * x ^ i). -cut (forall n:nat, Bn n <> 0). -intro; cut (Un_cv (fun n:nat => Rabs (Bn (S n) / Bn n)) 0). -intro; assert (H4 := Alembert_C2 Bn H2 H3). -elim H4; intros. -apply existT with x0; unfold Bn in p; apply tech12; assumption. -unfold Un_cv in |- *; intros; unfold Un_cv in H1; cut (0 < eps / Rabs x). -intro; elim (H1 (eps / Rabs x) H4); intros. -exists x0; intros; unfold R_dist in |- *; unfold Rminus in |- *; - rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; - unfold Bn in |- *; - replace (An (S n) * x ^ S n / (An n * x ^ n)) with (An (S n) / An n * x). -rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs x). -apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. -rewrite <- (Rmult_comm (Rabs x)); rewrite <- Rmult_assoc; - rewrite <- Rinv_l_sym. -rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H5; - replace (Rabs (An (S n) / An n)) with (R_dist (Rabs (An (S n) * / An n)) 0). -apply H5; assumption. -unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; - rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold Rdiv in |- *; - reflexivity. -apply Rabs_no_R0; assumption. -replace (S n) with (n + 1)%nat; [ idtac | ring ]; rewrite pow_add; - unfold Rdiv in |- *; rewrite Rinv_mult_distr. -replace (An (n + 1)%nat * (x ^ n * x ^ 1) * (/ An n * / x ^ n)) with - (An (n + 1)%nat * x ^ 1 * / An n * (x ^ n * / x ^ n)); - [ idtac | ring ]; rewrite <- Rinv_r_sym. -simpl in |- *; ring. -apply pow_nonzero; assumption. -apply H0. -apply pow_nonzero; assumption. -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption ]. -intro; unfold Bn in |- *; apply prod_neq_R0; - [ apply H0 | apply pow_nonzero; assumption ]. + forall (An:nat -> R) (x:R), + x <> 0 -> + (forall n:nat, An n <> 0) -> + Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 -> + sigT (fun l:R => Pser An x l). +Proof. + intros; set (Bn := fun i:nat => An i * x ^ i). + cut (forall n:nat, Bn n <> 0). + intro; cut (Un_cv (fun n:nat => Rabs (Bn (S n) / Bn n)) 0). + intro; assert (H4 := Alembert_C2 Bn H2 H3). + elim H4; intros. + apply existT with x0; unfold Bn in p; apply tech12; assumption. + unfold Un_cv in |- *; intros; unfold Un_cv in H1; cut (0 < eps / Rabs x). + intro; elim (H1 (eps / Rabs x) H4); intros. + exists x0; intros; unfold R_dist in |- *; unfold Rminus in |- *; + rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; + unfold Bn in |- *; + replace (An (S n) * x ^ S n / (An n * x ^ n)) with (An (S n) / An n * x). + rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs x). + apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. + rewrite <- (Rmult_comm (Rabs x)); rewrite <- Rmult_assoc; + rewrite <- Rinv_l_sym. + rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H5; + replace (Rabs (An (S n) / An n)) with (R_dist (Rabs (An (S n) * / An n)) 0). + apply H5; assumption. + unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold Rdiv in |- *; + reflexivity. + apply Rabs_no_R0; assumption. + replace (S n) with (n + 1)%nat; [ idtac | ring ]; rewrite pow_add; + unfold Rdiv in |- *; rewrite Rinv_mult_distr. + replace (An (n + 1)%nat * (x ^ n * x ^ 1) * (/ An n * / x ^ n)) with + (An (n + 1)%nat * x ^ 1 * / An n * (x ^ n * / x ^ n)); + [ idtac | ring ]; rewrite <- Rinv_r_sym. + simpl in |- *; ring. + apply pow_nonzero; assumption. + apply H0. + apply pow_nonzero; assumption. + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption ]. + intro; unfold Bn in |- *; apply prod_neq_R0; + [ apply H0 | apply pow_nonzero; assumption ]. Qed. Lemma AlembertC3_step2 : - forall (An:nat -> R) (x:R), x = 0 -> sigT (fun l:R => Pser An x l). -intros; apply existT with (An 0%nat). -unfold Pser in |- *; unfold infinit_sum in |- *; intros; exists 0%nat; intros; - replace (sum_f_R0 (fun n0:nat => An n0 * x ^ n0) n) with (An 0%nat). -unfold R_dist in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; - rewrite Rabs_R0; assumption. -induction n as [| n Hrecn]. -simpl in |- *; ring. -rewrite tech5; rewrite Hrecn; - [ rewrite H; simpl in |- *; ring | unfold ge in |- *; apply le_O_n ]. + forall (An:nat -> R) (x:R), x = 0 -> sigT (fun l:R => Pser An x l). +Proof. + intros; apply existT with (An 0%nat). + unfold Pser in |- *; unfold infinit_sum in |- *; intros; exists 0%nat; intros; + replace (sum_f_R0 (fun n0:nat => An n0 * x ^ n0) n) with (An 0%nat). + unfold R_dist in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; assumption. + induction n as [| n Hrecn]. + simpl in |- *; ring. + rewrite tech5; rewrite Hrecn; + [ rewrite H; simpl in |- *; ring | unfold ge in |- *; apply le_O_n ]. Qed. -(* An useful criterion of convergence for power series *) +(** An useful criterion of convergence for power series *) Theorem Alembert_C3 : - forall (An:nat -> R) (x:R), - (forall n:nat, An n <> 0) -> - Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 -> - sigT (fun l:R => Pser An x l). -intros; case (total_order_T x 0); intro. -elim s; intro. -cut (x <> 0). -intro; apply AlembertC3_step1; assumption. -red in |- *; intro; rewrite H1 in a; elim (Rlt_irrefl _ a). -apply AlembertC3_step2; assumption. -cut (x <> 0). -intro; apply AlembertC3_step1; assumption. -red in |- *; intro; rewrite H1 in r; elim (Rlt_irrefl _ r). + forall (An:nat -> R) (x:R), + (forall n:nat, An n <> 0) -> + Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 -> + sigT (fun l:R => Pser An x l). +Proof. + intros; case (total_order_T x 0); intro. + elim s; intro. + cut (x <> 0). + intro; apply AlembertC3_step1; assumption. + red in |- *; intro; rewrite H1 in a; elim (Rlt_irrefl _ a). + apply AlembertC3_step2; assumption. + cut (x <> 0). + intro; apply AlembertC3_step1; assumption. + red in |- *; intro; rewrite H1 in r; elim (Rlt_irrefl _ r). Qed. Lemma Alembert_C4 : - forall (An:nat -> R) (k:R), - 0 <= k < 1 -> - (forall n:nat, 0 < An n) -> - Un_cv (fun n:nat => Rabs (An (S n) / An n)) k -> - sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l). -intros An k Hyp H H0. -cut - (sigT (fun l:R => is_lub (EUn (fun N:nat => sum_f_R0 An N)) l) -> - sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l)). -intro X; apply X. -apply completeness. -assert (H1 := tech13 _ _ Hyp H0). -elim H1; intros. -elim H2; intros. -elim H4; intros. -unfold bound in |- *; exists (sum_f_R0 An x0 + / (1 - x) * An (S x0)). -unfold is_upper_bound in |- *; intros; unfold EUn in H6. -elim H6; intros. -rewrite H7. -assert (H8 := lt_eq_lt_dec x2 x0). -elim H8; intros. -elim a; intro. -replace (sum_f_R0 An x0) with - (sum_f_R0 An x2 + sum_f_R0 (fun i:nat => An (S x2 + i)%nat) (x0 - S x2)). -pattern (sum_f_R0 An x2) at 1 in |- *; rewrite <- Rplus_0_r. -rewrite Rplus_assoc; apply Rplus_le_compat_l. -left; apply Rplus_lt_0_compat. -apply tech1. -intros; apply H. -apply Rmult_lt_0_compat. -apply Rinv_0_lt_compat; apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; - replace (x + (1 - x)) with 1; [ elim H3; intros; assumption | ring ]. -apply H. -symmetry in |- *; apply tech2; assumption. -rewrite b; pattern (sum_f_R0 An x0) at 1 in |- *; rewrite <- Rplus_0_r; - apply Rplus_le_compat_l. -left; apply Rmult_lt_0_compat. -apply Rinv_0_lt_compat; apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; - replace (x + (1 - x)) with 1; [ elim H3; intros; assumption | ring ]. -apply H. -replace (sum_f_R0 An x2) with - (sum_f_R0 An x0 + sum_f_R0 (fun i:nat => An (S x0 + i)%nat) (x2 - S x0)). -apply Rplus_le_compat_l. -cut - (sum_f_R0 (fun i:nat => An (S x0 + i)%nat) (x2 - S x0) <= - An (S x0) * sum_f_R0 (fun i:nat => x ^ i) (x2 - S x0)). -intro; - apply Rle_trans with (An (S x0) * sum_f_R0 (fun i:nat => x ^ i) (x2 - S x0)). -assumption. -rewrite <- (Rmult_comm (An (S x0))); apply Rmult_le_compat_l. -left; apply H. -rewrite tech3. -unfold Rdiv in |- *; apply Rmult_le_reg_l with (1 - x). -apply Rplus_lt_reg_r with x; rewrite Rplus_0_r. -replace (x + (1 - x)) with 1; [ elim H3; intros; assumption | ring ]. -do 2 rewrite (Rmult_comm (1 - x)). -rewrite Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_r; apply Rplus_le_reg_l with (x ^ S (x2 - S x0)). -replace (x ^ S (x2 - S x0) + (1 - x ^ S (x2 - S x0))) with 1; - [ idtac | ring ]. -rewrite <- (Rplus_comm 1); pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; - apply Rplus_le_compat_l. -left; apply pow_lt. -apply Rle_lt_trans with k. -elim Hyp; intros; assumption. -elim H3; intros; assumption. -apply Rminus_eq_contra. -red in |- *; intro. -elim H3; intros. -rewrite H10 in H12; elim (Rlt_irrefl _ H12). -red in |- *; intro. -elim H3; intros. -rewrite H10 in H12; elim (Rlt_irrefl _ H12). -replace (An (S x0)) with (An (S x0 + 0)%nat). -apply (tech6 (fun i:nat => An (S x0 + i)%nat) x). -left; apply Rle_lt_trans with k. -elim Hyp; intros; assumption. -elim H3; intros; assumption. -intro. -cut (forall n:nat, (n >= x0)%nat -> An (S n) < x * An n). -intro. -replace (S x0 + S i)%nat with (S (S x0 + i)). -apply H9. -unfold ge in |- *. -apply tech8. + forall (An:nat -> R) (k:R), + 0 <= k < 1 -> + (forall n:nat, 0 < An n) -> + Un_cv (fun n:nat => Rabs (An (S n) / An n)) k -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l). +Proof. + intros An k Hyp H H0. + cut + (sigT (fun l:R => is_lub (EUn (fun N:nat => sum_f_R0 An N)) l) -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l)). + intro X; apply X. + apply completeness. + assert (H1 := tech13 _ _ Hyp H0). + elim H1; intros. + elim H2; intros. + elim H4; intros. + unfold bound in |- *; exists (sum_f_R0 An x0 + / (1 - x) * An (S x0)). + unfold is_upper_bound in |- *; intros; unfold EUn in H6. + elim H6; intros. + rewrite H7. + assert (H8 := lt_eq_lt_dec x2 x0). + elim H8; intros. + elim a; intro. + replace (sum_f_R0 An x0) with + (sum_f_R0 An x2 + sum_f_R0 (fun i:nat => An (S x2 + i)%nat) (x0 - S x2)). + pattern (sum_f_R0 An x2) at 1 in |- *; rewrite <- Rplus_0_r. + rewrite Rplus_assoc; apply Rplus_le_compat_l. + left; apply Rplus_lt_0_compat. + apply tech1. + intros; apply H. + apply Rmult_lt_0_compat. + apply Rinv_0_lt_compat; apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; + replace (x + (1 - x)) with 1; [ elim H3; intros; assumption | ring ]. + apply H. + symmetry in |- *; apply tech2; assumption. + rewrite b; pattern (sum_f_R0 An x0) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l. + left; apply Rmult_lt_0_compat. + apply Rinv_0_lt_compat; apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; + replace (x + (1 - x)) with 1; [ elim H3; intros; assumption | ring ]. + apply H. + replace (sum_f_R0 An x2) with + (sum_f_R0 An x0 + sum_f_R0 (fun i:nat => An (S x0 + i)%nat) (x2 - S x0)). + apply Rplus_le_compat_l. + cut + (sum_f_R0 (fun i:nat => An (S x0 + i)%nat) (x2 - S x0) <= + An (S x0) * sum_f_R0 (fun i:nat => x ^ i) (x2 - S x0)). + intro; + apply Rle_trans with (An (S x0) * sum_f_R0 (fun i:nat => x ^ i) (x2 - S x0)). + assumption. + rewrite <- (Rmult_comm (An (S x0))); apply Rmult_le_compat_l. + left; apply H. + rewrite tech3. + unfold Rdiv in |- *; apply Rmult_le_reg_l with (1 - x). + apply Rplus_lt_reg_r with x; rewrite Rplus_0_r. + replace (x + (1 - x)) with 1; [ elim H3; intros; assumption | ring ]. + do 2 rewrite (Rmult_comm (1 - x)). + rewrite Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_r; apply Rplus_le_reg_l with (x ^ S (x2 - S x0)). + replace (x ^ S (x2 - S x0) + (1 - x ^ S (x2 - S x0))) with 1; + [ idtac | ring ]. + rewrite <- (Rplus_comm 1); pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l. + left; apply pow_lt. + apply Rle_lt_trans with k. + elim Hyp; intros; assumption. + elim H3; intros; assumption. + apply Rminus_eq_contra. + red in |- *; intro. + elim H3; intros. + rewrite H10 in H12; elim (Rlt_irrefl _ H12). + red in |- *; intro. + elim H3; intros. + rewrite H10 in H12; elim (Rlt_irrefl _ H12). + replace (An (S x0)) with (An (S x0 + 0)%nat). + apply (tech6 (fun i:nat => An (S x0 + i)%nat) x). + left; apply Rle_lt_trans with k. + elim Hyp; intros; assumption. + elim H3; intros; assumption. + intro. + cut (forall n:nat, (n >= x0)%nat -> An (S n) < x * An n). + intro. + replace (S x0 + S i)%nat with (S (S x0 + i)). + apply H9. + unfold ge in |- *. + apply tech8. apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; do 2 rewrite S_INR; - ring. -intros. -apply Rmult_lt_reg_l with (/ An n). -apply Rinv_0_lt_compat; apply H. -do 2 rewrite (Rmult_comm (/ An n)). -rewrite Rmult_assoc. -rewrite <- Rinv_r_sym. -rewrite Rmult_1_r. -replace (An (S n) * / An n) with (Rabs (An (S n) / An n)). -apply H5; assumption. -rewrite Rabs_right. -unfold Rdiv in |- *; reflexivity. -left; unfold Rdiv in |- *; change (0 < An (S n) * / An n) in |- *; - apply Rmult_lt_0_compat. -apply H. -apply Rinv_0_lt_compat; apply H. -red in |- *; intro. -assert (H11 := H n). -rewrite H10 in H11; elim (Rlt_irrefl _ H11). -replace (S x0 + 0)%nat with (S x0); [ reflexivity | ring ]. -symmetry in |- *; apply tech2; assumption. -exists (sum_f_R0 An 0); unfold EUn in |- *; exists 0%nat; reflexivity. -intro X; elim X; intros. -apply existT with x; apply tech10; - [ unfold Un_growing in |- *; intro; rewrite tech5; - pattern (sum_f_R0 An n) at 1 in |- *; rewrite <- Rplus_0_r; - apply Rplus_le_compat_l; left; apply H - | apply p ]. + ring. + intros. + apply Rmult_lt_reg_l with (/ An n). + apply Rinv_0_lt_compat; apply H. + do 2 rewrite (Rmult_comm (/ An n)). + rewrite Rmult_assoc. + rewrite <- Rinv_r_sym. + rewrite Rmult_1_r. + replace (An (S n) * / An n) with (Rabs (An (S n) / An n)). + apply H5; assumption. + rewrite Rabs_right. + unfold Rdiv in |- *; reflexivity. + left; unfold Rdiv in |- *; change (0 < An (S n) * / An n) in |- *; + apply Rmult_lt_0_compat. + apply H. + apply Rinv_0_lt_compat; apply H. + red in |- *; intro. + assert (H11 := H n). + rewrite H10 in H11; elim (Rlt_irrefl _ H11). + replace (S x0 + 0)%nat with (S x0); [ reflexivity | ring ]. + symmetry in |- *; apply tech2; assumption. + exists (sum_f_R0 An 0); unfold EUn in |- *; exists 0%nat; reflexivity. + intro X; elim X; intros. + apply existT with x; apply tech10; + [ unfold Un_growing in |- *; intro; rewrite tech5; + pattern (sum_f_R0 An n) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l; left; apply H + | apply p ]. Qed. Lemma Alembert_C5 : - forall (An:nat -> R) (k:R), - 0 <= k < 1 -> - (forall n:nat, An n <> 0) -> - Un_cv (fun n:nat => Rabs (An (S n) / An n)) k -> - sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l). -intros. -cut - (sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l) -> - sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l)). -intro Hyp0; apply Hyp0. -apply cv_cauchy_2. -apply cauchy_abs. -apply cv_cauchy_1. -cut - (sigT - (fun l:R => Un_cv (fun N:nat => sum_f_R0 (fun i:nat => Rabs (An i)) N) l) -> - sigT - (fun l:R => Un_cv (fun N:nat => sum_f_R0 (fun i:nat => Rabs (An i)) N) l)). -intro Hyp; apply Hyp. -apply (Alembert_C4 (fun i:nat => Rabs (An i)) k). -assumption. -intro; apply Rabs_pos_lt; apply H0. -unfold Un_cv in |- *. -unfold Un_cv in H1. -unfold Rdiv in |- *. -intros. -elim (H1 eps H2); intros. -exists x; intros. -rewrite <- Rabs_Rinv. -rewrite <- Rabs_mult. -rewrite Rabs_Rabsolu. -unfold Rdiv in H3; apply H3; assumption. -apply H0. -intro X. -elim X; intros. -apply existT with x. -assumption. -intro X. -elim X; intros. -apply existT with x. -assumption. + forall (An:nat -> R) (k:R), + 0 <= k < 1 -> + (forall n:nat, An n <> 0) -> + Un_cv (fun n:nat => Rabs (An (S n) / An n)) k -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l). +Proof. + intros. + cut + (sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l) -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l)). + intro Hyp0; apply Hyp0. + apply cv_cauchy_2. + apply cauchy_abs. + apply cv_cauchy_1. + cut + (sigT + (fun l:R => Un_cv (fun N:nat => sum_f_R0 (fun i:nat => Rabs (An i)) N) l) -> + sigT + (fun l:R => Un_cv (fun N:nat => sum_f_R0 (fun i:nat => Rabs (An i)) N) l)). + intro Hyp; apply Hyp. + apply (Alembert_C4 (fun i:nat => Rabs (An i)) k). + assumption. + intro; apply Rabs_pos_lt; apply H0. + unfold Un_cv in |- *. + unfold Un_cv in H1. + unfold Rdiv in |- *. + intros. + elim (H1 eps H2); intros. + exists x; intros. + rewrite <- Rabs_Rinv. + rewrite <- Rabs_mult. + rewrite Rabs_Rabsolu. + unfold Rdiv in H3; apply H3; assumption. + apply H0. + intro X. + elim X; intros. + apply existT with x. + assumption. + intro X. + elim X; intros. + apply existT with x. + assumption. Qed. -(* Convergence of power series in D(O,1/k) *) -(* k=0 is described in Alembert_C3 *) +(** Convergence of power series in D(O,1/k) + k=0 is described in Alembert_C3 *) Lemma Alembert_C6 : - forall (An:nat -> R) (x k:R), - 0 < k -> - (forall n:nat, An n <> 0) -> - Un_cv (fun n:nat => Rabs (An (S n) / An n)) k -> - Rabs x < / k -> sigT (fun l:R => Pser An x l). -intros. -cut - (sigT - (fun l:R => Un_cv (fun N:nat => sum_f_R0 (fun i:nat => An i * x ^ i) N) l)). -intro X. -elim X; intros. -apply existT with x0. -apply tech12; assumption. -case (total_order_T x 0); intro. -elim s; intro. -eapply Alembert_C5 with (k * Rabs x). -split. -unfold Rdiv in |- *; apply Rmult_le_pos. -left; assumption. -left; apply Rabs_pos_lt. -red in |- *; intro; rewrite H3 in a; elim (Rlt_irrefl _ a). -apply Rmult_lt_reg_l with (/ k). -apply Rinv_0_lt_compat; assumption. -rewrite <- Rmult_assoc. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_l. -rewrite Rmult_1_r; assumption. -red in |- *; intro; rewrite H3 in H; elim (Rlt_irrefl _ H). -intro; apply prod_neq_R0. -apply H0. -apply pow_nonzero. -red in |- *; intro; rewrite H3 in a; elim (Rlt_irrefl _ a). -unfold Un_cv in |- *; unfold Un_cv in H1. -intros. -cut (0 < eps / Rabs x). -intro. -elim (H1 (eps / Rabs x) H4); intros. -exists x0. -intros. -replace (An (S n) * x ^ S n / (An n * x ^ n)) with (An (S n) / An n * x). -unfold R_dist in |- *. -rewrite Rabs_mult. -replace (Rabs (An (S n) / An n) * Rabs x - k * Rabs x) with - (Rabs x * (Rabs (An (S n) / An n) - k)); [ idtac | ring ]. -rewrite Rabs_mult. -rewrite Rabs_Rabsolu. -apply Rmult_lt_reg_l with (/ Rabs x). -apply Rinv_0_lt_compat; apply Rabs_pos_lt. -red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a). -rewrite <- Rmult_assoc. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_l. -rewrite <- (Rmult_comm eps). -unfold R_dist in H5. -unfold Rdiv in |- *; unfold Rdiv in H5; apply H5; assumption. -apply Rabs_no_R0. -red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a). -unfold Rdiv in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ]. -rewrite pow_add. -simpl in |- *. -rewrite Rmult_1_r. -rewrite Rinv_mult_distr. -replace (An (n + 1)%nat * (x ^ n * x) * (/ An n * / x ^ n)) with - (An (n + 1)%nat * / An n * x * (x ^ n * / x ^ n)); - [ idtac | ring ]. -rewrite <- Rinv_r_sym. -rewrite Rmult_1_r; reflexivity. -apply pow_nonzero. -red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a). -apply H0. -apply pow_nonzero. -red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a). -unfold Rdiv in |- *; apply Rmult_lt_0_compat. -assumption. -apply Rinv_0_lt_compat; apply Rabs_pos_lt. -red in |- *; intro H7; rewrite H7 in a; elim (Rlt_irrefl _ a). -apply existT with (An 0%nat). -unfold Un_cv in |- *. -intros. -exists 0%nat. -intros. -unfold R_dist in |- *. -replace (sum_f_R0 (fun i:nat => An i * x ^ i) n) with (An 0%nat). -unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. -induction n as [| n Hrecn]. -simpl in |- *; ring. -rewrite tech5. -rewrite <- Hrecn. -rewrite b; simpl in |- *; ring. -unfold ge in |- *; apply le_O_n. -eapply Alembert_C5 with (k * Rabs x). -split. -unfold Rdiv in |- *; apply Rmult_le_pos. -left; assumption. -left; apply Rabs_pos_lt. -red in |- *; intro; rewrite H3 in r; elim (Rlt_irrefl _ r). -apply Rmult_lt_reg_l with (/ k). -apply Rinv_0_lt_compat; assumption. -rewrite <- Rmult_assoc. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_l. -rewrite Rmult_1_r; assumption. -red in |- *; intro; rewrite H3 in H; elim (Rlt_irrefl _ H). -intro; apply prod_neq_R0. -apply H0. -apply pow_nonzero. -red in |- *; intro; rewrite H3 in r; elim (Rlt_irrefl _ r). -unfold Un_cv in |- *; unfold Un_cv in H1. -intros. -cut (0 < eps / Rabs x). -intro. -elim (H1 (eps / Rabs x) H4); intros. -exists x0. -intros. -replace (An (S n) * x ^ S n / (An n * x ^ n)) with (An (S n) / An n * x). -unfold R_dist in |- *. -rewrite Rabs_mult. -replace (Rabs (An (S n) / An n) * Rabs x - k * Rabs x) with - (Rabs x * (Rabs (An (S n) / An n) - k)); [ idtac | ring ]. -rewrite Rabs_mult. -rewrite Rabs_Rabsolu. -apply Rmult_lt_reg_l with (/ Rabs x). -apply Rinv_0_lt_compat; apply Rabs_pos_lt. -red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r). -rewrite <- Rmult_assoc. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_l. -rewrite <- (Rmult_comm eps). -unfold R_dist in H5. -unfold Rdiv in |- *; unfold Rdiv in H5; apply H5; assumption. -apply Rabs_no_R0. -red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r). -unfold Rdiv in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ]. -rewrite pow_add. -simpl in |- *. -rewrite Rmult_1_r. -rewrite Rinv_mult_distr. -replace (An (n + 1)%nat * (x ^ n * x) * (/ An n * / x ^ n)) with - (An (n + 1)%nat * / An n * x * (x ^ n * / x ^ n)); - [ idtac | ring ]. -rewrite <- Rinv_r_sym. -rewrite Rmult_1_r; reflexivity. -apply pow_nonzero. -red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r). -apply H0. -apply pow_nonzero. -red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r). -unfold Rdiv in |- *; apply Rmult_lt_0_compat. -assumption. -apply Rinv_0_lt_compat; apply Rabs_pos_lt. -red in |- *; intro H7; rewrite H7 in r; elim (Rlt_irrefl _ r). + forall (An:nat -> R) (x k:R), + 0 < k -> + (forall n:nat, An n <> 0) -> + Un_cv (fun n:nat => Rabs (An (S n) / An n)) k -> + Rabs x < / k -> sigT (fun l:R => Pser An x l). + intros. + cut + (sigT + (fun l:R => Un_cv (fun N:nat => sum_f_R0 (fun i:nat => An i * x ^ i) N) l)). + intro X. + elim X; intros. + apply existT with x0. + apply tech12; assumption. + case (total_order_T x 0); intro. + elim s; intro. + eapply Alembert_C5 with (k * Rabs x). + split. + unfold Rdiv in |- *; apply Rmult_le_pos. + left; assumption. + left; apply Rabs_pos_lt. + red in |- *; intro; rewrite H3 in a; elim (Rlt_irrefl _ a). + apply Rmult_lt_reg_l with (/ k). + apply Rinv_0_lt_compat; assumption. + rewrite <- Rmult_assoc. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_l. + rewrite Rmult_1_r; assumption. + red in |- *; intro; rewrite H3 in H; elim (Rlt_irrefl _ H). + intro; apply prod_neq_R0. + apply H0. + apply pow_nonzero. + red in |- *; intro; rewrite H3 in a; elim (Rlt_irrefl _ a). + unfold Un_cv in |- *; unfold Un_cv in H1. + intros. + cut (0 < eps / Rabs x). + intro. + elim (H1 (eps / Rabs x) H4); intros. + exists x0. + intros. + replace (An (S n) * x ^ S n / (An n * x ^ n)) with (An (S n) / An n * x). + unfold R_dist in |- *. + rewrite Rabs_mult. + replace (Rabs (An (S n) / An n) * Rabs x - k * Rabs x) with + (Rabs x * (Rabs (An (S n) / An n) - k)); [ idtac | ring ]. + rewrite Rabs_mult. + rewrite Rabs_Rabsolu. + apply Rmult_lt_reg_l with (/ Rabs x). + apply Rinv_0_lt_compat; apply Rabs_pos_lt. + red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a). + rewrite <- Rmult_assoc. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_l. + rewrite <- (Rmult_comm eps). + unfold R_dist in H5. + unfold Rdiv in |- *; unfold Rdiv in H5; apply H5; assumption. + apply Rabs_no_R0. + red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a). + unfold Rdiv in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ]. + rewrite pow_add. + simpl in |- *. + rewrite Rmult_1_r. + rewrite Rinv_mult_distr. + replace (An (n + 1)%nat * (x ^ n * x) * (/ An n * / x ^ n)) with + (An (n + 1)%nat * / An n * x * (x ^ n * / x ^ n)); + [ idtac | ring ]. + rewrite <- Rinv_r_sym. + rewrite Rmult_1_r; reflexivity. + apply pow_nonzero. + red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a). + apply H0. + apply pow_nonzero. + red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a). + unfold Rdiv in |- *; apply Rmult_lt_0_compat. + assumption. + apply Rinv_0_lt_compat; apply Rabs_pos_lt. + red in |- *; intro H7; rewrite H7 in a; elim (Rlt_irrefl _ a). + apply existT with (An 0%nat). + unfold Un_cv in |- *. + intros. + exists 0%nat. + intros. + unfold R_dist in |- *. + replace (sum_f_R0 (fun i:nat => An i * x ^ i) n) with (An 0%nat). + unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. + induction n as [| n Hrecn]. + simpl in |- *; ring. + rewrite tech5. + rewrite <- Hrecn. + rewrite b; simpl in |- *; ring. + unfold ge in |- *; apply le_O_n. + eapply Alembert_C5 with (k * Rabs x). + split. + unfold Rdiv in |- *; apply Rmult_le_pos. + left; assumption. + left; apply Rabs_pos_lt. + red in |- *; intro; rewrite H3 in r; elim (Rlt_irrefl _ r). + apply Rmult_lt_reg_l with (/ k). + apply Rinv_0_lt_compat; assumption. + rewrite <- Rmult_assoc. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_l. + rewrite Rmult_1_r; assumption. + red in |- *; intro; rewrite H3 in H; elim (Rlt_irrefl _ H). + intro; apply prod_neq_R0. + apply H0. + apply pow_nonzero. + red in |- *; intro; rewrite H3 in r; elim (Rlt_irrefl _ r). + unfold Un_cv in |- *; unfold Un_cv in H1. + intros. + cut (0 < eps / Rabs x). + intro. + elim (H1 (eps / Rabs x) H4); intros. + exists x0. + intros. + replace (An (S n) * x ^ S n / (An n * x ^ n)) with (An (S n) / An n * x). + unfold R_dist in |- *. + rewrite Rabs_mult. + replace (Rabs (An (S n) / An n) * Rabs x - k * Rabs x) with + (Rabs x * (Rabs (An (S n) / An n) - k)); [ idtac | ring ]. + rewrite Rabs_mult. + rewrite Rabs_Rabsolu. + apply Rmult_lt_reg_l with (/ Rabs x). + apply Rinv_0_lt_compat; apply Rabs_pos_lt. + red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r). + rewrite <- Rmult_assoc. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_l. + rewrite <- (Rmult_comm eps). + unfold R_dist in H5. + unfold Rdiv in |- *; unfold Rdiv in H5; apply H5; assumption. + apply Rabs_no_R0. + red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r). + unfold Rdiv in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ]. + rewrite pow_add. + simpl in |- *. + rewrite Rmult_1_r. + rewrite Rinv_mult_distr. + replace (An (n + 1)%nat * (x ^ n * x) * (/ An n * / x ^ n)) with + (An (n + 1)%nat * / An n * x * (x ^ n * / x ^ n)); + [ idtac | ring ]. + rewrite <- Rinv_r_sym. + rewrite Rmult_1_r; reflexivity. + apply pow_nonzero. + red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r). + apply H0. + apply pow_nonzero. + red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r). + unfold Rdiv in |- *; apply Rmult_lt_0_compat. + assumption. + apply Rinv_0_lt_compat; apply Rabs_pos_lt. + red in |- *; intro H7; rewrite H7 in r; elim (Rlt_irrefl _ r). Qed. diff --git a/theories/Reals/AltSeries.v b/theories/Reals/AltSeries.v index 1ec8c664..fa44b6ff 100644 --- a/theories/Reals/AltSeries.v +++ b/theories/Reals/AltSeries.v @@ -1,12 +1,12 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) - -(*i $Id: AltSeries.v 5920 2004-07-16 20:01:26Z herbelin $ i*) + (************************************************************************) + (* v * The Coq Proof Assistant / The Coq Development Team *) + (* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) + (* \VV/ **************************************************************) + (* // * This file is distributed under the terms of the *) + (* * GNU Lesser General Public License Version 2.1 *) + (************************************************************************) + + (*i $Id: AltSeries.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -17,432 +17,442 @@ Require Import Max. Open Local Scope R_scope. (**********) +(** * Formalization of alternated series *) Definition tg_alt (Un:nat -> R) (i:nat) : R := (-1) ^ i * Un i. Definition positivity_seq (Un:nat -> R) : Prop := forall n:nat, 0 <= Un n. Lemma CV_ALT_step0 : - forall Un:nat -> R, - Un_decreasing Un -> - Un_growing (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N))). -intros; unfold Un_growing in |- *; intro. -cut ((2 * S n)%nat = S (S (2 * n))). -intro; rewrite H0. -do 4 rewrite tech5; repeat rewrite Rplus_assoc; apply Rplus_le_compat_l. -pattern (tg_alt Un (S (2 * n))) at 1 in |- *; rewrite <- Rplus_0_r. -apply Rplus_le_compat_l. -unfold tg_alt in |- *; rewrite <- H0; rewrite pow_1_odd; rewrite pow_1_even; - rewrite Rmult_1_l. -apply Rplus_le_reg_l with (Un (S (2 * S n))). -rewrite Rplus_0_r; - replace (Un (S (2 * S n)) + (Un (2 * S n)%nat + -1 * Un (S (2 * S n)))) with - (Un (2 * S n)%nat); [ idtac | ring ]. -apply H. -cut (forall n:nat, S n = (n + 1)%nat); [ intro | intro; ring ]. -rewrite (H0 n); rewrite (H0 (S (2 * n))); rewrite (H0 (2 * n)%nat); ring. + forall Un:nat -> R, + Un_decreasing Un -> + Un_growing (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N))). +Proof. + intros; unfold Un_growing in |- *; intro. + cut ((2 * S n)%nat = S (S (2 * n))). + intro; rewrite H0. + do 4 rewrite tech5; repeat rewrite Rplus_assoc; apply Rplus_le_compat_l. + pattern (tg_alt Un (S (2 * n))) at 1 in |- *; rewrite <- Rplus_0_r. + apply Rplus_le_compat_l. + unfold tg_alt in |- *; rewrite <- H0; rewrite pow_1_odd; rewrite pow_1_even; + rewrite Rmult_1_l. + apply Rplus_le_reg_l with (Un (S (2 * S n))). + rewrite Rplus_0_r; + replace (Un (S (2 * S n)) + (Un (2 * S n)%nat + -1 * Un (S (2 * S n)))) with + (Un (2 * S n)%nat); [ idtac | ring ]. + apply H. + cut (forall n:nat, S n = (n + 1)%nat); [ intro | intro; ring ]. + rewrite (H0 n); rewrite (H0 (S (2 * n))); rewrite (H0 (2 * n)%nat); ring. Qed. Lemma CV_ALT_step1 : - forall Un:nat -> R, - Un_decreasing Un -> - Un_decreasing (fun N:nat => sum_f_R0 (tg_alt Un) (2 * N)). -intros; unfold Un_decreasing in |- *; intro. -cut ((2 * S n)%nat = S (S (2 * n))). -intro; rewrite H0; do 2 rewrite tech5; repeat rewrite Rplus_assoc. -pattern (sum_f_R0 (tg_alt Un) (2 * n)) at 2 in |- *; rewrite <- Rplus_0_r. -apply Rplus_le_compat_l. -unfold tg_alt in |- *; rewrite <- H0; rewrite pow_1_odd; rewrite pow_1_even; - rewrite Rmult_1_l. -apply Rplus_le_reg_l with (Un (S (2 * n))). -rewrite Rplus_0_r; - replace (Un (S (2 * n)) + (-1 * Un (S (2 * n)) + Un (2 * S n)%nat)) with - (Un (2 * S n)%nat); [ idtac | ring ]. -rewrite H0; apply H. -cut (forall n:nat, S n = (n + 1)%nat); [ intro | intro; ring ]. -rewrite (H0 n); rewrite (H0 (S (2 * n))); rewrite (H0 (2 * n)%nat); ring. + forall Un:nat -> R, + Un_decreasing Un -> + Un_decreasing (fun N:nat => sum_f_R0 (tg_alt Un) (2 * N)). +Proof. + intros; unfold Un_decreasing in |- *; intro. + cut ((2 * S n)%nat = S (S (2 * n))). + intro; rewrite H0; do 2 rewrite tech5; repeat rewrite Rplus_assoc. + pattern (sum_f_R0 (tg_alt Un) (2 * n)) at 2 in |- *; rewrite <- Rplus_0_r. + apply Rplus_le_compat_l. + unfold tg_alt in |- *; rewrite <- H0; rewrite pow_1_odd; rewrite pow_1_even; + rewrite Rmult_1_l. + apply Rplus_le_reg_l with (Un (S (2 * n))). + rewrite Rplus_0_r; + replace (Un (S (2 * n)) + (-1 * Un (S (2 * n)) + Un (2 * S n)%nat)) with + (Un (2 * S n)%nat); [ idtac | ring ]. + rewrite H0; apply H. + cut (forall n:nat, S n = (n + 1)%nat); [ intro | intro; ring ]. + rewrite (H0 n); rewrite (H0 (S (2 * n))); rewrite (H0 (2 * n)%nat); ring. Qed. (**********) Lemma CV_ALT_step2 : - forall (Un:nat -> R) (N:nat), - Un_decreasing Un -> - positivity_seq Un -> - sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N)) <= 0. -intros; induction N as [| N HrecN]. -simpl in |- *; unfold tg_alt in |- *; simpl in |- *; rewrite Rmult_1_r. -replace (-1 * -1 * Un 2%nat) with (Un 2%nat); [ idtac | ring ]. -apply Rplus_le_reg_l with (Un 1%nat); rewrite Rplus_0_r. -replace (Un 1%nat + (-1 * Un 1%nat + Un 2%nat)) with (Un 2%nat); - [ apply H | ring ]. -cut (S (2 * S N) = S (S (S (2 * N)))). -intro; rewrite H1; do 2 rewrite tech5. -apply Rle_trans with (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N))). -pattern (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N))) at 2 in |- *; - rewrite <- Rplus_0_r. -rewrite Rplus_assoc; apply Rplus_le_compat_l. -unfold tg_alt in |- *; rewrite <- H1. -rewrite pow_1_odd. -cut (S (S (2 * S N)) = (2 * S (S N))%nat). -intro; rewrite H2; rewrite pow_1_even; rewrite Rmult_1_l; rewrite <- H2. -apply Rplus_le_reg_l with (Un (S (2 * S N))). -rewrite Rplus_0_r; - replace (Un (S (2 * S N)) + (-1 * Un (S (2 * S N)) + Un (S (S (2 * S N))))) - with (Un (S (S (2 * S N)))); [ idtac | ring ]. -apply H. -apply INR_eq; rewrite mult_INR; repeat rewrite S_INR; rewrite mult_INR; - repeat rewrite S_INR; ring. -apply HrecN. -apply INR_eq; repeat rewrite S_INR; do 2 rewrite mult_INR; - repeat rewrite S_INR; ring. + forall (Un:nat -> R) (N:nat), + Un_decreasing Un -> + positivity_seq Un -> + sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N)) <= 0. +Proof. + intros; induction N as [| N HrecN]. + simpl in |- *; unfold tg_alt in |- *; simpl in |- *; rewrite Rmult_1_r. + replace (-1 * -1 * Un 2%nat) with (Un 2%nat); [ idtac | ring ]. + apply Rplus_le_reg_l with (Un 1%nat); rewrite Rplus_0_r. + replace (Un 1%nat + (-1 * Un 1%nat + Un 2%nat)) with (Un 2%nat); + [ apply H | ring ]. + cut (S (2 * S N) = S (S (S (2 * N)))). + intro; rewrite H1; do 2 rewrite tech5. + apply Rle_trans with (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N))). + pattern (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N))) at 2 in |- *; + rewrite <- Rplus_0_r. + rewrite Rplus_assoc; apply Rplus_le_compat_l. + unfold tg_alt in |- *; rewrite <- H1. + rewrite pow_1_odd. + cut (S (S (2 * S N)) = (2 * S (S N))%nat). + intro; rewrite H2; rewrite pow_1_even; rewrite Rmult_1_l; rewrite <- H2. + apply Rplus_le_reg_l with (Un (S (2 * S N))). + rewrite Rplus_0_r; + replace (Un (S (2 * S N)) + (-1 * Un (S (2 * S N)) + Un (S (S (2 * S N))))) + with (Un (S (S (2 * S N)))); [ idtac | ring ]. + apply H. + ring_nat. + apply HrecN. + ring_nat. Qed. -(* A more general inequality *) +(** A more general inequality *) Lemma CV_ALT_step3 : - forall (Un:nat -> R) (N:nat), - Un_decreasing Un -> - positivity_seq Un -> sum_f_R0 (fun i:nat => tg_alt Un (S i)) N <= 0. -intros; induction N as [| N HrecN]. -simpl in |- *; unfold tg_alt in |- *; simpl in |- *; rewrite Rmult_1_r. -apply Rplus_le_reg_l with (Un 1%nat). -rewrite Rplus_0_r; replace (Un 1%nat + -1 * Un 1%nat) with 0; - [ apply H0 | ring ]. -assert (H1 := even_odd_cor N). -elim H1; intros. -elim H2; intro. -rewrite H3; apply CV_ALT_step2; assumption. -rewrite H3; rewrite tech5. -apply Rle_trans with (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * x))). -pattern (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * x))) at 2 in |- *; - rewrite <- Rplus_0_r. -apply Rplus_le_compat_l. -unfold tg_alt in |- *; simpl in |- *. -replace (x + (x + 0))%nat with (2 * x)%nat; [ idtac | ring ]. -rewrite pow_1_even. -replace (-1 * (-1 * (-1 * 1)) * Un (S (S (S (2 * x))))) with - (- Un (S (S (S (2 * x))))); [ idtac | ring ]. -apply Rplus_le_reg_l with (Un (S (S (S (2 * x))))). -rewrite Rplus_0_r; rewrite Rplus_opp_r. -apply H0. -apply CV_ALT_step2; assumption. + forall (Un:nat -> R) (N:nat), + Un_decreasing Un -> + positivity_seq Un -> sum_f_R0 (fun i:nat => tg_alt Un (S i)) N <= 0. +Proof. + intros; induction N as [| N HrecN]. + simpl in |- *; unfold tg_alt in |- *; simpl in |- *; rewrite Rmult_1_r. + apply Rplus_le_reg_l with (Un 1%nat). + rewrite Rplus_0_r; replace (Un 1%nat + -1 * Un 1%nat) with 0; + [ apply H0 | ring ]. + assert (H1 := even_odd_cor N). + elim H1; intros. + elim H2; intro. + rewrite H3; apply CV_ALT_step2; assumption. + rewrite H3; rewrite tech5. + apply Rle_trans with (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * x))). + pattern (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * x))) at 2 in |- *; + rewrite <- Rplus_0_r. + apply Rplus_le_compat_l. + unfold tg_alt in |- *; simpl in |- *. + replace (x + (x + 0))%nat with (2 * x)%nat; [ idtac | ring ]. + rewrite pow_1_even. + replace (-1 * (-1 * (-1 * 1)) * Un (S (S (S (2 * x))))) with + (- Un (S (S (S (2 * x))))); [ idtac | ring ]. + apply Rplus_le_reg_l with (Un (S (S (S (2 * x))))). + rewrite Rplus_0_r; rewrite Rplus_opp_r. + apply H0. + apply CV_ALT_step2; assumption. Qed. -(**********) + (**********) Lemma CV_ALT_step4 : - forall Un:nat -> R, - Un_decreasing Un -> - positivity_seq Un -> - has_ub (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N))). -intros; unfold has_ub in |- *; unfold bound in |- *. -exists (Un 0%nat). -unfold is_upper_bound in |- *; intros; elim H1; intros. -rewrite H2; rewrite decomp_sum. -replace (tg_alt Un 0) with (Un 0%nat). -pattern (Un 0%nat) at 2 in |- *; rewrite <- Rplus_0_r. -apply Rplus_le_compat_l. -apply CV_ALT_step3; assumption. -unfold tg_alt in |- *; simpl in |- *; ring. -apply lt_O_Sn. + forall Un:nat -> R, + Un_decreasing Un -> + positivity_seq Un -> + has_ub (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N))). +Proof. + intros; unfold has_ub in |- *; unfold bound in |- *. + exists (Un 0%nat). + unfold is_upper_bound in |- *; intros; elim H1; intros. + rewrite H2; rewrite decomp_sum. + replace (tg_alt Un 0) with (Un 0%nat). + pattern (Un 0%nat) at 2 in |- *; rewrite <- Rplus_0_r. + apply Rplus_le_compat_l. + apply CV_ALT_step3; assumption. + unfold tg_alt in |- *; simpl in |- *; ring. + apply lt_O_Sn. Qed. -(* This lemma gives an interesting result about alternated series *) +(** This lemma gives an interesting result about alternated series *) Lemma CV_ALT : - forall Un:nat -> R, - Un_decreasing Un -> - positivity_seq Un -> - Un_cv Un 0 -> - sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) N) l). -intros. -assert (H2 := CV_ALT_step0 _ H). -assert (H3 := CV_ALT_step4 _ H H0). -assert (X := growing_cv _ H2 H3). -elim X; intros. -apply existT with x. -unfold Un_cv in |- *; unfold R_dist in |- *; unfold Un_cv in H1; - unfold R_dist in H1; unfold Un_cv in p; unfold R_dist in p. -intros; cut (0 < eps / 2); - [ intro - | unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. -elim (H1 (eps / 2) H5); intros N2 H6. -elim (p (eps / 2) H5); intros N1 H7. -set (N := max (S (2 * N1)) N2). -exists N; intros. -assert (H9 := even_odd_cor n). -elim H9; intros P H10. -cut (N1 <= P)%nat. -intro; elim H10; intro. -replace (sum_f_R0 (tg_alt Un) n - x) with - (sum_f_R0 (tg_alt Un) (S n) - x + - tg_alt Un (S n)). -apply Rle_lt_trans with - (Rabs (sum_f_R0 (tg_alt Un) (S n) - x) + Rabs (- tg_alt Un (S n))). -apply Rabs_triang. -rewrite (double_var eps); apply Rplus_lt_compat. -rewrite H12; apply H7; assumption. -rewrite Rabs_Ropp; unfold tg_alt in |- *; rewrite Rabs_mult; - rewrite pow_1_abs; rewrite Rmult_1_l; unfold Rminus in H6; - rewrite Ropp_0 in H6; rewrite <- (Rplus_0_r (Un (S n))); - apply H6. -unfold ge in |- *; apply le_trans with n. -apply le_trans with N; [ unfold N in |- *; apply le_max_r | assumption ]. -apply le_n_Sn. -rewrite tech5; ring. -rewrite H12; apply Rlt_trans with (eps / 2). -apply H7; assumption. -unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2. -prove_sup0. -rewrite (Rmult_comm 2); rewrite Rmult_assoc; rewrite <- Rinv_l_sym; - [ rewrite Rmult_1_r | discrR ]. -rewrite double. -pattern eps at 1 in |- *; rewrite <- (Rplus_0_r eps); apply Rplus_lt_compat_l; - assumption. -elim H10; intro; apply le_double. -rewrite <- H11; apply le_trans with N. -unfold N in |- *; apply le_trans with (S (2 * N1)); - [ apply le_n_Sn | apply le_max_l ]. -assumption. -apply lt_n_Sm_le. -rewrite <- H11. -apply lt_le_trans with N. -unfold N in |- *; apply lt_le_trans with (S (2 * N1)). -apply lt_n_Sn. -apply le_max_l. -assumption. + forall Un:nat -> R, + Un_decreasing Un -> + positivity_seq Un -> + Un_cv Un 0 -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) N) l). +Proof. + intros. + assert (H2 := CV_ALT_step0 _ H). + assert (H3 := CV_ALT_step4 _ H H0). + assert (X := growing_cv _ H2 H3). + elim X; intros. + apply existT with x. + unfold Un_cv in |- *; unfold R_dist in |- *; unfold Un_cv in H1; + unfold R_dist in H1; unfold Un_cv in p; unfold R_dist in p. + intros; cut (0 < eps / 2); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. + elim (H1 (eps / 2) H5); intros N2 H6. + elim (p (eps / 2) H5); intros N1 H7. + set (N := max (S (2 * N1)) N2). + exists N; intros. + assert (H9 := even_odd_cor n). + elim H9; intros P H10. + cut (N1 <= P)%nat. + intro; elim H10; intro. + replace (sum_f_R0 (tg_alt Un) n - x) with + (sum_f_R0 (tg_alt Un) (S n) - x + - tg_alt Un (S n)). + apply Rle_lt_trans with + (Rabs (sum_f_R0 (tg_alt Un) (S n) - x) + Rabs (- tg_alt Un (S n))). + apply Rabs_triang. + rewrite (double_var eps); apply Rplus_lt_compat. + rewrite H12; apply H7; assumption. + rewrite Rabs_Ropp; unfold tg_alt in |- *; rewrite Rabs_mult; + rewrite pow_1_abs; rewrite Rmult_1_l; unfold Rminus in H6; + rewrite Ropp_0 in H6; rewrite <- (Rplus_0_r (Un (S n))); + apply H6. + unfold ge in |- *; apply le_trans with n. + apply le_trans with N; [ unfold N in |- *; apply le_max_r | assumption ]. + apply le_n_Sn. + rewrite tech5; ring. + rewrite H12; apply Rlt_trans with (eps / 2). + apply H7; assumption. + unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2. + prove_sup0. + rewrite (Rmult_comm 2); rewrite Rmult_assoc; rewrite <- Rinv_l_sym; + [ rewrite Rmult_1_r | discrR ]. + rewrite double. + pattern eps at 1 in |- *; rewrite <- (Rplus_0_r eps); apply Rplus_lt_compat_l; + assumption. + elim H10; intro; apply le_double. + rewrite <- H11; apply le_trans with N. + unfold N in |- *; apply le_trans with (S (2 * N1)); + [ apply le_n_Sn | apply le_max_l ]. + assumption. + apply lt_n_Sm_le. + rewrite <- H11. + apply lt_le_trans with N. + unfold N in |- *; apply lt_le_trans with (S (2 * N1)). + apply lt_n_Sn. + apply le_max_l. + assumption. Qed. -(************************************************) -(* Convergence of alternated series *) -(* *) -(* Applications: PI, cos, sin *) -(************************************************) + +(*************************************************) +(** * Convergence of alternated series *) Theorem alternated_series : - forall Un:nat -> R, - Un_decreasing Un -> - Un_cv Un 0 -> - sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) N) l). -intros; apply CV_ALT. -assumption. -unfold positivity_seq in |- *; apply decreasing_ineq; assumption. -assumption. + forall Un:nat -> R, + Un_decreasing Un -> + Un_cv Un 0 -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) N) l). +Proof. + intros; apply CV_ALT. + assumption. + unfold positivity_seq in |- *; apply decreasing_ineq; assumption. + assumption. Qed. Theorem alternated_series_ineq : - forall (Un:nat -> R) (l:R) (N:nat), - Un_decreasing Un -> - Un_cv Un 0 -> - Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) N) l -> - sum_f_R0 (tg_alt Un) (S (2 * N)) <= l <= sum_f_R0 (tg_alt Un) (2 * N). -intros. -cut (Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) (2 * N)) l). -cut (Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N))) l). -intros; split. -apply (growing_ineq (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N)))). -apply CV_ALT_step0; assumption. -assumption. -apply (decreasing_ineq (fun N:nat => sum_f_R0 (tg_alt Un) (2 * N))). -apply CV_ALT_step1; assumption. -assumption. -unfold Un_cv in |- *; unfold R_dist in |- *; unfold Un_cv in H1; - unfold R_dist in H1; intros. -elim (H1 eps H2); intros. -exists x; intros. -apply H3. -unfold ge in |- *; apply le_trans with (2 * n)%nat. -apply le_trans with n. -assumption. -assert (H5 := mult_O_le n 2). -elim H5; intro. -cut (0%nat <> 2%nat); - [ intro; elim H7; symmetry in |- *; assumption | discriminate ]. -assumption. -apply le_n_Sn. -unfold Un_cv in |- *; unfold R_dist in |- *; unfold Un_cv in H1; - unfold R_dist in H1; intros. -elim (H1 eps H2); intros. -exists x; intros. -apply H3. -unfold ge in |- *; apply le_trans with n. -assumption. -assert (H5 := mult_O_le n 2). -elim H5; intro. -cut (0%nat <> 2%nat); - [ intro; elim H7; symmetry in |- *; assumption | discriminate ]. -assumption. + forall (Un:nat -> R) (l:R) (N:nat), + Un_decreasing Un -> + Un_cv Un 0 -> + Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) N) l -> + sum_f_R0 (tg_alt Un) (S (2 * N)) <= l <= sum_f_R0 (tg_alt Un) (2 * N). +Proof. + intros. + cut (Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) (2 * N)) l). + cut (Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N))) l). + intros; split. + apply (growing_ineq (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N)))). + apply CV_ALT_step0; assumption. + assumption. + apply (decreasing_ineq (fun N:nat => sum_f_R0 (tg_alt Un) (2 * N))). + apply CV_ALT_step1; assumption. + assumption. + unfold Un_cv in |- *; unfold R_dist in |- *; unfold Un_cv in H1; + unfold R_dist in H1; intros. + elim (H1 eps H2); intros. + exists x; intros. + apply H3. + unfold ge in |- *; apply le_trans with (2 * n)%nat. + apply le_trans with n. + assumption. + assert (H5 := mult_O_le n 2). + elim H5; intro. + cut (0%nat <> 2%nat); + [ intro; elim H7; symmetry in |- *; assumption | discriminate ]. + assumption. + apply le_n_Sn. + unfold Un_cv in |- *; unfold R_dist in |- *; unfold Un_cv in H1; + unfold R_dist in H1; intros. + elim (H1 eps H2); intros. + exists x; intros. + apply H3. + unfold ge in |- *; apply le_trans with n. + assumption. + assert (H5 := mult_O_le n 2). + elim H5; intro. + cut (0%nat <> 2%nat); + [ intro; elim H7; symmetry in |- *; assumption | discriminate ]. + assumption. Qed. -(************************************) -(* Application : construction of PI *) -(************************************) +(***************************************) +(** * Application : construction of PI *) +(***************************************) Definition PI_tg (n:nat) := / INR (2 * n + 1). Lemma PI_tg_pos : forall n:nat, 0 <= PI_tg n. -intro; unfold PI_tg in |- *; left; apply Rinv_0_lt_compat; apply lt_INR_0; - replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ]. +Proof. + intro; unfold PI_tg in |- *; left; apply Rinv_0_lt_compat; apply lt_INR_0; + replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ]. Qed. Lemma PI_tg_decreasing : Un_decreasing PI_tg. -unfold PI_tg, Un_decreasing in |- *; intro. -apply Rmult_le_reg_l with (INR (2 * n + 1)). -apply lt_INR_0. -replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ]. -rewrite <- Rinv_r_sym. -apply Rmult_le_reg_l with (INR (2 * S n + 1)). -apply lt_INR_0. -replace (2 * S n + 1)%nat with (S (2 * S n)); [ apply lt_O_Sn | ring ]. -rewrite (Rmult_comm (INR (2 * S n + 1))); rewrite Rmult_assoc; - rewrite <- Rinv_l_sym. -do 2 rewrite Rmult_1_r; apply le_INR. -replace (2 * S n + 1)%nat with (S (S (2 * n + 1))). -apply le_trans with (S (2 * n + 1)); apply le_n_Sn. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite plus_INR; - do 2 rewrite mult_INR; repeat rewrite S_INR; ring. -apply not_O_INR; discriminate. -apply not_O_INR; replace (2 * n + 1)%nat with (S (2 * n)); - [ discriminate | ring ]. +Proof. + unfold PI_tg, Un_decreasing in |- *; intro. + apply Rmult_le_reg_l with (INR (2 * n + 1)). + apply lt_INR_0. + replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ]. + rewrite <- Rinv_r_sym. + apply Rmult_le_reg_l with (INR (2 * S n + 1)). + apply lt_INR_0. + replace (2 * S n + 1)%nat with (S (2 * S n)); [ apply lt_O_Sn | ring ]. + rewrite (Rmult_comm (INR (2 * S n + 1))); rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. + do 2 rewrite Rmult_1_r; apply le_INR. + replace (2 * S n + 1)%nat with (S (S (2 * n + 1))). + apply le_trans with (S (2 * n + 1)); apply le_n_Sn. + ring_nat. + apply not_O_INR; discriminate. + apply not_O_INR; replace (2 * n + 1)%nat with (S (2 * n)); + [ discriminate | ring ]. Qed. Lemma PI_tg_cv : Un_cv PI_tg 0. -unfold Un_cv in |- *; unfold R_dist in |- *; intros. -cut (0 < 2 * eps); - [ intro | apply Rmult_lt_0_compat; [ prove_sup0 | assumption ] ]. -assert (H1 := archimed (/ (2 * eps))). -cut (0 <= up (/ (2 * eps)))%Z. -intro; assert (H3 := IZN (up (/ (2 * eps))) H2). -elim H3; intros N H4. -cut (0 < N)%nat. -intro; exists N; intros. -cut (0 < n)%nat. -intro; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; - rewrite Rabs_right. -unfold PI_tg in |- *; apply Rlt_trans with (/ INR (2 * n)). -apply Rmult_lt_reg_l with (INR (2 * n)). -apply lt_INR_0. -replace (2 * n)%nat with (n + n)%nat; [ idtac | ring ]. -apply lt_le_trans with n. -assumption. -apply le_plus_l. -rewrite <- Rinv_r_sym. -apply Rmult_lt_reg_l with (INR (2 * n + 1)). -apply lt_INR_0. -replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ]. -rewrite (Rmult_comm (INR (2 * n + 1))). -rewrite Rmult_assoc; rewrite <- Rinv_l_sym. -do 2 rewrite Rmult_1_r; apply lt_INR. -replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_n_Sn | ring ]. -apply not_O_INR; replace (2 * n + 1)%nat with (S (2 * n)); - [ discriminate | ring ]. -replace n with (S (pred n)). -apply not_O_INR; discriminate. -symmetry in |- *; apply S_pred with 0%nat. -assumption. -apply Rle_lt_trans with (/ INR (2 * N)). -apply Rmult_le_reg_l with (INR (2 * N)). -rewrite mult_INR; apply Rmult_lt_0_compat; - [ simpl in |- *; prove_sup0 | apply lt_INR_0; assumption ]. -rewrite <- Rinv_r_sym. -apply Rmult_le_reg_l with (INR (2 * n)). -rewrite mult_INR; apply Rmult_lt_0_compat; - [ simpl in |- *; prove_sup0 | apply lt_INR_0; assumption ]. -rewrite (Rmult_comm (INR (2 * n))); rewrite Rmult_assoc; - rewrite <- Rinv_l_sym. -do 2 rewrite Rmult_1_r; apply le_INR. -apply (fun m n p:nat => mult_le_compat_l p n m); assumption. -replace n with (S (pred n)). -apply not_O_INR; discriminate. -symmetry in |- *; apply S_pred with 0%nat. -assumption. -replace N with (S (pred N)). -apply not_O_INR; discriminate. -symmetry in |- *; apply S_pred with 0%nat. -assumption. -rewrite mult_INR. -rewrite Rinv_mult_distr. -replace (INR 2) with 2; [ idtac | reflexivity ]. -apply Rmult_lt_reg_l with 2. -prove_sup0. -rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; [ idtac | discrR ]. -rewrite Rmult_1_l; apply Rmult_lt_reg_l with (INR N). -apply lt_INR_0; assumption. -rewrite <- Rinv_r_sym. -apply Rmult_lt_reg_l with (/ (2 * eps)). -apply Rinv_0_lt_compat; assumption. -rewrite Rmult_1_r; - replace (/ (2 * eps) * (INR N * (2 * eps))) with - (INR N * (2 * eps * / (2 * eps))); [ idtac | ring ]. -rewrite <- Rinv_r_sym. -rewrite Rmult_1_r; replace (INR N) with (IZR (Z_of_nat N)). -rewrite <- H4. -elim H1; intros; assumption. -symmetry in |- *; apply INR_IZR_INZ. -apply prod_neq_R0; - [ discrR | red in |- *; intro; rewrite H8 in H; elim (Rlt_irrefl _ H) ]. -apply not_O_INR. -red in |- *; intro; rewrite H8 in H5; elim (lt_irrefl _ H5). -replace (INR 2) with 2; [ discrR | reflexivity ]. -apply not_O_INR. -red in |- *; intro; rewrite H8 in H5; elim (lt_irrefl _ H5). -apply Rle_ge; apply PI_tg_pos. -apply lt_le_trans with N; assumption. -elim H1; intros H5 _. -assert (H6 := lt_eq_lt_dec 0 N). -elim H6; intro. -elim a; intro. -assumption. -rewrite <- b in H4. -rewrite H4 in H5. -simpl in H5. -cut (0 < / (2 * eps)); [ intro | apply Rinv_0_lt_compat; assumption ]. -elim (Rlt_irrefl _ (Rlt_trans _ _ _ H7 H5)). -elim (lt_n_O _ b). -apply le_IZR. -simpl in |- *. -left; apply Rlt_trans with (/ (2 * eps)). -apply Rinv_0_lt_compat; assumption. -elim H1; intros; assumption. +Proof. + unfold Un_cv in |- *; unfold R_dist in |- *; intros. + cut (0 < 2 * eps); + [ intro | apply Rmult_lt_0_compat; [ prove_sup0 | assumption ] ]. + assert (H1 := archimed (/ (2 * eps))). + cut (0 <= up (/ (2 * eps)))%Z. + intro; assert (H3 := IZN (up (/ (2 * eps))) H2). + elim H3; intros N H4. + cut (0 < N)%nat. + intro; exists N; intros. + cut (0 < n)%nat. + intro; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; + rewrite Rabs_right. + unfold PI_tg in |- *; apply Rlt_trans with (/ INR (2 * n)). + apply Rmult_lt_reg_l with (INR (2 * n)). + apply lt_INR_0. + replace (2 * n)%nat with (n + n)%nat; [ idtac | ring ]. + apply lt_le_trans with n. + assumption. + apply le_plus_l. + rewrite <- Rinv_r_sym. + apply Rmult_lt_reg_l with (INR (2 * n + 1)). + apply lt_INR_0. + replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ]. + rewrite (Rmult_comm (INR (2 * n + 1))). + rewrite Rmult_assoc; rewrite <- Rinv_l_sym. + do 2 rewrite Rmult_1_r; apply lt_INR. + replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_n_Sn | ring ]. + apply not_O_INR; replace (2 * n + 1)%nat with (S (2 * n)); + [ discriminate | ring ]. + replace n with (S (pred n)). + apply not_O_INR; discriminate. + symmetry in |- *; apply S_pred with 0%nat. + assumption. + apply Rle_lt_trans with (/ INR (2 * N)). + apply Rmult_le_reg_l with (INR (2 * N)). + rewrite mult_INR; apply Rmult_lt_0_compat; + [ simpl in |- *; prove_sup0 | apply lt_INR_0; assumption ]. + rewrite <- Rinv_r_sym. + apply Rmult_le_reg_l with (INR (2 * n)). + rewrite mult_INR; apply Rmult_lt_0_compat; + [ simpl in |- *; prove_sup0 | apply lt_INR_0; assumption ]. + rewrite (Rmult_comm (INR (2 * n))); rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. + do 2 rewrite Rmult_1_r; apply le_INR. + apply (fun m n p:nat => mult_le_compat_l p n m); assumption. + replace n with (S (pred n)). + apply not_O_INR; discriminate. + symmetry in |- *; apply S_pred with 0%nat. + assumption. + replace N with (S (pred N)). + apply not_O_INR; discriminate. + symmetry in |- *; apply S_pred with 0%nat. + assumption. + rewrite mult_INR. + rewrite Rinv_mult_distr. + replace (INR 2) with 2; [ idtac | reflexivity ]. + apply Rmult_lt_reg_l with 2. + prove_sup0. + rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; [ idtac | discrR ]. + rewrite Rmult_1_l; apply Rmult_lt_reg_l with (INR N). + apply lt_INR_0; assumption. + rewrite <- Rinv_r_sym. + apply Rmult_lt_reg_l with (/ (2 * eps)). + apply Rinv_0_lt_compat; assumption. + rewrite Rmult_1_r; + replace (/ (2 * eps) * (INR N * (2 * eps))) with + (INR N * (2 * eps * / (2 * eps))); [ idtac | ring ]. + rewrite <- Rinv_r_sym. + rewrite Rmult_1_r; replace (INR N) with (IZR (Z_of_nat N)). + rewrite <- H4. + elim H1; intros; assumption. + symmetry in |- *; apply INR_IZR_INZ. + apply prod_neq_R0; + [ discrR | red in |- *; intro; rewrite H8 in H; elim (Rlt_irrefl _ H) ]. + apply not_O_INR. + red in |- *; intro; rewrite H8 in H5; elim (lt_irrefl _ H5). + replace (INR 2) with 2; [ discrR | reflexivity ]. + apply not_O_INR. + red in |- *; intro; rewrite H8 in H5; elim (lt_irrefl _ H5). + apply Rle_ge; apply PI_tg_pos. + apply lt_le_trans with N; assumption. + elim H1; intros H5 _. + assert (H6 := lt_eq_lt_dec 0 N). + elim H6; intro. + elim a; intro. + assumption. + rewrite <- b in H4. + rewrite H4 in H5. + simpl in H5. + cut (0 < / (2 * eps)); [ intro | apply Rinv_0_lt_compat; assumption ]. + elim (Rlt_irrefl _ (Rlt_trans _ _ _ H7 H5)). + elim (lt_n_O _ b). + apply le_IZR. + simpl in |- *. + left; apply Rlt_trans with (/ (2 * eps)). + apply Rinv_0_lt_compat; assumption. + elim H1; intros; assumption. Qed. Lemma exist_PI : - sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 (tg_alt PI_tg) N) l). -apply alternated_series. -apply PI_tg_decreasing. -apply PI_tg_cv. + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 (tg_alt PI_tg) N) l). +Proof. + apply alternated_series. + apply PI_tg_decreasing. + apply PI_tg_cv. Qed. -(* Now, PI is defined *) +(** Now, PI is defined *) Definition PI : R := 4 * match exist_PI with - | existT a b => a + | existT a b => a end. -(* We can get an approximation of PI with the following inequality *) +(** We can get an approximation of PI with the following inequality *) Lemma PI_ineq : - forall N:nat, - sum_f_R0 (tg_alt PI_tg) (S (2 * N)) <= PI / 4 <= - sum_f_R0 (tg_alt PI_tg) (2 * N). -intro; apply alternated_series_ineq. -apply PI_tg_decreasing. -apply PI_tg_cv. -unfold PI in |- *; case exist_PI; intro. -replace (4 * x / 4) with x. -trivial. -unfold Rdiv in |- *; rewrite (Rmult_comm 4); rewrite Rmult_assoc; - rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r; reflexivity | discrR ]. + forall N:nat, + sum_f_R0 (tg_alt PI_tg) (S (2 * N)) <= PI / 4 <= + sum_f_R0 (tg_alt PI_tg) (2 * N). +Proof. + intro; apply alternated_series_ineq. + apply PI_tg_decreasing. + apply PI_tg_cv. + unfold PI in |- *; case exist_PI; intro. + replace (4 * x / 4) with x. + trivial. + unfold Rdiv in |- *; rewrite (Rmult_comm 4); rewrite Rmult_assoc; + rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r; reflexivity | discrR ]. Qed. Lemma PI_RGT_0 : 0 < PI. -assert (H := PI_ineq 0). -apply Rmult_lt_reg_l with (/ 4). -apply Rinv_0_lt_compat; prove_sup0. -rewrite Rmult_0_r; rewrite Rmult_comm. -elim H; clear H; intros H _. -unfold Rdiv in H; - apply Rlt_le_trans with (sum_f_R0 (tg_alt PI_tg) (S (2 * 0))). -simpl in |- *; unfold tg_alt in |- *; simpl in |- *; rewrite Rmult_1_l; - rewrite Rmult_1_r; apply Rplus_lt_reg_r with (PI_tg 1). -rewrite Rplus_0_r; - replace (PI_tg 1 + (PI_tg 0 + -1 * PI_tg 1)) with (PI_tg 0); - [ unfold PI_tg in |- * | ring ]. -simpl in |- *; apply Rinv_lt_contravar. -rewrite Rmult_1_l; replace (2 + 1) with 3; [ prove_sup0 | ring ]. -rewrite Rplus_comm; pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; - apply Rplus_lt_compat_l; prove_sup0. -assumption. -Qed.
\ No newline at end of file +Proof. + assert (H := PI_ineq 0). + apply Rmult_lt_reg_l with (/ 4). + apply Rinv_0_lt_compat; prove_sup0. + rewrite Rmult_0_r; rewrite Rmult_comm. + elim H; clear H; intros H _. + unfold Rdiv in H; + apply Rlt_le_trans with (sum_f_R0 (tg_alt PI_tg) (S (2 * 0))). + simpl in |- *; unfold tg_alt in |- *; simpl in |- *; rewrite Rmult_1_l; + rewrite Rmult_1_r; apply Rplus_lt_reg_r with (PI_tg 1). + rewrite Rplus_0_r; + replace (PI_tg 1 + (PI_tg 0 + -1 * PI_tg 1)) with (PI_tg 0); + [ unfold PI_tg in |- * | ring ]. + simpl in |- *; apply Rinv_lt_contravar. + rewrite Rmult_1_l; replace (2 + 1) with 3; [ prove_sup0 | ring ]. + rewrite Rplus_comm; pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_lt_compat_l; prove_sup0. + assumption. +Qed. diff --git a/theories/Reals/ArithProp.v b/theories/Reals/ArithProp.v index 24d64c07..48876be2 100644 --- a/theories/Reals/ArithProp.v +++ b/theories/Reals/ArithProp.v @@ -1,178 +1,187 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) - -(*i $Id: ArithProp.v 5920 2004-07-16 20:01:26Z herbelin $ i*) + (************************************************************************) + (* v * The Coq Proof Assistant / The Coq Development Team *) + (* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) + (* \VV/ **************************************************************) + (* // * This file is distributed under the terms of the *) + (* * GNU Lesser General Public License Version 2.1 *) + (************************************************************************) + + (*i $Id: ArithProp.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rbasic_fun. Require Import Even. Require Import Div2. +Require Import ArithRing. + Open Local Scope Z_scope. Open Local Scope R_scope. Lemma minus_neq_O : forall n i:nat, (i < n)%nat -> (n - i)%nat <> 0%nat. -intros; red in |- *; intro. -cut (forall n m:nat, (m <= n)%nat -> (n - m)%nat = 0%nat -> n = m). -intro; assert (H2 := H1 _ _ (lt_le_weak _ _ H) H0); rewrite H2 in H; - elim (lt_irrefl _ H). -set (R := fun n m:nat => (m <= n)%nat -> (n - m)%nat = 0%nat -> n = m). -cut - ((forall n m:nat, R n m) -> - forall n0 m:nat, (m <= n0)%nat -> (n0 - m)%nat = 0%nat -> n0 = m). -intro; apply H1. -apply nat_double_ind. -unfold R in |- *; intros; inversion H2; reflexivity. -unfold R in |- *; intros; simpl in H3; assumption. -unfold R in |- *; intros; simpl in H4; assert (H5 := le_S_n _ _ H3); - assert (H6 := H2 H5 H4); rewrite H6; reflexivity. -unfold R in |- *; intros; apply H1; assumption. +Proof. + intros; red in |- *; intro. + cut (forall n m:nat, (m <= n)%nat -> (n - m)%nat = 0%nat -> n = m). + intro; assert (H2 := H1 _ _ (lt_le_weak _ _ H) H0); rewrite H2 in H; + elim (lt_irrefl _ H). + set (R := fun n m:nat => (m <= n)%nat -> (n - m)%nat = 0%nat -> n = m). + cut + ((forall n m:nat, R n m) -> + forall n0 m:nat, (m <= n0)%nat -> (n0 - m)%nat = 0%nat -> n0 = m). + intro; apply H1. + apply nat_double_ind. + unfold R in |- *; intros; inversion H2; reflexivity. + unfold R in |- *; intros; simpl in H3; assumption. + unfold R in |- *; intros; simpl in H4; assert (H5 := le_S_n _ _ H3); + assert (H6 := H2 H5 H4); rewrite H6; reflexivity. + unfold R in |- *; intros; apply H1; assumption. Qed. Lemma le_minusni_n : forall n i:nat, (i <= n)%nat -> (n - i <= n)%nat. -set (R := fun m n:nat => (n <= m)%nat -> (m - n <= m)%nat). -cut - ((forall m n:nat, R m n) -> forall n i:nat, (i <= n)%nat -> (n - i <= n)%nat). -intro; apply H. -apply nat_double_ind. -unfold R in |- *; intros; simpl in |- *; apply le_n. -unfold R in |- *; intros; simpl in |- *; apply le_n. -unfold R in |- *; intros; simpl in |- *; apply le_trans with n. -apply H0; apply le_S_n; assumption. -apply le_n_Sn. -unfold R in |- *; intros; apply H; assumption. +Proof. + set (R := fun m n:nat => (n <= m)%nat -> (m - n <= m)%nat). + cut + ((forall m n:nat, R m n) -> forall n i:nat, (i <= n)%nat -> (n - i <= n)%nat). + intro; apply H. + apply nat_double_ind. + unfold R in |- *; intros; simpl in |- *; apply le_n. + unfold R in |- *; intros; simpl in |- *; apply le_n. + unfold R in |- *; intros; simpl in |- *; apply le_trans with n. + apply H0; apply le_S_n; assumption. + apply le_n_Sn. + unfold R in |- *; intros; apply H; assumption. Qed. Lemma lt_minus_O_lt : forall m n:nat, (m < n)%nat -> (0 < n - m)%nat. -intros n m; pattern n, m in |- *; apply nat_double_ind; - [ intros; rewrite <- minus_n_O; assumption - | intros; elim (lt_n_O _ H) - | intros; simpl in |- *; apply H; apply lt_S_n; assumption ]. +Proof. + intros n m; pattern n, m in |- *; apply nat_double_ind; + [ intros; rewrite <- minus_n_O; assumption + | intros; elim (lt_n_O _ H) + | intros; simpl in |- *; apply H; apply lt_S_n; assumption ]. Qed. Lemma even_odd_cor : - forall n:nat, exists p : nat, n = (2 * p)%nat \/ n = S (2 * p). -intro. -assert (H := even_or_odd n). -exists (div2 n). -assert (H0 := even_odd_double n). -elim H0; intros. -elim H1; intros H3 _. -elim H2; intros H4 _. -replace (2 * div2 n)%nat with (double (div2 n)). -elim H; intro. -left. -apply H3; assumption. -right. -apply H4; assumption. -unfold double in |- *; ring. + forall n:nat, exists p : nat, n = (2 * p)%nat \/ n = S (2 * p). +Proof. + intro. + assert (H := even_or_odd n). + exists (div2 n). + assert (H0 := even_odd_double n). + elim H0; intros. + elim H1; intros H3 _. + elim H2; intros H4 _. + replace (2 * div2 n)%nat with (double (div2 n)). + elim H; intro. + left. + apply H3; assumption. + right. + apply H4; assumption. + unfold double in |- *; ring. Qed. -(* 2m <= 2n => m<=n *) + (* 2m <= 2n => m<=n *) Lemma le_double : forall m n:nat, (2 * m <= 2 * n)%nat -> (m <= n)%nat. -intros; apply INR_le. -assert (H1 := le_INR _ _ H). -do 2 rewrite mult_INR in H1. -apply Rmult_le_reg_l with (INR 2). -replace (INR 2) with 2; [ prove_sup0 | reflexivity ]. -assumption. +Proof. + intros; apply INR_le. + assert (H1 := le_INR _ _ H). + do 2 rewrite mult_INR in H1. + apply Rmult_le_reg_l with (INR 2). + replace (INR 2) with 2; [ prove_sup0 | reflexivity ]. + assumption. Qed. -(* Here, we have the euclidian division *) -(* This lemma is used in the proof of sin_eq_0 : (sin x)=0<->x=kPI *) +(** Here, we have the euclidian division *) +(** This lemma is used in the proof of sin_eq_0 : (sin x)=0<->x=kPI *) Lemma euclidian_division : - forall x y:R, - y <> 0 -> + forall x y:R, + y <> 0 -> exists k : Z, (exists r : R, x = IZR k * y + r /\ 0 <= r < Rabs y). -intros. -set - (k0 := - match Rcase_abs y with - | left _ => (1 - up (x / - y))%Z - | right _ => (up (x / y) - 1)%Z - end). -exists k0. -exists (x - IZR k0 * y). -split. -ring. -unfold k0 in |- *; case (Rcase_abs y); intro. -assert (H0 := archimed (x / - y)); rewrite <- Z_R_minus; simpl in |- *; - unfold Rminus in |- *. -replace (- ((1 + - IZR (up (x / - y))) * y)) with - ((IZR (up (x / - y)) - 1) * y); [ idtac | ring ]. -split. -apply Rmult_le_reg_l with (/ - y). -apply Rinv_0_lt_compat; apply Ropp_0_gt_lt_contravar; exact r. -rewrite Rmult_0_r; rewrite (Rmult_comm (/ - y)); rewrite Rmult_plus_distr_r; - rewrite <- Ropp_inv_permute; [ idtac | assumption ]. -rewrite Rmult_assoc; repeat rewrite Ropp_mult_distr_r_reverse; - rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r | assumption ]. -apply Rplus_le_reg_l with (IZR (up (x / - y)) - x / - y). -rewrite Rplus_0_r; unfold Rdiv in |- *; pattern (/ - y) at 4 in |- *; - rewrite <- Ropp_inv_permute; [ idtac | assumption ]. -replace - (IZR (up (x * / - y)) - x * - / y + - (- (x * / y) + - (IZR (up (x * / - y)) - 1))) with 1; - [ idtac | ring ]. -elim H0; intros _ H1; unfold Rdiv in H1; exact H1. -rewrite (Rabs_left _ r); apply Rmult_lt_reg_l with (/ - y). -apply Rinv_0_lt_compat; apply Ropp_0_gt_lt_contravar; exact r. -rewrite <- Rinv_l_sym. -rewrite (Rmult_comm (/ - y)); rewrite Rmult_plus_distr_r; - rewrite <- Ropp_inv_permute; [ idtac | assumption ]. -rewrite Rmult_assoc; repeat rewrite Ropp_mult_distr_r_reverse; - rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r | assumption ]; - apply Rplus_lt_reg_r with (IZR (up (x / - y)) - 1). -replace (IZR (up (x / - y)) - 1 + 1) with (IZR (up (x / - y))); - [ idtac | ring ]. -replace (IZR (up (x / - y)) - 1 + (- (x * / y) + - (IZR (up (x / - y)) - 1))) - with (- (x * / y)); [ idtac | ring ]. -rewrite <- Ropp_mult_distr_r_reverse; rewrite (Ropp_inv_permute _ H); elim H0; - unfold Rdiv in |- *; intros H1 _; exact H1. -apply Ropp_neq_0_compat; assumption. -assert (H0 := archimed (x / y)); rewrite <- Z_R_minus; simpl in |- *; - cut (0 < y). -intro; unfold Rminus in |- *; - replace (- ((IZR (up (x / y)) + -1) * y)) with ((1 - IZR (up (x / y))) * y); - [ idtac | ring ]. -split. -apply Rmult_le_reg_l with (/ y). -apply Rinv_0_lt_compat; assumption. -rewrite Rmult_0_r; rewrite (Rmult_comm (/ y)); rewrite Rmult_plus_distr_r; - rewrite Rmult_assoc; rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_r | assumption ]; - apply Rplus_le_reg_l with (IZR (up (x / y)) - x / y); - rewrite Rplus_0_r; unfold Rdiv in |- *; - replace - (IZR (up (x * / y)) - x * / y + (x * / y + (1 - IZR (up (x * / y))))) with - 1; [ idtac | ring ]; elim H0; intros _ H2; unfold Rdiv in H2; - exact H2. -rewrite (Rabs_right _ r); apply Rmult_lt_reg_l with (/ y). -apply Rinv_0_lt_compat; assumption. -rewrite <- (Rinv_l_sym _ H); rewrite (Rmult_comm (/ y)); - rewrite Rmult_plus_distr_r; rewrite Rmult_assoc; rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_r | assumption ]; - apply Rplus_lt_reg_r with (IZR (up (x / y)) - 1); - replace (IZR (up (x / y)) - 1 + 1) with (IZR (up (x / y))); - [ idtac | ring ]; - replace (IZR (up (x / y)) - 1 + (x * / y + (1 - IZR (up (x / y))))) with - (x * / y); [ idtac | ring ]; elim H0; unfold Rdiv in |- *; - intros H2 _; exact H2. -case (total_order_T 0 y); intro. -elim s; intro. -assumption. -elim H; symmetry in |- *; exact b. -assert (H1 := Rge_le _ _ r); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 r0)). +Proof. + intros. + set + (k0 := + match Rcase_abs y with + | left _ => (1 - up (x / - y))%Z + | right _ => (up (x / y) - 1)%Z + end). + exists k0. + exists (x - IZR k0 * y). + split. + ring. + unfold k0 in |- *; case (Rcase_abs y); intro. + assert (H0 := archimed (x / - y)); rewrite <- Z_R_minus; simpl in |- *; + unfold Rminus in |- *. + replace (- ((1 + - IZR (up (x / - y))) * y)) with + ((IZR (up (x / - y)) - 1) * y); [ idtac | ring ]. + split. + apply Rmult_le_reg_l with (/ - y). + apply Rinv_0_lt_compat; apply Ropp_0_gt_lt_contravar; exact r. + rewrite Rmult_0_r; rewrite (Rmult_comm (/ - y)); rewrite Rmult_plus_distr_r; + rewrite <- Ropp_inv_permute; [ idtac | assumption ]. + rewrite Rmult_assoc; repeat rewrite Ropp_mult_distr_r_reverse; + rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r | assumption ]. + apply Rplus_le_reg_l with (IZR (up (x / - y)) - x / - y). + rewrite Rplus_0_r; unfold Rdiv in |- *; pattern (/ - y) at 4 in |- *; + rewrite <- Ropp_inv_permute; [ idtac | assumption ]. + replace + (IZR (up (x * / - y)) - x * - / y + + (- (x * / y) + - (IZR (up (x * / - y)) - 1))) with 1; + [ idtac | ring ]. + elim H0; intros _ H1; unfold Rdiv in H1; exact H1. + rewrite (Rabs_left _ r); apply Rmult_lt_reg_l with (/ - y). + apply Rinv_0_lt_compat; apply Ropp_0_gt_lt_contravar; exact r. + rewrite <- Rinv_l_sym. + rewrite (Rmult_comm (/ - y)); rewrite Rmult_plus_distr_r; + rewrite <- Ropp_inv_permute; [ idtac | assumption ]. + rewrite Rmult_assoc; repeat rewrite Ropp_mult_distr_r_reverse; + rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r | assumption ]; + apply Rplus_lt_reg_r with (IZR (up (x / - y)) - 1). + replace (IZR (up (x / - y)) - 1 + 1) with (IZR (up (x / - y))); + [ idtac | ring ]. + replace (IZR (up (x / - y)) - 1 + (- (x * / y) + - (IZR (up (x / - y)) - 1))) + with (- (x * / y)); [ idtac | ring ]. + rewrite <- Ropp_mult_distr_r_reverse; rewrite (Ropp_inv_permute _ H); elim H0; + unfold Rdiv in |- *; intros H1 _; exact H1. + apply Ropp_neq_0_compat; assumption. + assert (H0 := archimed (x / y)); rewrite <- Z_R_minus; simpl in |- *; + cut (0 < y). + intro; unfold Rminus in |- *; + replace (- ((IZR (up (x / y)) + -1) * y)) with ((1 - IZR (up (x / y))) * y); + [ idtac | ring ]. + split. + apply Rmult_le_reg_l with (/ y). + apply Rinv_0_lt_compat; assumption. + rewrite Rmult_0_r; rewrite (Rmult_comm (/ y)); rewrite Rmult_plus_distr_r; + rewrite Rmult_assoc; rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_r | assumption ]; + apply Rplus_le_reg_l with (IZR (up (x / y)) - x / y); + rewrite Rplus_0_r; unfold Rdiv in |- *; + replace + (IZR (up (x * / y)) - x * / y + (x * / y + (1 - IZR (up (x * / y))))) with + 1; [ idtac | ring ]; elim H0; intros _ H2; unfold Rdiv in H2; + exact H2. + rewrite (Rabs_right _ r); apply Rmult_lt_reg_l with (/ y). + apply Rinv_0_lt_compat; assumption. + rewrite <- (Rinv_l_sym _ H); rewrite (Rmult_comm (/ y)); + rewrite Rmult_plus_distr_r; rewrite Rmult_assoc; rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_r | assumption ]; + apply Rplus_lt_reg_r with (IZR (up (x / y)) - 1); + replace (IZR (up (x / y)) - 1 + 1) with (IZR (up (x / y))); + [ idtac | ring ]; + replace (IZR (up (x / y)) - 1 + (x * / y + (1 - IZR (up (x / y))))) with + (x * / y); [ idtac | ring ]; elim H0; unfold Rdiv in |- *; + intros H2 _; exact H2. + case (total_order_T 0 y); intro. + elim s; intro. + assumption. + elim H; symmetry in |- *; exact b. + assert (H1 := Rge_le _ _ r); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 r0)). Qed. Lemma tech8 : forall n i:nat, (n <= S n + i)%nat. -intros; induction i as [| i Hreci]. -replace (S n + 0)%nat with (S n); [ apply le_n_Sn | ring ]. -replace (S n + S i)%nat with (S (S n + i)). -apply le_S; assumption. -apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; do 2 rewrite S_INR; ring. -Qed.
\ No newline at end of file +Proof. + intros; induction i as [| i Hreci]. + replace (S n + 0)%nat with (S n); [ apply le_n_Sn | ring ]. + replace (S n + S i)%nat with (S (S n + i)). + apply le_S; assumption. + apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; do 2 rewrite S_INR; ring. +Qed. diff --git a/theories/Reals/Binomial.v b/theories/Reals/Binomial.v index 940bd628..5be34e71 100644 --- a/theories/Reals/Binomial.v +++ b/theories/Reals/Binomial.v @@ -1,12 +1,12 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) - -(*i $Id: Binomial.v 6295 2004-11-12 16:40:39Z gregoire $ i*) + (************************************************************************) + (* v * The Coq Proof Assistant / The Coq Development Team *) + (* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) + (* \VV/ **************************************************************) + (* // * This file is distributed under the terms of the *) + (* * GNU Lesser General Public License Version 2.1 *) + (************************************************************************) + + (*i $Id: Binomial.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -17,188 +17,193 @@ Definition C (n p:nat) : R := INR (fact n) / (INR (fact p) * INR (fact (n - p))). Lemma pascal_step1 : forall n i:nat, (i <= n)%nat -> C n i = C n (n - i). -intros; unfold C in |- *; replace (n - (n - i))%nat with i. -rewrite Rmult_comm. -reflexivity. -apply plus_minus; rewrite plus_comm; apply le_plus_minus; assumption. +Proof. + intros; unfold C in |- *; replace (n - (n - i))%nat with i. + rewrite Rmult_comm. + reflexivity. + apply plus_minus; rewrite plus_comm; apply le_plus_minus; assumption. Qed. Lemma pascal_step2 : - forall n i:nat, - (i <= n)%nat -> C (S n) i = INR (S n) / INR (S n - i) * C n i. -intros; unfold C in |- *; replace (S n - i)%nat with (S (n - i)). -cut (forall n:nat, fact (S n) = (S n * fact n)%nat). -intro; repeat rewrite H0. -unfold Rdiv in |- *; repeat rewrite mult_INR; repeat rewrite Rinv_mult_distr. -ring. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -apply not_O_INR; discriminate. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -apply prod_neq_R0. -apply not_O_INR; discriminate. -apply INR_fact_neq_0. -intro; reflexivity. -apply minus_Sn_m; assumption. + forall n i:nat, + (i <= n)%nat -> C (S n) i = INR (S n) / INR (S n - i) * C n i. +Proof. + intros; unfold C in |- *; replace (S n - i)%nat with (S (n - i)). + cut (forall n:nat, fact (S n) = (S n * fact n)%nat). + intro; repeat rewrite H0. + unfold Rdiv in |- *; repeat rewrite mult_INR; repeat rewrite Rinv_mult_distr. + ring. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + apply not_O_INR; discriminate. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + apply prod_neq_R0. + apply not_O_INR; discriminate. + apply INR_fact_neq_0. + intro; reflexivity. + apply minus_Sn_m; assumption. Qed. Lemma pascal_step3 : - forall n i:nat, (i < n)%nat -> C n (S i) = INR (n - i) / INR (S i) * C n i. -intros; unfold C in |- *. -cut (forall n:nat, fact (S n) = (S n * fact n)%nat). -intro. -cut ((n - i)%nat = S (n - S i)). -intro. -pattern (n - i)%nat at 2 in |- *; rewrite H1. -repeat rewrite H0; unfold Rdiv in |- *; repeat rewrite mult_INR; - repeat rewrite Rinv_mult_distr. -rewrite <- H1; rewrite (Rmult_comm (/ INR (n - i))); - repeat rewrite Rmult_assoc; rewrite (Rmult_comm (INR (n - i))); - repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. -ring. -apply not_O_INR; apply minus_neq_O; assumption. -apply not_O_INR; discriminate. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -apply prod_neq_R0; [ apply not_O_INR; discriminate | apply INR_fact_neq_0 ]. -apply not_O_INR; discriminate. -apply INR_fact_neq_0. -apply prod_neq_R0; [ apply not_O_INR; discriminate | apply INR_fact_neq_0 ]. -apply INR_fact_neq_0. -rewrite minus_Sn_m. -simpl in |- *; reflexivity. -apply lt_le_S; assumption. -intro; reflexivity. + forall n i:nat, (i < n)%nat -> C n (S i) = INR (n - i) / INR (S i) * C n i. +Proof. + intros; unfold C in |- *. + cut (forall n:nat, fact (S n) = (S n * fact n)%nat). + intro. + cut ((n - i)%nat = S (n - S i)). + intro. + pattern (n - i)%nat at 2 in |- *; rewrite H1. + repeat rewrite H0; unfold Rdiv in |- *; repeat rewrite mult_INR; + repeat rewrite Rinv_mult_distr. + rewrite <- H1; rewrite (Rmult_comm (/ INR (n - i))); + repeat rewrite Rmult_assoc; rewrite (Rmult_comm (INR (n - i))); + repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. + ring. + apply not_O_INR; apply minus_neq_O; assumption. + apply not_O_INR; discriminate. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + apply prod_neq_R0; [ apply not_O_INR; discriminate | apply INR_fact_neq_0 ]. + apply not_O_INR; discriminate. + apply INR_fact_neq_0. + apply prod_neq_R0; [ apply not_O_INR; discriminate | apply INR_fact_neq_0 ]. + apply INR_fact_neq_0. + rewrite minus_Sn_m. + simpl in |- *; reflexivity. + apply lt_le_S; assumption. + intro; reflexivity. Qed. -(**********) + (**********) Lemma pascal : - forall n i:nat, (i < n)%nat -> C n i + C n (S i) = C (S n) (S i). -intros. -rewrite pascal_step3; [ idtac | assumption ]. -replace (C n i + INR (n - i) / INR (S i) * C n i) with - (C n i * (1 + INR (n - i) / INR (S i))); [ idtac | ring ]. -replace (1 + INR (n - i) / INR (S i)) with (INR (S n) / INR (S i)). -rewrite pascal_step1. -rewrite Rmult_comm; replace (S i) with (S n - (n - i))%nat. -rewrite <- pascal_step2. -apply pascal_step1. -apply le_trans with n. -apply le_minusni_n. -apply lt_le_weak; assumption. -apply le_n_Sn. -apply le_minusni_n. -apply lt_le_weak; assumption. -rewrite <- minus_Sn_m. -cut ((n - (n - i))%nat = i). -intro; rewrite H0; reflexivity. -symmetry in |- *; apply plus_minus. -rewrite plus_comm; rewrite le_plus_minus_r. -reflexivity. -apply lt_le_weak; assumption. -apply le_minusni_n; apply lt_le_weak; assumption. -apply lt_le_weak; assumption. -unfold Rdiv in |- *. -repeat rewrite S_INR. -rewrite minus_INR. -cut (INR i + 1 <> 0). -intro. -apply Rmult_eq_reg_l with (INR i + 1); [ idtac | assumption ]. -rewrite Rmult_plus_distr_l. -rewrite Rmult_1_r. -do 2 rewrite (Rmult_comm (INR i + 1)). -repeat rewrite Rmult_assoc. -rewrite <- Rinv_l_sym; [ idtac | assumption ]. -ring. -rewrite <- S_INR. -apply not_O_INR; discriminate. -apply lt_le_weak; assumption. + forall n i:nat, (i < n)%nat -> C n i + C n (S i) = C (S n) (S i). +Proof. + intros. + rewrite pascal_step3; [ idtac | assumption ]. + replace (C n i + INR (n - i) / INR (S i) * C n i) with + (C n i * (1 + INR (n - i) / INR (S i))); [ idtac | ring ]. + replace (1 + INR (n - i) / INR (S i)) with (INR (S n) / INR (S i)). + rewrite pascal_step1. + rewrite Rmult_comm; replace (S i) with (S n - (n - i))%nat. + rewrite <- pascal_step2. + apply pascal_step1. + apply le_trans with n. + apply le_minusni_n. + apply lt_le_weak; assumption. + apply le_n_Sn. + apply le_minusni_n. + apply lt_le_weak; assumption. + rewrite <- minus_Sn_m. + cut ((n - (n - i))%nat = i). + intro; rewrite H0; reflexivity. + symmetry in |- *; apply plus_minus. + rewrite plus_comm; rewrite le_plus_minus_r. + reflexivity. + apply lt_le_weak; assumption. + apply le_minusni_n; apply lt_le_weak; assumption. + apply lt_le_weak; assumption. + unfold Rdiv in |- *. + repeat rewrite S_INR. + rewrite minus_INR. + cut (INR i + 1 <> 0). + intro. + apply Rmult_eq_reg_l with (INR i + 1); [ idtac | assumption ]. + rewrite Rmult_plus_distr_l. + rewrite Rmult_1_r. + do 2 rewrite (Rmult_comm (INR i + 1)). + repeat rewrite Rmult_assoc. + rewrite <- Rinv_l_sym; [ idtac | assumption ]. + ring. + rewrite <- S_INR. + apply not_O_INR; discriminate. + apply lt_le_weak; assumption. Qed. -(*********************) -(*********************) + (*********************) + (*********************) Lemma binomial : - forall (x y:R) (n:nat), - (x + y) ^ n = sum_f_R0 (fun i:nat => C n i * x ^ i * y ^ (n - i)) n. -intros; induction n as [| n Hrecn]. -unfold C in |- *; simpl in |- *; unfold Rdiv in |- *; - repeat rewrite Rmult_1_r; rewrite Rinv_1; ring. -pattern (S n) at 1 in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ]. -rewrite pow_add; rewrite Hrecn. -replace ((x + y) ^ 1) with (x + y); [ idtac | simpl in |- *; ring ]. -rewrite tech5. -cut (forall p:nat, C p p = 1). -cut (forall p:nat, C p 0 = 1). -intros; rewrite H0; rewrite <- minus_n_n; rewrite Rmult_1_l. -replace (y ^ 0) with 1; [ rewrite Rmult_1_r | simpl in |- *; reflexivity ]. -induction n as [| n Hrecn0]. -simpl in |- *; do 2 rewrite H; ring. -(* N >= 1 *) -set (N := S n). -rewrite Rmult_plus_distr_l. -replace (sum_f_R0 (fun i:nat => C N i * x ^ i * y ^ (N - i)) N * x) with - (sum_f_R0 (fun i:nat => C N i * x ^ S i * y ^ (N - i)) N). -replace (sum_f_R0 (fun i:nat => C N i * x ^ i * y ^ (N - i)) N * y) with - (sum_f_R0 (fun i:nat => C N i * x ^ i * y ^ (S N - i)) N). -rewrite (decomp_sum (fun i:nat => C (S N) i * x ^ i * y ^ (S N - i)) N). -rewrite H; replace (x ^ 0) with 1; [ idtac | reflexivity ]. -do 2 rewrite Rmult_1_l. -replace (S N - 0)%nat with (S N); [ idtac | reflexivity ]. -set (An := fun i:nat => C N i * x ^ S i * y ^ (N - i)). -set (Bn := fun i:nat => C N (S i) * x ^ S i * y ^ (N - i)). -replace (pred N) with n. -replace (sum_f_R0 (fun i:nat => C (S N) (S i) * x ^ S i * y ^ (S N - S i)) n) - with (sum_f_R0 (fun i:nat => An i + Bn i) n). -rewrite plus_sum. -replace (x ^ S N) with (An (S n)). -rewrite (Rplus_comm (sum_f_R0 An n)). -repeat rewrite Rplus_assoc. -rewrite <- tech5. -fold N in |- *. -set (Cn := fun i:nat => C N i * x ^ i * y ^ (S N - i)). -cut (forall i:nat, (i < N)%nat -> Cn (S i) = Bn i). -intro; replace (sum_f_R0 Bn n) with (sum_f_R0 (fun i:nat => Cn (S i)) n). -replace (y ^ S N) with (Cn 0%nat). -rewrite <- Rplus_assoc; rewrite (decomp_sum Cn N). -replace (pred N) with n. -ring. -unfold N in |- *; simpl in |- *; reflexivity. -unfold N in |- *; apply lt_O_Sn. -unfold Cn in |- *; rewrite H; simpl in |- *; ring. -apply sum_eq. -intros; apply H1. -unfold N in |- *; apply le_lt_trans with n; [ assumption | apply lt_n_Sn ]. -intros; unfold Bn, Cn in |- *. -replace (S N - S i)%nat with (N - i)%nat; reflexivity. -unfold An in |- *; fold N in |- *; rewrite <- minus_n_n; rewrite H0; - simpl in |- *; ring. -apply sum_eq. -intros; unfold An, Bn in |- *; replace (S N - S i)%nat with (N - i)%nat; - [ idtac | reflexivity ]. -rewrite <- pascal; - [ ring - | apply le_lt_trans with n; [ assumption | unfold N in |- *; apply lt_n_Sn ] ]. -unfold N in |- *; reflexivity. -unfold N in |- *; apply lt_O_Sn. -rewrite <- (Rmult_comm y); rewrite scal_sum; apply sum_eq. -intros; replace (S N - i)%nat with (S (N - i)). -replace (S (N - i)) with (N - i + 1)%nat; [ idtac | ring ]. -rewrite pow_add; replace (y ^ 1) with y; [ idtac | simpl in |- *; ring ]; - ring. -apply minus_Sn_m; assumption. -rewrite <- (Rmult_comm x); rewrite scal_sum; apply sum_eq. -intros; replace (S i) with (i + 1)%nat; [ idtac | ring ]; rewrite pow_add; - replace (x ^ 1) with x; [ idtac | simpl in |- *; ring ]; - ring. -intro; unfold C in |- *. -replace (INR (fact 0)) with 1; [ idtac | reflexivity ]. -replace (p - 0)%nat with p; [ idtac | apply minus_n_O ]. -rewrite Rmult_1_l; unfold Rdiv in |- *; rewrite <- Rinv_r_sym; - [ reflexivity | apply INR_fact_neq_0 ]. -intro; unfold C in |- *. -replace (p - p)%nat with 0%nat; [ idtac | apply minus_n_n ]. -replace (INR (fact 0)) with 1; [ idtac | reflexivity ]. -rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite <- Rinv_r_sym; - [ reflexivity | apply INR_fact_neq_0 ]. + forall (x y:R) (n:nat), + (x + y) ^ n = sum_f_R0 (fun i:nat => C n i * x ^ i * y ^ (n - i)) n. +Proof. + intros; induction n as [| n Hrecn]. + unfold C in |- *; simpl in |- *; unfold Rdiv in |- *; + repeat rewrite Rmult_1_r; rewrite Rinv_1; ring. + pattern (S n) at 1 in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ]. + rewrite pow_add; rewrite Hrecn. + replace ((x + y) ^ 1) with (x + y); [ idtac | simpl in |- *; ring ]. + rewrite tech5. + cut (forall p:nat, C p p = 1). + cut (forall p:nat, C p 0 = 1). + intros; rewrite H0; rewrite <- minus_n_n; rewrite Rmult_1_l. + replace (y ^ 0) with 1; [ rewrite Rmult_1_r | simpl in |- *; reflexivity ]. + induction n as [| n Hrecn0]. + simpl in |- *; do 2 rewrite H; ring. + (* N >= 1 *) + set (N := S n). + rewrite Rmult_plus_distr_l. + replace (sum_f_R0 (fun i:nat => C N i * x ^ i * y ^ (N - i)) N * x) with + (sum_f_R0 (fun i:nat => C N i * x ^ S i * y ^ (N - i)) N). + replace (sum_f_R0 (fun i:nat => C N i * x ^ i * y ^ (N - i)) N * y) with + (sum_f_R0 (fun i:nat => C N i * x ^ i * y ^ (S N - i)) N). + rewrite (decomp_sum (fun i:nat => C (S N) i * x ^ i * y ^ (S N - i)) N). + rewrite H; replace (x ^ 0) with 1; [ idtac | reflexivity ]. + do 2 rewrite Rmult_1_l. + replace (S N - 0)%nat with (S N); [ idtac | reflexivity ]. + set (An := fun i:nat => C N i * x ^ S i * y ^ (N - i)). + set (Bn := fun i:nat => C N (S i) * x ^ S i * y ^ (N - i)). + replace (pred N) with n. + replace (sum_f_R0 (fun i:nat => C (S N) (S i) * x ^ S i * y ^ (S N - S i)) n) + with (sum_f_R0 (fun i:nat => An i + Bn i) n). + rewrite plus_sum. + replace (x ^ S N) with (An (S n)). + rewrite (Rplus_comm (sum_f_R0 An n)). + repeat rewrite Rplus_assoc. + rewrite <- tech5. + fold N in |- *. + set (Cn := fun i:nat => C N i * x ^ i * y ^ (S N - i)). + cut (forall i:nat, (i < N)%nat -> Cn (S i) = Bn i). + intro; replace (sum_f_R0 Bn n) with (sum_f_R0 (fun i:nat => Cn (S i)) n). + replace (y ^ S N) with (Cn 0%nat). + rewrite <- Rplus_assoc; rewrite (decomp_sum Cn N). + replace (pred N) with n. + ring. + unfold N in |- *; simpl in |- *; reflexivity. + unfold N in |- *; apply lt_O_Sn. + unfold Cn in |- *; rewrite H; simpl in |- *; ring. + apply sum_eq. + intros; apply H1. + unfold N in |- *; apply le_lt_trans with n; [ assumption | apply lt_n_Sn ]. + intros; unfold Bn, Cn in |- *. + replace (S N - S i)%nat with (N - i)%nat; reflexivity. + unfold An in |- *; fold N in |- *; rewrite <- minus_n_n; rewrite H0; + simpl in |- *; ring. + apply sum_eq. + intros; unfold An, Bn in |- *; replace (S N - S i)%nat with (N - i)%nat; + [ idtac | reflexivity ]. + rewrite <- pascal; + [ ring + | apply le_lt_trans with n; [ assumption | unfold N in |- *; apply lt_n_Sn ] ]. + unfold N in |- *; reflexivity. + unfold N in |- *; apply lt_O_Sn. + rewrite <- (Rmult_comm y); rewrite scal_sum; apply sum_eq. + intros; replace (S N - i)%nat with (S (N - i)). + replace (S (N - i)) with (N - i + 1)%nat; [ idtac | ring ]. + rewrite pow_add; replace (y ^ 1) with y; [ idtac | simpl in |- *; ring ]; + ring. + apply minus_Sn_m; assumption. + rewrite <- (Rmult_comm x); rewrite scal_sum; apply sum_eq. + intros; replace (S i) with (i + 1)%nat; [ idtac | ring ]; rewrite pow_add; + replace (x ^ 1) with x; [ idtac | simpl in |- *; ring ]; + ring. + intro; unfold C in |- *. + replace (INR (fact 0)) with 1; [ idtac | reflexivity ]. + replace (p - 0)%nat with p; [ idtac | apply minus_n_O ]. + rewrite Rmult_1_l; unfold Rdiv in |- *; rewrite <- Rinv_r_sym; + [ reflexivity | apply INR_fact_neq_0 ]. + intro; unfold C in |- *. + replace (p - p)%nat with 0%nat; [ idtac | apply minus_n_n ]. + replace (INR (fact 0)) with 1; [ idtac | reflexivity ]. + rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite <- Rinv_r_sym; + [ reflexivity | apply INR_fact_neq_0 ]. Qed. diff --git a/theories/Reals/Cauchy_prod.v b/theories/Reals/Cauchy_prod.v index 7f3727c7..37429a90 100644 --- a/theories/Reals/Cauchy_prod.v +++ b/theories/Reals/Cauchy_prod.v @@ -1,12 +1,12 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) - -(*i $Id: Cauchy_prod.v 5920 2004-07-16 20:01:26Z herbelin $ i*) + (************************************************************************) + (* v * The Coq Proof Assistant / The Coq Development Team *) + (* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) + (* \VV/ **************************************************************) + (* // * This file is distributed under the terms of the *) + (* * GNU Lesser General Public License Version 2.1 *) + (************************************************************************) + + (*i $Id: Cauchy_prod.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -14,445 +14,449 @@ Require Import Rseries. Require Import PartSum. Open Local Scope R_scope. -(**********) + (**********) Lemma sum_N_predN : - forall (An:nat -> R) (N:nat), - (0 < N)%nat -> sum_f_R0 An N = sum_f_R0 An (pred N) + An N. -intros. -replace N with (S (pred N)). -rewrite tech5. -reflexivity. -symmetry in |- *; apply S_pred with 0%nat; assumption. + forall (An:nat -> R) (N:nat), + (0 < N)%nat -> sum_f_R0 An N = sum_f_R0 An (pred N) + An N. +Proof. + intros. + replace N with (S (pred N)). + rewrite tech5. + reflexivity. + symmetry in |- *; apply S_pred with 0%nat; assumption. Qed. -(**********) + (**********) Lemma sum_plus : - forall (An Bn:nat -> R) (N:nat), - sum_f_R0 (fun l:nat => An l + Bn l) N = sum_f_R0 An N + sum_f_R0 Bn N. -intros. -induction N as [| N HrecN]. -reflexivity. -do 3 rewrite tech5. -rewrite HrecN; ring. + forall (An Bn:nat -> R) (N:nat), + sum_f_R0 (fun l:nat => An l + Bn l) N = sum_f_R0 An N + sum_f_R0 Bn N. +Proof. + intros. + induction N as [| N HrecN]. + reflexivity. + do 3 rewrite tech5. + rewrite HrecN; ring. Qed. -(* The main result *) + (* The main result *) Theorem cauchy_finite : - forall (An Bn:nat -> R) (N:nat), - (0 < N)%nat -> - sum_f_R0 An N * sum_f_R0 Bn N = - sum_f_R0 (fun k:nat => sum_f_R0 (fun p:nat => An p * Bn (k - p)%nat) k) N + - sum_f_R0 - (fun k:nat => - sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (N - l)%nat) - (pred (N - k))) (pred N). -intros; induction N as [| N HrecN]. -elim (lt_irrefl _ H). -cut (N = 0%nat \/ (0 < N)%nat). -intro; elim H0; intro. -rewrite H1; simpl in |- *; ring. -replace (pred (S N)) with (S (pred N)). -do 5 rewrite tech5. -rewrite Rmult_plus_distr_r; rewrite Rmult_plus_distr_l; rewrite (HrecN H1). -repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l. -replace (pred (S N - S (pred N))) with 0%nat. -rewrite Rmult_plus_distr_l; - replace - (sum_f_R0 (fun l:nat => An (S (l + S (pred N))) * Bn (S N - l)%nat) 0) with - (An (S N) * Bn (S N)). -repeat rewrite <- Rplus_assoc; - do 2 rewrite <- (Rplus_comm (An (S N) * Bn (S N))); - repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l. -rewrite <- minus_n_n; cut (N = 1%nat \/ (2 <= N)%nat). -intro; elim H2; intro. -rewrite H3; simpl in |- *; ring. -replace - (sum_f_R0 - (fun k:nat => - sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (N - l)%nat) (pred (N - k))) - (pred N)) with - (sum_f_R0 - (fun k:nat => - sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) - (pred (pred (N - k)))) (pred (pred N)) + - sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N)). -replace (sum_f_R0 (fun p:nat => An p * Bn (S N - p)%nat) N) with - (sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N) + - An 0%nat * Bn (S N)). -repeat rewrite <- Rplus_assoc; - rewrite <- - (Rplus_comm (sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N))) - ; repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l. -replace - (sum_f_R0 - (fun k:nat => - sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (S N - l)%nat) - (pred (S N - k))) (pred N)) with - (sum_f_R0 - (fun k:nat => - sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) - (pred (N - k))) (pred N) + - Bn (S N) * sum_f_R0 (fun l:nat => An (S l)) (pred N)). -rewrite (decomp_sum An N H1); rewrite Rmult_plus_distr_r; - repeat rewrite <- Rplus_assoc; rewrite <- (Rplus_comm (An 0%nat * Bn (S N))); - repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l. -repeat rewrite <- Rplus_assoc; - rewrite <- - (Rplus_comm (sum_f_R0 (fun i:nat => An (S i)) (pred N) * Bn (S N))) - ; - rewrite <- - (Rplus_comm (Bn (S N) * sum_f_R0 (fun i:nat => An (S i)) (pred N))) - ; rewrite (Rmult_comm (Bn (S N))); repeat rewrite Rplus_assoc; - apply Rplus_eq_compat_l. -replace - (sum_f_R0 - (fun k:nat => - sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) - (pred (N - k))) (pred N)) with - (sum_f_R0 - (fun k:nat => - sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) - (pred (pred (N - k)))) (pred (pred N)) + - An (S N) * sum_f_R0 (fun l:nat => Bn (S l)) (pred N)). -rewrite (decomp_sum Bn N H1); rewrite Rmult_plus_distr_l. -set - (Z := - sum_f_R0 - (fun k:nat => - sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) - (pred (pred (N - k)))) (pred (pred N))); - set (Z2 := sum_f_R0 (fun i:nat => Bn (S i)) (pred N)); - ring. -rewrite - (sum_N_predN + forall (An Bn:nat -> R) (N:nat), + (0 < N)%nat -> + sum_f_R0 An N * sum_f_R0 Bn N = + sum_f_R0 (fun k:nat => sum_f_R0 (fun p:nat => An p * Bn (k - p)%nat) k) N + + sum_f_R0 (fun k:nat => - sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) - (pred (N - k))) (pred N)). -replace - (sum_f_R0 - (fun k:nat => - sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) - (pred (N - k))) (pred (pred N))) with - (sum_f_R0 - (fun k:nat => - sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) - (pred (pred (N - k))) + An (S N) * Bn (S k)) ( - pred (pred N))). -rewrite - (sum_plus - (fun k:nat => - sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) - (pred (pred (N - k)))) (fun k:nat => An (S N) * Bn (S k)) - (pred (pred N))). -repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l. -replace (pred (N - pred N)) with 0%nat. -simpl in |- *; rewrite <- minus_n_O. -replace (S (pred N)) with N. -replace (sum_f_R0 (fun k:nat => An (S N) * Bn (S k)) (pred (pred N))) with - (sum_f_R0 (fun k:nat => Bn (S k) * An (S N)) (pred (pred N))). -rewrite <- (scal_sum (fun l:nat => Bn (S l)) (pred (pred N)) (An (S N))); - rewrite (sum_N_predN (fun l:nat => Bn (S l)) (pred N)). -replace (S (pred N)) with N. -ring. -apply S_pred with 0%nat; assumption. -apply lt_pred; apply lt_le_trans with 2%nat; [ apply lt_n_Sn | assumption ]. -apply sum_eq; intros; apply Rmult_comm. -apply S_pred with 0%nat; assumption. -replace (N - pred N)%nat with 1%nat. -reflexivity. -pattern N at 1 in |- *; replace N with (S (pred N)). -rewrite <- minus_Sn_m. -rewrite <- minus_n_n; reflexivity. -apply le_n. -symmetry in |- *; apply S_pred with 0%nat; assumption. -apply sum_eq; intros; - rewrite - (sum_N_predN (fun l:nat => An (S (S (l + i))) * Bn (N - l)%nat) - (pred (N - i))). -replace (S (S (pred (N - i) + i))) with (S N). -replace (N - pred (N - i))%nat with (S i). -ring. -rewrite pred_of_minus; apply INR_eq; repeat rewrite minus_INR. -rewrite S_INR; ring. -apply le_trans with (pred (pred N)). -assumption. -apply le_trans with (pred N); apply le_pred_n. -apply INR_le; rewrite minus_INR. -apply Rplus_le_reg_l with (INR i - 1). -replace (INR i - 1 + INR 1) with (INR i); [ idtac | ring ]. -replace (INR i - 1 + (INR N - INR i)) with (INR N - INR 1); [ idtac | ring ]. -rewrite <- minus_INR. -apply le_INR; apply le_trans with (pred (pred N)). -assumption. -rewrite <- pred_of_minus; apply le_pred_n. -apply le_trans with 2%nat. -apply le_n_Sn. -assumption. -apply le_trans with (pred (pred N)). -assumption. -apply le_trans with (pred N); apply le_pred_n. -rewrite <- pred_of_minus. -apply le_trans with (pred N). -apply le_S_n. -replace (S (pred N)) with N. -replace (S (pred (N - i))) with (N - i)%nat. -apply (fun p n m:nat => plus_le_reg_l n m p) with i; rewrite le_plus_minus_r. -apply le_plus_r. -apply le_trans with (pred (pred N)); - [ assumption | apply le_trans with (pred N); apply le_pred_n ]. -apply S_pred with 0%nat. -apply plus_lt_reg_l with i; rewrite le_plus_minus_r. -replace (i + 0)%nat with i; [ idtac | ring ]. -apply le_lt_trans with (pred (pred N)); - [ assumption | apply lt_trans with (pred N); apply lt_pred_n_n ]. -apply lt_S_n. -replace (S (pred N)) with N. -apply lt_le_trans with 2%nat. -apply lt_n_Sn. -assumption. -apply S_pred with 0%nat; assumption. -assumption. -apply le_trans with (pred (pred N)). -assumption. -apply le_trans with (pred N); apply le_pred_n. -apply S_pred with 0%nat; assumption. -apply le_pred_n. -apply INR_eq; rewrite pred_of_minus; do 3 rewrite S_INR; rewrite plus_INR; - repeat rewrite minus_INR. -ring. -apply le_trans with (pred (pred N)). -assumption. -apply le_trans with (pred N); apply le_pred_n. -apply INR_le. -rewrite minus_INR. -apply Rplus_le_reg_l with (INR i - 1). -replace (INR i - 1 + INR 1) with (INR i); [ idtac | ring ]. -replace (INR i - 1 + (INR N - INR i)) with (INR N - INR 1); [ idtac | ring ]. -rewrite <- minus_INR. -apply le_INR. -apply le_trans with (pred (pred N)). -assumption. -rewrite <- pred_of_minus. -apply le_pred_n. -apply le_trans with 2%nat. -apply le_n_Sn. -assumption. -apply le_trans with (pred (pred N)). -assumption. -apply le_trans with (pred N); apply le_pred_n. -apply lt_le_trans with 1%nat. -apply lt_O_Sn. -apply INR_le. -rewrite pred_of_minus. -repeat rewrite minus_INR. -apply Rplus_le_reg_l with (INR i - 1). -replace (INR i - 1 + INR 1) with (INR i); [ idtac | ring ]. -replace (INR i - 1 + (INR N - INR i - INR 1)) with (INR N - INR 1 - INR 1). -repeat rewrite <- minus_INR. -apply le_INR. -apply le_trans with (pred (pred N)). -assumption. -do 2 rewrite <- pred_of_minus. -apply le_n. -apply (fun p n m:nat => plus_le_reg_l n m p) with 1%nat. -rewrite le_plus_minus_r. -simpl in |- *; assumption. -apply le_trans with 2%nat; [ apply le_n_Sn | assumption ]. -apply le_trans with 2%nat; [ apply le_n_Sn | assumption ]. -ring. -apply le_trans with (pred (pred N)). -assumption. -apply le_trans with (pred N); apply le_pred_n. -apply (fun p n m:nat => plus_le_reg_l n m p) with i. -rewrite le_plus_minus_r. -replace (i + 1)%nat with (S i). -replace N with (S (pred N)). -apply le_n_S. -apply le_trans with (pred (pred N)). -assumption. -apply le_pred_n. -symmetry in |- *; apply S_pred with 0%nat; assumption. -apply INR_eq; rewrite S_INR; rewrite plus_INR; reflexivity. -apply le_trans with (pred (pred N)). -assumption. -apply le_trans with (pred N); apply le_pred_n. -apply lt_le_trans with 1%nat. -apply lt_O_Sn. -apply le_S_n. -replace (S (pred N)) with N. -assumption. -apply S_pred with 0%nat; assumption. -replace - (sum_f_R0 - (fun k:nat => - sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (S N - l)%nat) - (pred (S N - k))) (pred N)) with - (sum_f_R0 - (fun k:nat => - sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) - (pred (N - k)) + An (S k) * Bn (S N)) (pred N)). -rewrite - (sum_plus - (fun k:nat => - sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) - (pred (N - k))) (fun k:nat => An (S k) * Bn (S N))) - . -apply Rplus_eq_compat_l. -rewrite scal_sum; reflexivity. -apply sum_eq; intros; rewrite Rplus_comm; - rewrite - (decomp_sum (fun l:nat => An (S (l + i)) * Bn (S N - l)%nat) - (pred (S N - i))). -replace (0 + i)%nat with i; [ idtac | ring ]. -rewrite <- minus_n_O; apply Rplus_eq_compat_l. -replace (pred (pred (S N - i))) with (pred (N - i)). -apply sum_eq; intros. -replace (S N - S i0)%nat with (N - i0)%nat; [ idtac | reflexivity ]. -replace (S i0 + i)%nat with (S (i0 + i)). -reflexivity. -apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; rewrite S_INR; ring. -cut ((N - i)%nat = pred (S N - i)). -intro; rewrite H5; reflexivity. -rewrite pred_of_minus. -apply INR_eq; repeat rewrite minus_INR. -rewrite S_INR; ring. -apply le_trans with N. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply le_n_Sn. -apply (fun p n m:nat => plus_le_reg_l n m p) with i. -rewrite le_plus_minus_r. -replace (i + 1)%nat with (S i). -apply le_n_S. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply INR_eq; rewrite S_INR; rewrite plus_INR; ring. -apply le_trans with N. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply le_n_Sn. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -replace (pred (S N - i)) with (S N - S i)%nat. -replace (S N - S i)%nat with (N - i)%nat; [ idtac | reflexivity ]. -apply plus_lt_reg_l with i. -rewrite le_plus_minus_r. -replace (i + 0)%nat with i; [ idtac | ring ]. -apply le_lt_trans with (pred N). -assumption. -apply lt_pred_n_n. -assumption. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -rewrite pred_of_minus. -apply INR_eq; repeat rewrite minus_INR. -repeat rewrite S_INR; ring. -apply le_trans with N. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply le_n_Sn. -apply (fun p n m:nat => plus_le_reg_l n m p) with i. -rewrite le_plus_minus_r. -replace (i + 1)%nat with (S i). -apply le_n_S. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply INR_eq; rewrite S_INR; rewrite plus_INR; ring. -apply le_trans with N. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply le_n_Sn. -apply le_n_S. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -rewrite Rplus_comm. -rewrite (decomp_sum (fun p:nat => An p * Bn (S N - p)%nat) N). -rewrite <- minus_n_O. -apply Rplus_eq_compat_l. -apply sum_eq; intros. -reflexivity. -assumption. -rewrite Rplus_comm. -rewrite - (decomp_sum - (fun k:nat => - sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (N - l)%nat) (pred (N - k))) - (pred N)). -rewrite <- minus_n_O. -replace (sum_f_R0 (fun l:nat => An (S (l + 0)) * Bn (N - l)%nat) (pred N)) - with (sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N)). -apply Rplus_eq_compat_l. -apply sum_eq; intros. -replace (pred (N - S i)) with (pred (pred (N - i))). -apply sum_eq; intros. -replace (i0 + S i)%nat with (S (i0 + i)). -reflexivity. -apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; rewrite S_INR; ring. -cut (pred (N - i) = (N - S i)%nat). -intro; rewrite H5; reflexivity. -rewrite pred_of_minus. -apply INR_eq. -repeat rewrite minus_INR. -repeat rewrite S_INR; ring. -apply le_trans with (S (pred (pred N))). -apply le_n_S; assumption. -replace (S (pred (pred N))) with (pred N). -apply le_pred_n. -apply S_pred with 0%nat. -apply lt_S_n. -replace (S (pred N)) with N. -apply lt_le_trans with 2%nat. -apply lt_n_Sn. -assumption. -apply S_pred with 0%nat; assumption. -apply le_trans with (pred (pred N)). -assumption. -apply le_trans with (pred N); apply le_pred_n. -apply (fun p n m:nat => plus_le_reg_l n m p) with i. -rewrite le_plus_minus_r. -replace (i + 1)%nat with (S i). -replace N with (S (pred N)). -apply le_n_S. -apply le_trans with (pred (pred N)). -assumption. -apply le_pred_n. -symmetry in |- *; apply S_pred with 0%nat; assumption. -apply INR_eq; rewrite S_INR; rewrite plus_INR; ring. -apply le_trans with (pred (pred N)). -assumption. -apply le_trans with (pred N); apply le_pred_n. -apply sum_eq; intros. -replace (i + 0)%nat with i; [ reflexivity | trivial ]. -apply lt_S_n. -replace (S (pred N)) with N. -apply lt_le_trans with 2%nat; [ apply lt_n_Sn | assumption ]. -apply S_pred with 0%nat; assumption. -inversion H1. -left; reflexivity. -right; apply le_n_S; assumption. -simpl in |- *. -replace (S (pred N)) with N. -reflexivity. -apply S_pred with 0%nat; assumption. -simpl in |- *. -cut ((N - pred N)%nat = 1%nat). -intro; rewrite H2; reflexivity. -rewrite pred_of_minus. -apply INR_eq; repeat rewrite minus_INR. -ring. -apply lt_le_S; assumption. -rewrite <- pred_of_minus; apply le_pred_n. -simpl in |- *; symmetry in |- *; apply S_pred with 0%nat; assumption. -inversion H. -left; reflexivity. -right; apply lt_le_trans with 1%nat; [ apply lt_n_Sn | exact H1 ]. -Qed.
\ No newline at end of file + sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (N - l)%nat) + (pred (N - k))) (pred N). +Proof. + intros; induction N as [| N HrecN]. + elim (lt_irrefl _ H). + cut (N = 0%nat \/ (0 < N)%nat). + intro; elim H0; intro. + rewrite H1; simpl in |- *; ring. + replace (pred (S N)) with (S (pred N)). + do 5 rewrite tech5. + rewrite Rmult_plus_distr_r; rewrite Rmult_plus_distr_l; rewrite (HrecN H1). + repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l. + replace (pred (S N - S (pred N))) with 0%nat. + rewrite Rmult_plus_distr_l; + replace + (sum_f_R0 (fun l:nat => An (S (l + S (pred N))) * Bn (S N - l)%nat) 0) with + (An (S N) * Bn (S N)). + repeat rewrite <- Rplus_assoc; + do 2 rewrite <- (Rplus_comm (An (S N) * Bn (S N))); + repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l. + rewrite <- minus_n_n; cut (N = 1%nat \/ (2 <= N)%nat). + intro; elim H2; intro. + rewrite H3; simpl in |- *; ring. + replace + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (N - l)%nat) (pred (N - k))) + (pred N)) with + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (pred (N - k)))) (pred (pred N)) + + sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N)). + replace (sum_f_R0 (fun p:nat => An p * Bn (S N - p)%nat) N) with + (sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N) + + An 0%nat * Bn (S N)). + repeat rewrite <- Rplus_assoc; + rewrite <- + (Rplus_comm (sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N))) + ; repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l. + replace + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (S N - l)%nat) + (pred (S N - k))) (pred N)) with + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (N - k))) (pred N) + + Bn (S N) * sum_f_R0 (fun l:nat => An (S l)) (pred N)). + rewrite (decomp_sum An N H1); rewrite Rmult_plus_distr_r; + repeat rewrite <- Rplus_assoc; rewrite <- (Rplus_comm (An 0%nat * Bn (S N))); + repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l. + repeat rewrite <- Rplus_assoc; + rewrite <- + (Rplus_comm (sum_f_R0 (fun i:nat => An (S i)) (pred N) * Bn (S N))) + ; + rewrite <- + (Rplus_comm (Bn (S N) * sum_f_R0 (fun i:nat => An (S i)) (pred N))) + ; rewrite (Rmult_comm (Bn (S N))); repeat rewrite Rplus_assoc; + apply Rplus_eq_compat_l. + replace + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (N - k))) (pred N)) with + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (pred (N - k)))) (pred (pred N)) + + An (S N) * sum_f_R0 (fun l:nat => Bn (S l)) (pred N)). + rewrite (decomp_sum Bn N H1); rewrite Rmult_plus_distr_l. + set + (Z := + sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (pred (N - k)))) (pred (pred N))); + set (Z2 := sum_f_R0 (fun i:nat => Bn (S i)) (pred N)); + ring. + rewrite + (sum_N_predN + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (N - k))) (pred N)). + replace + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (N - k))) (pred (pred N))) with + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (pred (N - k))) + An (S N) * Bn (S k)) ( + pred (pred N))). + rewrite + (sum_plus + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (pred (N - k)))) (fun k:nat => An (S N) * Bn (S k)) + (pred (pred N))). + repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l. + replace (pred (N - pred N)) with 0%nat. + simpl in |- *; rewrite <- minus_n_O. + replace (S (pred N)) with N. + replace (sum_f_R0 (fun k:nat => An (S N) * Bn (S k)) (pred (pred N))) with + (sum_f_R0 (fun k:nat => Bn (S k) * An (S N)) (pred (pred N))). + rewrite <- (scal_sum (fun l:nat => Bn (S l)) (pred (pred N)) (An (S N))); + rewrite (sum_N_predN (fun l:nat => Bn (S l)) (pred N)). + replace (S (pred N)) with N. + ring. + apply S_pred with 0%nat; assumption. + apply lt_pred; apply lt_le_trans with 2%nat; [ apply lt_n_Sn | assumption ]. + apply sum_eq; intros; apply Rmult_comm. + apply S_pred with 0%nat; assumption. + replace (N - pred N)%nat with 1%nat. + reflexivity. + pattern N at 1 in |- *; replace N with (S (pred N)). + rewrite <- minus_Sn_m. + rewrite <- minus_n_n; reflexivity. + apply le_n. + symmetry in |- *; apply S_pred with 0%nat; assumption. + apply sum_eq; intros; + rewrite + (sum_N_predN (fun l:nat => An (S (S (l + i))) * Bn (N - l)%nat) + (pred (N - i))). + replace (S (S (pred (N - i) + i))) with (S N). + replace (N - pred (N - i))%nat with (S i). + reflexivity. + rewrite pred_of_minus; apply INR_eq; repeat rewrite minus_INR. + rewrite S_INR; simpl; ring. + apply le_trans with (pred (pred N)). + assumption. + apply le_trans with (pred N); apply le_pred_n. + apply INR_le; rewrite minus_INR. + apply Rplus_le_reg_l with (INR i - 1). + replace (INR i - 1 + INR 1) with (INR i); [ idtac | simpl; ring ]. + replace (INR i - 1 + (INR N - INR i)) with (INR N - INR 1); + [ idtac | simpl; ring ]. + rewrite <- minus_INR. + apply le_INR; apply le_trans with (pred (pred N)). + assumption. + rewrite <- pred_of_minus; apply le_pred_n. + apply le_trans with 2%nat. + apply le_n_Sn. + assumption. + apply le_trans with (pred (pred N)). + assumption. + apply le_trans with (pred N); apply le_pred_n. + rewrite <- pred_of_minus. + apply le_trans with (pred N). + apply le_S_n. + replace (S (pred N)) with N. + replace (S (pred (N - i))) with (N - i)%nat. + apply (fun p n m:nat => plus_le_reg_l n m p) with i; rewrite le_plus_minus_r. + apply le_plus_r. + apply le_trans with (pred (pred N)); + [ assumption | apply le_trans with (pred N); apply le_pred_n ]. + apply S_pred with 0%nat. + apply plus_lt_reg_l with i; rewrite le_plus_minus_r. + replace (i + 0)%nat with i; [ idtac | ring ]. + apply le_lt_trans with (pred (pred N)); + [ assumption | apply lt_trans with (pred N); apply lt_pred_n_n ]. + apply lt_S_n. + replace (S (pred N)) with N. + apply lt_le_trans with 2%nat. + apply lt_n_Sn. + assumption. + apply S_pred with 0%nat; assumption. + assumption. + apply le_trans with (pred (pred N)). + assumption. + apply le_trans with (pred N); apply le_pred_n. + apply S_pred with 0%nat; assumption. + apply le_pred_n. + apply INR_eq; rewrite pred_of_minus; do 3 rewrite S_INR; rewrite plus_INR; + repeat rewrite minus_INR. + simpl; ring. + apply le_trans with (pred (pred N)). + assumption. + apply le_trans with (pred N); apply le_pred_n. + apply INR_le. + rewrite minus_INR. + apply Rplus_le_reg_l with (INR i - 1). + replace (INR i - 1 + INR 1) with (INR i); [ idtac | simpl; ring ]. + replace (INR i - 1 + (INR N - INR i)) with (INR N - INR 1); + [ idtac | simpl; ring ]. + rewrite <- minus_INR. + apply le_INR. + apply le_trans with (pred (pred N)). + assumption. + rewrite <- pred_of_minus. + apply le_pred_n. + apply le_trans with 2%nat. + apply le_n_Sn. + assumption. + apply le_trans with (pred (pred N)). + assumption. + apply le_trans with (pred N); apply le_pred_n. + apply lt_le_trans with 1%nat. + apply lt_O_Sn. + apply INR_le. + rewrite pred_of_minus. + repeat rewrite minus_INR. + apply Rplus_le_reg_l with (INR i - 1). + replace (INR i - 1 + INR 1) with (INR i); [ idtac | simpl; ring ]. + replace (INR i - 1 + (INR N - INR i - INR 1)) with (INR N - INR 1 - INR 1). + repeat rewrite <- minus_INR. + apply le_INR. + apply le_trans with (pred (pred N)). + assumption. + do 2 rewrite <- pred_of_minus. + apply le_n. + apply (fun p n m:nat => plus_le_reg_l n m p) with 1%nat. + rewrite le_plus_minus_r. + simpl in |- *; assumption. + apply le_trans with 2%nat; [ apply le_n_Sn | assumption ]. + apply le_trans with 2%nat; [ apply le_n_Sn | assumption ]. + simpl; ring. + apply le_trans with (pred (pred N)). + assumption. + apply le_trans with (pred N); apply le_pred_n. + apply (fun p n m:nat => plus_le_reg_l n m p) with i. + rewrite le_plus_minus_r. + replace (i + 1)%nat with (S i). + replace N with (S (pred N)). + apply le_n_S. + apply le_trans with (pred (pred N)). + assumption. + apply le_pred_n. + symmetry in |- *; apply S_pred with 0%nat; assumption. + apply INR_eq; rewrite S_INR; rewrite plus_INR; reflexivity. + apply le_trans with (pred (pred N)). + assumption. + apply le_trans with (pred N); apply le_pred_n. + apply lt_le_trans with 1%nat. + apply lt_O_Sn. + apply le_S_n. + replace (S (pred N)) with N. + assumption. + apply S_pred with 0%nat; assumption. + replace + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (S N - l)%nat) + (pred (S N - k))) (pred N)) with + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (N - k)) + An (S k) * Bn (S N)) (pred N)). + rewrite + (sum_plus + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) + (pred (N - k))) (fun k:nat => An (S k) * Bn (S N))). + apply Rplus_eq_compat_l. + rewrite scal_sum; reflexivity. + apply sum_eq; intros; rewrite Rplus_comm; + rewrite + (decomp_sum (fun l:nat => An (S (l + i)) * Bn (S N - l)%nat) + (pred (S N - i))). + replace (0 + i)%nat with i; [ idtac | ring ]. + rewrite <- minus_n_O; apply Rplus_eq_compat_l. + replace (pred (pred (S N - i))) with (pred (N - i)). + apply sum_eq; intros. + replace (S N - S i0)%nat with (N - i0)%nat; [ idtac | reflexivity ]. + replace (S i0 + i)%nat with (S (i0 + i)). + reflexivity. + apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; rewrite S_INR; simpl; ring. + cut ((N - i)%nat = pred (S N - i)). + intro; rewrite H5; reflexivity. + rewrite pred_of_minus. + apply INR_eq; repeat rewrite minus_INR. + rewrite S_INR; simpl; ring. + apply le_trans with N. + apply le_trans with (pred N). + assumption. + apply le_pred_n. + apply le_n_Sn. + apply (fun p n m:nat => plus_le_reg_l n m p) with i. + rewrite le_plus_minus_r. + replace (i + 1)%nat with (S i). + apply le_n_S. + apply le_trans with (pred N). + assumption. + apply le_pred_n. + apply INR_eq; rewrite S_INR; rewrite plus_INR; simpl; ring. + apply le_trans with N. + apply le_trans with (pred N). + assumption. + apply le_pred_n. + apply le_n_Sn. + apply le_trans with (pred N). + assumption. + apply le_pred_n. + replace (pred (S N - i)) with (S N - S i)%nat. + replace (S N - S i)%nat with (N - i)%nat; [ idtac | reflexivity ]. + apply plus_lt_reg_l with i. + rewrite le_plus_minus_r. + replace (i + 0)%nat with i; [ idtac | ring ]. + apply le_lt_trans with (pred N). + assumption. + apply lt_pred_n_n. + assumption. + apply le_trans with (pred N). + assumption. + apply le_pred_n. + rewrite pred_of_minus. + apply INR_eq; repeat rewrite minus_INR. + repeat rewrite S_INR; simpl; ring. + apply le_trans with N. + apply le_trans with (pred N). + assumption. + apply le_pred_n. + apply le_n_Sn. + apply (fun p n m:nat => plus_le_reg_l n m p) with i. + rewrite le_plus_minus_r. + replace (i + 1)%nat with (S i). + apply le_n_S. + apply le_trans with (pred N). + assumption. + apply le_pred_n. + apply INR_eq; rewrite S_INR; rewrite plus_INR; simpl; ring. + apply le_trans with N. + apply le_trans with (pred N). + assumption. + apply le_pred_n. + apply le_n_Sn. + apply le_n_S. + apply le_trans with (pred N). + assumption. + apply le_pred_n. + rewrite Rplus_comm. + rewrite (decomp_sum (fun p:nat => An p * Bn (S N - p)%nat) N). + rewrite <- minus_n_O. + apply Rplus_eq_compat_l. + apply sum_eq; intros. + reflexivity. + assumption. + rewrite Rplus_comm. + rewrite + (decomp_sum + (fun k:nat => + sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (N - l)%nat) (pred (N - k))) + (pred N)). + rewrite <- minus_n_O. + replace (sum_f_R0 (fun l:nat => An (S (l + 0)) * Bn (N - l)%nat) (pred N)) + with (sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N)). + apply Rplus_eq_compat_l. + apply sum_eq; intros. + replace (pred (N - S i)) with (pred (pred (N - i))). + apply sum_eq; intros. + replace (i0 + S i)%nat with (S (i0 + i)). + reflexivity. + apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; rewrite S_INR; simpl; ring. + cut (pred (N - i) = (N - S i)%nat). + intro; rewrite H5; reflexivity. + rewrite pred_of_minus. + apply INR_eq. + repeat rewrite minus_INR. + repeat rewrite S_INR; simpl; ring. + apply le_trans with (S (pred (pred N))). + apply le_n_S; assumption. + replace (S (pred (pred N))) with (pred N). + apply le_pred_n. + apply S_pred with 0%nat. + apply lt_S_n. + replace (S (pred N)) with N. + apply lt_le_trans with 2%nat. + apply lt_n_Sn. + assumption. + apply S_pred with 0%nat; assumption. + apply le_trans with (pred (pred N)). + assumption. + apply le_trans with (pred N); apply le_pred_n. + apply (fun p n m:nat => plus_le_reg_l n m p) with i. + rewrite le_plus_minus_r. + replace (i + 1)%nat with (S i). + replace N with (S (pred N)). + apply le_n_S. + apply le_trans with (pred (pred N)). + assumption. + apply le_pred_n. + symmetry in |- *; apply S_pred with 0%nat; assumption. + apply INR_eq; rewrite S_INR; rewrite plus_INR; simpl; ring. + apply le_trans with (pred (pred N)). + assumption. + apply le_trans with (pred N); apply le_pred_n. + apply sum_eq; intros. + replace (i + 0)%nat with i; [ reflexivity | trivial ]. + apply lt_S_n. + replace (S (pred N)) with N. + apply lt_le_trans with 2%nat; [ apply lt_n_Sn | assumption ]. + apply S_pred with 0%nat; assumption. + inversion H1. + left; reflexivity. + right; apply le_n_S; assumption. + simpl in |- *. + replace (S (pred N)) with N. + reflexivity. + apply S_pred with 0%nat; assumption. + simpl in |- *. + cut ((N - pred N)%nat = 1%nat). + intro; rewrite H2; reflexivity. + rewrite pred_of_minus. + apply INR_eq; repeat rewrite minus_INR. + simpl; ring. + apply lt_le_S; assumption. + rewrite <- pred_of_minus; apply le_pred_n. + simpl in |- *; symmetry in |- *; apply S_pred with 0%nat; assumption. + inversion H. + left; reflexivity. + right; apply lt_le_trans with 1%nat; [ apply lt_n_Sn | exact H1 ]. +Qed. diff --git a/theories/Reals/Cos_plus.v b/theories/Reals/Cos_plus.v index 558632c5..3719d551 100644 --- a/theories/Reals/Cos_plus.v +++ b/theories/Reals/Cos_plus.v @@ -1,12 +1,12 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) - -(*i $Id: Cos_plus.v 5920 2004-07-16 20:01:26Z herbelin $ i*) + (************************************************************************) + (* v * The Coq Proof Assistant / The Coq Development Team *) + (* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) + (* \VV/ **************************************************************) + (* // * This file is distributed under the terms of the *) + (* * GNU Lesser General Public License Version 2.1 *) + (************************************************************************) + + (*i $Id: Cos_plus.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -19,1043 +19,833 @@ Definition Majxy (x y:R) (n:nat) : R := Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S n) / INR (fact n). Lemma Majxy_cv_R0 : forall x y:R, Un_cv (Majxy x y) 0. -intros. -set (C := Rmax 1 (Rmax (Rabs x) (Rabs y))). -set (C0 := C ^ 4). -cut (0 < C). -intro. -cut (0 < C0). -intro. -assert (H1 := cv_speed_pow_fact C0). -unfold Un_cv in H1; unfold R_dist in H1. -unfold Un_cv in |- *; unfold R_dist in |- *; intros. -cut (0 < eps / C0); - [ intro - | unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; assumption ] ]. -elim (H1 (eps / C0) H3); intros N0 H4. -exists N0; intros. -replace (Majxy x y n) with (C0 ^ S n / INR (fact n)). -simpl in |- *. -apply Rmult_lt_reg_l with (Rabs (/ C0)). -apply Rabs_pos_lt. -apply Rinv_neq_0_compat. -red in |- *; intro; rewrite H6 in H0; elim (Rlt_irrefl _ H0). -rewrite <- Rabs_mult. -unfold Rminus in |- *; rewrite Rmult_plus_distr_l. -rewrite Ropp_0; rewrite Rmult_0_r. -unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_l. -rewrite (Rabs_right (/ C0)). -rewrite <- (Rmult_comm eps). -replace (C0 ^ n * / INR (fact n) + 0) with (C0 ^ n * / INR (fact n) - 0); - [ idtac | ring ]. -unfold Rdiv in H4; apply H4; assumption. -apply Rle_ge; left; apply Rinv_0_lt_compat; assumption. -red in |- *; intro; rewrite H6 in H0; elim (Rlt_irrefl _ H0). -unfold Majxy in |- *. -unfold C0 in |- *. -rewrite pow_mult. -unfold C in |- *; reflexivity. -unfold C0 in |- *; apply pow_lt; assumption. -apply Rlt_le_trans with 1. -apply Rlt_0_1. -unfold C in |- *. -apply RmaxLess1. +Proof. + intros. + set (C := Rmax 1 (Rmax (Rabs x) (Rabs y))). + set (C0 := C ^ 4). + cut (0 < C). + intro. + cut (0 < C0). + intro. + assert (H1 := cv_speed_pow_fact C0). + unfold Un_cv in H1; unfold R_dist in H1. + unfold Un_cv in |- *; unfold R_dist in |- *; intros. + cut (0 < eps / C0); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; assumption ] ]. + elim (H1 (eps / C0) H3); intros N0 H4. + exists N0; intros. + replace (Majxy x y n) with (C0 ^ S n / INR (fact n)). + simpl in |- *. + apply Rmult_lt_reg_l with (Rabs (/ C0)). + apply Rabs_pos_lt. + apply Rinv_neq_0_compat. + red in |- *; intro; rewrite H6 in H0; elim (Rlt_irrefl _ H0). + rewrite <- Rabs_mult. + unfold Rminus in |- *; rewrite Rmult_plus_distr_l. + rewrite Ropp_0; rewrite Rmult_0_r. + unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_l. + rewrite (Rabs_right (/ C0)). + rewrite <- (Rmult_comm eps). + replace (C0 ^ n * / INR (fact n) + 0) with (C0 ^ n * / INR (fact n) - 0); + [ idtac | ring ]. + unfold Rdiv in H4; apply H4; assumption. + apply Rle_ge; left; apply Rinv_0_lt_compat; assumption. + red in |- *; intro; rewrite H6 in H0; elim (Rlt_irrefl _ H0). + unfold Majxy in |- *. + unfold C0 in |- *. + rewrite pow_mult. + unfold C in |- *; reflexivity. + unfold C0 in |- *; apply pow_lt; assumption. + apply Rlt_le_trans with 1. + apply Rlt_0_1. + unfold C in |- *. + apply RmaxLess1. Qed. Lemma reste1_maj : - forall (x y:R) (N:nat), - (0 < N)%nat -> Rabs (Reste1 x y N) <= Majxy x y (pred N). -intros. -set (C := Rmax 1 (Rmax (Rabs x) (Rabs y))). -unfold Reste1 in |- *. -apply Rle_trans with - (sum_f_R0 - (fun k:nat => - Rabs - (sum_f_R0 - (fun l:nat => - (-1) ^ S (l + k) / INR (fact (2 * S (l + k))) * - x ^ (2 * S (l + k)) * - ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) * - y ^ (2 * (N - l))) (pred (N - k)))) ( - pred N)). -apply - (Rsum_abs - (fun k:nat => - sum_f_R0 - (fun l:nat => + forall (x y:R) (N:nat), + (0 < N)%nat -> Rabs (Reste1 x y N) <= Majxy x y (pred N). +Proof. + intros. + set (C := Rmax 1 (Rmax (Rabs x) (Rabs y))). + unfold Reste1 in |- *. + apply Rle_trans with + (sum_f_R0 + (fun k:nat => + Rabs + (sum_f_R0 + (fun l:nat => (-1) ^ S (l + k) / INR (fact (2 * S (l + k))) * - x ^ (2 * S (l + k)) * ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) * - y ^ (2 * (N - l))) (pred (N - k))) (pred N)). -apply Rle_trans with - (sum_f_R0 - (fun k:nat => - sum_f_R0 - (fun l:nat => - Rabs - ((-1) ^ S (l + k) / INR (fact (2 * S (l + k))) * - x ^ (2 * S (l + k)) * - ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) * - y ^ (2 * (N - l)))) (pred (N - k))) ( - pred N)). -apply sum_Rle. -intros. -apply - (Rsum_abs - (fun l:nat => - (-1) ^ S (l + n) / INR (fact (2 * S (l + n))) * x ^ (2 * S (l + n)) * - ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) * - y ^ (2 * (N - l))) (pred (N - n))). -apply Rle_trans with - (sum_f_R0 - (fun k:nat => - sum_f_R0 - (fun l:nat => - / INR (fact (2 * S (l + k)) * fact (2 * (N - l))) * - C ^ (2 * S (N + k))) (pred (N - k))) (pred N)). -apply sum_Rle; intros. -apply sum_Rle; intros. -unfold Rdiv in |- *; repeat rewrite Rabs_mult. -do 2 rewrite pow_1_abs. -do 2 rewrite Rmult_1_l. -rewrite (Rabs_right (/ INR (fact (2 * S (n0 + n))))). -rewrite (Rabs_right (/ INR (fact (2 * (N - n0))))). -rewrite mult_INR. -rewrite Rinv_mult_distr. -repeat rewrite Rmult_assoc. -apply Rmult_le_compat_l. -left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. -rewrite <- Rmult_assoc. -rewrite <- (Rmult_comm (/ INR (fact (2 * (N - n0))))). -rewrite Rmult_assoc. -apply Rmult_le_compat_l. -left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. -do 2 rewrite <- RPow_abs. -apply Rle_trans with (Rabs x ^ (2 * S (n0 + n)) * C ^ (2 * (N - n0))). -apply Rmult_le_compat_l. -apply pow_le; apply Rabs_pos. -apply pow_incr. -split. -apply Rabs_pos. -unfold C in |- *. -apply Rle_trans with (Rmax (Rabs x) (Rabs y)); apply RmaxLess2. -apply Rle_trans with (C ^ (2 * S (n0 + n)) * C ^ (2 * (N - n0))). -do 2 rewrite <- (Rmult_comm (C ^ (2 * (N - n0)))). -apply Rmult_le_compat_l. -apply pow_le. -apply Rle_trans with 1. -left; apply Rlt_0_1. -unfold C in |- *; apply RmaxLess1. -apply pow_incr. -split. -apply Rabs_pos. -unfold C in |- *; apply Rle_trans with (Rmax (Rabs x) (Rabs y)). -apply RmaxLess1. -apply RmaxLess2. -right. -replace (2 * S (N + n))%nat with (2 * (N - n0) + 2 * S (n0 + n))%nat. -rewrite pow_add. -apply Rmult_comm. -apply INR_eq; rewrite plus_INR; do 3 rewrite mult_INR. -rewrite minus_INR. -repeat rewrite S_INR; do 2 rewrite plus_INR; ring. -apply le_trans with (pred (N - n)). -exact H1. -apply le_S_n. -replace (S (pred (N - n))) with (N - n)%nat. -apply le_trans with N. -apply (fun p n m:nat => plus_le_reg_l n m p) with n. -rewrite <- le_plus_minus. -apply le_plus_r. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply le_n_Sn. -apply S_pred with 0%nat. -apply plus_lt_reg_l with n. -rewrite <- le_plus_minus. -replace (n + 0)%nat with n; [ idtac | ring ]. -apply le_lt_trans with (pred N). -assumption. -apply lt_pred_n_n; assumption. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. -apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. -apply Rle_trans with - (sum_f_R0 - (fun k:nat => - sum_f_R0 - (fun l:nat => - / INR (fact (2 * S (l + k)) * fact (2 * (N - l))) * C ^ (4 * N)) - (pred (N - k))) (pred N)). -apply sum_Rle; intros. -apply sum_Rle; intros. -apply Rmult_le_compat_l. -left; apply Rinv_0_lt_compat. -rewrite mult_INR; apply Rmult_lt_0_compat; apply INR_fact_lt_0. -apply Rle_pow. -unfold C in |- *; apply RmaxLess1. -replace (4 * N)%nat with (2 * (2 * N))%nat; [ idtac | ring ]. -apply (fun m n p:nat => mult_le_compat_l p n m). -replace (2 * N)%nat with (S (N + pred N)). -apply le_n_S. -apply plus_le_compat_l; assumption. -rewrite pred_of_minus. -apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; - rewrite minus_INR. -repeat rewrite S_INR; ring. -apply lt_le_S; assumption. -apply Rle_trans with - (sum_f_R0 - (fun k:nat => - sum_f_R0 (fun l:nat => C ^ (4 * N) * Rsqr (/ INR (fact (S (N + k))))) - (pred (N - k))) (pred N)). -apply sum_Rle; intros. -apply sum_Rle; intros. -rewrite <- (Rmult_comm (C ^ (4 * N))). -apply Rmult_le_compat_l. -apply pow_le. -left; apply Rlt_le_trans with 1. -apply Rlt_0_1. -unfold C in |- *; apply RmaxLess1. -replace (/ INR (fact (2 * S (n0 + n)) * fact (2 * (N - n0)))) with - (Binomial.C (2 * S (N + n)) (2 * S (n0 + n)) / INR (fact (2 * S (N + n)))). -apply Rle_trans with - (Binomial.C (2 * S (N + n)) (S (N + n)) / INR (fact (2 * S (N + n)))). -unfold Rdiv in |- *; - do 2 rewrite <- (Rmult_comm (/ INR (fact (2 * S (N + n))))). -apply Rmult_le_compat_l. -left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. -apply C_maj. -apply (fun m n p:nat => mult_le_compat_l p n m). -apply le_n_S. -apply plus_le_compat_r. -apply le_trans with (pred (N - n)). -assumption. -apply le_S_n. -replace (S (pred (N - n))) with (N - n)%nat. -apply le_trans with N. -apply (fun p n m:nat => plus_le_reg_l n m p) with n. -rewrite <- le_plus_minus. -apply le_plus_r. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply le_n_Sn. -apply S_pred with 0%nat. -apply plus_lt_reg_l with n. -rewrite <- le_plus_minus. -replace (n + 0)%nat with n; [ idtac | ring ]. -apply le_lt_trans with (pred N). -assumption. -apply lt_pred_n_n; assumption. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -right. -unfold Rdiv in |- *; rewrite Rmult_comm. -unfold Binomial.C in |- *. -unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_l. -replace (2 * S (N + n) - S (N + n))%nat with (S (N + n)). -rewrite Rinv_mult_distr. -unfold Rsqr in |- *; reflexivity. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -apply INR_eq; rewrite S_INR; rewrite minus_INR. -rewrite mult_INR; repeat rewrite S_INR; rewrite plus_INR; ring. -apply le_n_2n. -apply INR_fact_neq_0. -unfold Rdiv in |- *; rewrite Rmult_comm. -unfold Binomial.C in |- *. -unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_l. -replace (2 * S (N + n) - 2 * S (n0 + n))%nat with (2 * (N - n0))%nat. -rewrite mult_INR. -reflexivity. -apply INR_eq; rewrite minus_INR. -do 3 rewrite mult_INR; repeat rewrite S_INR; do 2 rewrite plus_INR; - rewrite minus_INR. -ring. -apply le_trans with (pred (N - n)). -assumption. -apply le_S_n. -replace (S (pred (N - n))) with (N - n)%nat. -apply le_trans with N. -apply (fun p n m:nat => plus_le_reg_l n m p) with n. -rewrite <- le_plus_minus. -apply le_plus_r. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply le_n_Sn. -apply S_pred with 0%nat. -apply plus_lt_reg_l with n. -rewrite <- le_plus_minus. -replace (n + 0)%nat with n; [ idtac | ring ]. -apply le_lt_trans with (pred N). -assumption. -apply lt_pred_n_n; assumption. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply (fun m n p:nat => mult_le_compat_l p n m). -apply le_n_S. -apply plus_le_compat_r. -apply le_trans with (pred (N - n)). -assumption. -apply le_S_n. -replace (S (pred (N - n))) with (N - n)%nat. -apply le_trans with N. -apply (fun p n m:nat => plus_le_reg_l n m p) with n. -rewrite <- le_plus_minus. -apply le_plus_r. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply le_n_Sn. -apply S_pred with 0%nat. -apply plus_lt_reg_l with n. -rewrite <- le_plus_minus. -replace (n + 0)%nat with n; [ idtac | ring ]. -apply le_lt_trans with (pred N). -assumption. -apply lt_pred_n_n; assumption. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply INR_fact_neq_0. -apply Rle_trans with - (sum_f_R0 (fun k:nat => INR N / INR (fact (S N)) * C ^ (4 * N)) (pred N)). -apply sum_Rle; intros. -rewrite <- - (scal_sum (fun _:nat => C ^ (4 * N)) (pred (N - n)) - (Rsqr (/ INR (fact (S (N + n)))))). -rewrite sum_cte. -rewrite <- Rmult_assoc. -do 2 rewrite <- (Rmult_comm (C ^ (4 * N))). -rewrite Rmult_assoc. -apply Rmult_le_compat_l. -apply pow_le. -left; apply Rlt_le_trans with 1. -apply Rlt_0_1. -unfold C in |- *; apply RmaxLess1. -apply Rle_trans with (Rsqr (/ INR (fact (S (N + n)))) * INR N). -apply Rmult_le_compat_l. -apply Rle_0_sqr. -replace (S (pred (N - n))) with (N - n)%nat. -apply le_INR. -apply (fun p n m:nat => plus_le_reg_l n m p) with n. -rewrite <- le_plus_minus. -apply le_plus_r. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply S_pred with 0%nat. -apply plus_lt_reg_l with n. -rewrite <- le_plus_minus. -replace (n + 0)%nat with n; [ idtac | ring ]. -apply le_lt_trans with (pred N). -assumption. -apply lt_pred_n_n; assumption. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -rewrite Rmult_comm; unfold Rdiv in |- *; apply Rmult_le_compat_l. -apply pos_INR. -apply Rle_trans with (/ INR (fact (S (N + n)))). -pattern (/ INR (fact (S (N + n)))) at 2 in |- *; rewrite <- Rmult_1_r. -unfold Rsqr in |- *. -apply Rmult_le_compat_l. -left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. -apply Rmult_le_reg_l with (INR (fact (S (N + n)))). -apply INR_fact_lt_0. -rewrite <- Rinv_r_sym. -rewrite Rmult_1_r. -replace 1 with (INR 1). -apply le_INR. -apply lt_le_S. -apply INR_lt; apply INR_fact_lt_0. -reflexivity. -apply INR_fact_neq_0. -apply Rmult_le_reg_l with (INR (fact (S (N + n)))). -apply INR_fact_lt_0. -rewrite <- Rinv_r_sym. -apply Rmult_le_reg_l with (INR (fact (S N))). -apply INR_fact_lt_0. -rewrite Rmult_1_r. -rewrite (Rmult_comm (INR (fact (S N)))). -rewrite Rmult_assoc. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_r. -apply le_INR. -apply fact_le. -apply le_n_S. -apply le_plus_l. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -rewrite sum_cte. -apply Rle_trans with (C ^ (4 * N) / INR (fact (pred N))). -rewrite <- (Rmult_comm (C ^ (4 * N))). -unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l. -apply pow_le. -left; apply Rlt_le_trans with 1. -apply Rlt_0_1. -unfold C in |- *; apply RmaxLess1. -cut (S (pred N) = N). -intro; rewrite H0. -pattern N at 2 in |- *; rewrite <- H0. -do 2 rewrite fact_simpl. -rewrite H0. -repeat rewrite mult_INR. -repeat rewrite Rinv_mult_distr. -rewrite (Rmult_comm (/ INR (S N))). -repeat rewrite <- Rmult_assoc. -rewrite <- Rinv_r_sym. -rewrite Rmult_1_l. -pattern (/ INR (fact (pred N))) at 2 in |- *; rewrite <- Rmult_1_r. -rewrite Rmult_assoc. -apply Rmult_le_compat_l. -left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. -apply Rmult_le_reg_l with (INR (S N)). -apply lt_INR_0; apply lt_O_Sn. -rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. -rewrite Rmult_1_r; rewrite Rmult_1_l. -apply le_INR; apply le_n_Sn. -apply not_O_INR; discriminate. -apply not_O_INR. -red in |- *; intro; rewrite H1 in H; elim (lt_irrefl _ H). -apply not_O_INR. -red in |- *; intro; rewrite H1 in H; elim (lt_irrefl _ H). -apply INR_fact_neq_0. -apply not_O_INR; discriminate. -apply prod_neq_R0. -apply not_O_INR. -red in |- *; intro; rewrite H1 in H; elim (lt_irrefl _ H). -apply INR_fact_neq_0. -symmetry in |- *; apply S_pred with 0%nat; assumption. -right. -unfold Majxy in |- *. -unfold C in |- *. -replace (S (pred N)) with N. -reflexivity. -apply S_pred with 0%nat; assumption. + x ^ (2 * S (l + k)) * + ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) * + y ^ (2 * (N - l))) (pred (N - k)))) ( + pred N)). + apply + (Rsum_abs + (fun k:nat => + sum_f_R0 + (fun l:nat => + (-1) ^ S (l + k) / INR (fact (2 * S (l + k))) * + x ^ (2 * S (l + k)) * ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) * + y ^ (2 * (N - l))) (pred (N - k))) (pred N)). + apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + Rabs + ((-1) ^ S (l + k) / INR (fact (2 * S (l + k))) * + x ^ (2 * S (l + k)) * + ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) * + y ^ (2 * (N - l)))) (pred (N - k))) ( + pred N)). + apply sum_Rle. + intros. + apply + (Rsum_abs + (fun l:nat => + (-1) ^ S (l + n) / INR (fact (2 * S (l + n))) * x ^ (2 * S (l + n)) * + ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) * + y ^ (2 * (N - l))) (pred (N - n))). + apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + / INR (fact (2 * S (l + k)) * fact (2 * (N - l))) * + C ^ (2 * S (N + k))) (pred (N - k))) (pred N)). + apply sum_Rle; intros. + apply sum_Rle; intros. + unfold Rdiv in |- *; repeat rewrite Rabs_mult. + do 2 rewrite pow_1_abs. + do 2 rewrite Rmult_1_l. + rewrite (Rabs_right (/ INR (fact (2 * S (n0 + n))))). + rewrite (Rabs_right (/ INR (fact (2 * (N - n0))))). + rewrite mult_INR. + rewrite Rinv_mult_distr. + repeat rewrite Rmult_assoc. + apply Rmult_le_compat_l. + left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. + rewrite <- Rmult_assoc. + rewrite <- (Rmult_comm (/ INR (fact (2 * (N - n0))))). + rewrite Rmult_assoc. + apply Rmult_le_compat_l. + left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. + do 2 rewrite <- RPow_abs. + apply Rle_trans with (Rabs x ^ (2 * S (n0 + n)) * C ^ (2 * (N - n0))). + apply Rmult_le_compat_l. + apply pow_le; apply Rabs_pos. + apply pow_incr. + split. + apply Rabs_pos. + unfold C in |- *. + apply Rle_trans with (Rmax (Rabs x) (Rabs y)); apply RmaxLess2. + apply Rle_trans with (C ^ (2 * S (n0 + n)) * C ^ (2 * (N - n0))). + do 2 rewrite <- (Rmult_comm (C ^ (2 * (N - n0)))). + apply Rmult_le_compat_l. + apply pow_le. + apply Rle_trans with 1. + left; apply Rlt_0_1. + unfold C in |- *; apply RmaxLess1. + apply pow_incr. + split. + apply Rabs_pos. + unfold C in |- *; apply Rle_trans with (Rmax (Rabs x) (Rabs y)). + apply RmaxLess1. + apply RmaxLess2. + right. + replace (2 * S (N + n))%nat with (2 * (N - n0) + 2 * S (n0 + n))%nat. + rewrite pow_add. + apply Rmult_comm. + apply INR_eq; rewrite plus_INR; do 3 rewrite mult_INR. + rewrite minus_INR. + repeat rewrite S_INR; do 2 rewrite plus_INR; ring. + apply le_trans with (pred (N - n)). + exact H1. + apply le_S_n. + replace (S (pred (N - n))) with (N - n)%nat. + apply le_trans with N. + apply (fun p n m:nat => plus_le_reg_l n m p) with n. + rewrite <- le_plus_minus. + apply le_plus_r. + apply le_trans with (pred N). + assumption. + apply le_pred_n. + apply le_n_Sn. + apply S_pred with 0%nat. + apply plus_lt_reg_l with n. + rewrite <- le_plus_minus. + replace (n + 0)%nat with n; [ idtac | ring ]. + apply le_lt_trans with (pred N). + assumption. + apply lt_pred_n_n; assumption. + apply le_trans with (pred N). + assumption. + apply le_pred_n. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. + apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. + apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + / INR (fact (2 * S (l + k)) * fact (2 * (N - l))) * C ^ (4 * N)) + (pred (N - k))) (pred N)). + apply sum_Rle; intros. + apply sum_Rle; intros. + apply Rmult_le_compat_l. + left; apply Rinv_0_lt_compat. + rewrite mult_INR; apply Rmult_lt_0_compat; apply INR_fact_lt_0. + apply Rle_pow. + unfold C in |- *; apply RmaxLess1. + replace (4 * N)%nat with (2 * (2 * N))%nat; [ idtac | ring ]. + apply (fun m n p:nat => mult_le_compat_l p n m). + replace (2 * N)%nat with (S (N + pred N)). + apply le_n_S. + apply plus_le_compat_l; assumption. + rewrite pred_of_minus. + omega. + apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => C ^ (4 * N) * Rsqr (/ INR (fact (S (N + k))))) + (pred (N - k))) (pred N)). + apply sum_Rle; intros. + apply sum_Rle; intros. + rewrite <- (Rmult_comm (C ^ (4 * N))). + apply Rmult_le_compat_l. + apply pow_le. + left; apply Rlt_le_trans with 1. + apply Rlt_0_1. + unfold C in |- *; apply RmaxLess1. + replace (/ INR (fact (2 * S (n0 + n)) * fact (2 * (N - n0)))) with + (Binomial.C (2 * S (N + n)) (2 * S (n0 + n)) / INR (fact (2 * S (N + n)))). + apply Rle_trans with + (Binomial.C (2 * S (N + n)) (S (N + n)) / INR (fact (2 * S (N + n)))). + unfold Rdiv in |- *; + do 2 rewrite <- (Rmult_comm (/ INR (fact (2 * S (N + n))))). + apply Rmult_le_compat_l. + left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. + apply C_maj. + omega. + right. + unfold Rdiv in |- *; rewrite Rmult_comm. + unfold Binomial.C in |- *. + unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_l. + replace (2 * S (N + n) - S (N + n))%nat with (S (N + n)). + rewrite Rinv_mult_distr. + unfold Rsqr in |- *; reflexivity. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + omega. + apply INR_fact_neq_0. + unfold Rdiv in |- *; rewrite Rmult_comm. + unfold Binomial.C in |- *. + unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_l. + replace (2 * S (N + n) - 2 * S (n0 + n))%nat with (2 * (N - n0))%nat. + rewrite mult_INR. + reflexivity. + omega. + apply INR_fact_neq_0. + apply Rle_trans with + (sum_f_R0 (fun k:nat => INR N / INR (fact (S N)) * C ^ (4 * N)) (pred N)). + apply sum_Rle; intros. + rewrite <- + (scal_sum (fun _:nat => C ^ (4 * N)) (pred (N - n)) + (Rsqr (/ INR (fact (S (N + n)))))). + rewrite sum_cte. + rewrite <- Rmult_assoc. + do 2 rewrite <- (Rmult_comm (C ^ (4 * N))). + rewrite Rmult_assoc. + apply Rmult_le_compat_l. + apply pow_le. + left; apply Rlt_le_trans with 1. + apply Rlt_0_1. + unfold C in |- *; apply RmaxLess1. + apply Rle_trans with (Rsqr (/ INR (fact (S (N + n)))) * INR N). + apply Rmult_le_compat_l. + apply Rle_0_sqr. + apply le_INR. + omega. + rewrite Rmult_comm; unfold Rdiv in |- *; apply Rmult_le_compat_l. + apply pos_INR. + apply Rle_trans with (/ INR (fact (S (N + n)))). + pattern (/ INR (fact (S (N + n)))) at 2 in |- *; rewrite <- Rmult_1_r. + unfold Rsqr in |- *. + apply Rmult_le_compat_l. + left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. + apply Rmult_le_reg_l with (INR (fact (S (N + n)))). + apply INR_fact_lt_0. + rewrite <- Rinv_r_sym. + rewrite Rmult_1_r. + replace 1 with (INR 1). + apply le_INR. + apply lt_le_S. + apply INR_lt; apply INR_fact_lt_0. + reflexivity. + apply INR_fact_neq_0. + apply Rmult_le_reg_l with (INR (fact (S (N + n)))). + apply INR_fact_lt_0. + rewrite <- Rinv_r_sym. + apply Rmult_le_reg_l with (INR (fact (S N))). + apply INR_fact_lt_0. + rewrite Rmult_1_r. + rewrite (Rmult_comm (INR (fact (S N)))). + rewrite Rmult_assoc. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_r. + apply le_INR. + apply fact_le. + apply le_n_S. + apply le_plus_l. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + rewrite sum_cte. + apply Rle_trans with (C ^ (4 * N) / INR (fact (pred N))). + rewrite <- (Rmult_comm (C ^ (4 * N))). + unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l. + apply pow_le. + left; apply Rlt_le_trans with 1. + apply Rlt_0_1. + unfold C in |- *; apply RmaxLess1. + cut (S (pred N) = N). + intro; rewrite H0. + pattern N at 2 in |- *; rewrite <- H0. + do 2 rewrite fact_simpl. + rewrite H0. + repeat rewrite mult_INR. + repeat rewrite Rinv_mult_distr. + rewrite (Rmult_comm (/ INR (S N))). + repeat rewrite <- Rmult_assoc. + rewrite <- Rinv_r_sym. + rewrite Rmult_1_l. + pattern (/ INR (fact (pred N))) at 2 in |- *; rewrite <- Rmult_1_r. + rewrite Rmult_assoc. + apply Rmult_le_compat_l. + left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. + apply Rmult_le_reg_l with (INR (S N)). + apply lt_INR_0; apply lt_O_Sn. + rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. + rewrite Rmult_1_r; rewrite Rmult_1_l. + apply le_INR; apply le_n_Sn. + apply not_O_INR; discriminate. + apply not_O_INR. + red in |- *; intro; rewrite H1 in H; elim (lt_irrefl _ H). + apply not_O_INR. + red in |- *; intro; rewrite H1 in H; elim (lt_irrefl _ H). + apply INR_fact_neq_0. + apply not_O_INR; discriminate. + apply prod_neq_R0. + apply not_O_INR. + red in |- *; intro; rewrite H1 in H; elim (lt_irrefl _ H). + apply INR_fact_neq_0. + symmetry in |- *; apply S_pred with 0%nat; assumption. + right. + unfold Majxy in |- *. + unfold C in |- *. + replace (S (pred N)) with N. + reflexivity. + apply S_pred with 0%nat; assumption. Qed. Lemma reste2_maj : - forall (x y:R) (N:nat), (0 < N)%nat -> Rabs (Reste2 x y N) <= Majxy x y N. -intros. -set (C := Rmax 1 (Rmax (Rabs x) (Rabs y))). -unfold Reste2 in |- *. -apply Rle_trans with - (sum_f_R0 - (fun k:nat => - Rabs - (sum_f_R0 - (fun l:nat => - (-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) * - x ^ (2 * S (l + k) + 1) * - ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) * - y ^ (2 * (N - l) + 1)) (pred (N - k)))) ( - pred N)). -apply - (Rsum_abs - (fun k:nat => - sum_f_R0 - (fun l:nat => + forall (x y:R) (N:nat), (0 < N)%nat -> Rabs (Reste2 x y N) <= Majxy x y N. +Proof. + intros. + set (C := Rmax 1 (Rmax (Rabs x) (Rabs y))). + unfold Reste2 in |- *. + apply Rle_trans with + (sum_f_R0 + (fun k:nat => + Rabs + (sum_f_R0 + (fun l:nat => (-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) * x ^ (2 * S (l + k) + 1) * ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) * - y ^ (2 * (N - l) + 1)) (pred (N - k))) ( - pred N)). -apply Rle_trans with - (sum_f_R0 - (fun k:nat => - sum_f_R0 - (fun l:nat => - Rabs - ((-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) * - x ^ (2 * S (l + k) + 1) * - ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) * - y ^ (2 * (N - l) + 1))) (pred (N - k))) ( - pred N)). -apply sum_Rle. -intros. -apply - (Rsum_abs - (fun l:nat => - (-1) ^ S (l + n) / INR (fact (2 * S (l + n) + 1)) * - x ^ (2 * S (l + n) + 1) * - ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) * - y ^ (2 * (N - l) + 1)) (pred (N - n))). -apply Rle_trans with - (sum_f_R0 - (fun k:nat => - sum_f_R0 - (fun l:nat => - / INR (fact (2 * S (l + k) + 1) * fact (2 * (N - l) + 1)) * - C ^ (2 * S (S (N + k)))) (pred (N - k))) ( - pred N)). -apply sum_Rle; intros. -apply sum_Rle; intros. -unfold Rdiv in |- *; repeat rewrite Rabs_mult. -do 2 rewrite pow_1_abs. -do 2 rewrite Rmult_1_l. -rewrite (Rabs_right (/ INR (fact (2 * S (n0 + n) + 1)))). -rewrite (Rabs_right (/ INR (fact (2 * (N - n0) + 1)))). -rewrite mult_INR. -rewrite Rinv_mult_distr. -repeat rewrite Rmult_assoc. -apply Rmult_le_compat_l. -left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. -rewrite <- Rmult_assoc. -rewrite <- (Rmult_comm (/ INR (fact (2 * (N - n0) + 1)))). -rewrite Rmult_assoc. -apply Rmult_le_compat_l. -left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. -do 2 rewrite <- RPow_abs. -apply Rle_trans with (Rabs x ^ (2 * S (n0 + n) + 1) * C ^ (2 * (N - n0) + 1)). -apply Rmult_le_compat_l. -apply pow_le; apply Rabs_pos. -apply pow_incr. -split. -apply Rabs_pos. -unfold C in |- *. -apply Rle_trans with (Rmax (Rabs x) (Rabs y)); apply RmaxLess2. -apply Rle_trans with (C ^ (2 * S (n0 + n) + 1) * C ^ (2 * (N - n0) + 1)). -do 2 rewrite <- (Rmult_comm (C ^ (2 * (N - n0) + 1))). -apply Rmult_le_compat_l. -apply pow_le. -apply Rle_trans with 1. -left; apply Rlt_0_1. -unfold C in |- *; apply RmaxLess1. -apply pow_incr. -split. -apply Rabs_pos. -unfold C in |- *; apply Rle_trans with (Rmax (Rabs x) (Rabs y)). -apply RmaxLess1. -apply RmaxLess2. -right. -replace (2 * S (S (N + n)))%nat with - (2 * (N - n0) + 1 + (2 * S (n0 + n) + 1))%nat. -repeat rewrite pow_add. -ring. -apply INR_eq; repeat rewrite plus_INR; do 3 rewrite mult_INR. -rewrite minus_INR. -repeat rewrite S_INR; do 2 rewrite plus_INR; ring. -apply le_trans with (pred (N - n)). -exact H1. -apply le_S_n. -replace (S (pred (N - n))) with (N - n)%nat. -apply le_trans with N. -apply (fun p n m:nat => plus_le_reg_l n m p) with n. -rewrite <- le_plus_minus. -apply le_plus_r. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply le_n_Sn. -apply S_pred with 0%nat. -apply plus_lt_reg_l with n. -rewrite <- le_plus_minus. -replace (n + 0)%nat with n; [ idtac | ring ]. -apply le_lt_trans with (pred N). -assumption. -apply lt_pred_n_n; assumption. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -apply Rle_ge; left; apply Rinv_0_lt_compat. -apply INR_fact_lt_0. -apply Rle_ge; left; apply Rinv_0_lt_compat. -apply INR_fact_lt_0. -apply Rle_trans with - (sum_f_R0 - (fun k:nat => - sum_f_R0 - (fun l:nat => - / INR (fact (2 * S (l + k) + 1) * fact (2 * (N - l) + 1)) * - C ^ (4 * S N)) (pred (N - k))) (pred N)). -apply sum_Rle; intros. -apply sum_Rle; intros. -apply Rmult_le_compat_l. -left; apply Rinv_0_lt_compat. -rewrite mult_INR; apply Rmult_lt_0_compat; apply INR_fact_lt_0. -apply Rle_pow. -unfold C in |- *; apply RmaxLess1. -replace (4 * S N)%nat with (2 * (2 * S N))%nat; [ idtac | ring ]. -apply (fun m n p:nat => mult_le_compat_l p n m). -replace (2 * S N)%nat with (S (S (N + N))). -repeat apply le_n_S. -apply plus_le_compat_l. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply INR_eq; do 2 rewrite S_INR; rewrite plus_INR; rewrite mult_INR. -repeat rewrite S_INR; ring. -apply Rle_trans with - (sum_f_R0 - (fun k:nat => - sum_f_R0 - (fun l:nat => C ^ (4 * S N) * Rsqr (/ INR (fact (S (S (N + k)))))) - (pred (N - k))) (pred N)). -apply sum_Rle; intros. -apply sum_Rle; intros. -rewrite <- (Rmult_comm (C ^ (4 * S N))). -apply Rmult_le_compat_l. -apply pow_le. -left; apply Rlt_le_trans with 1. -apply Rlt_0_1. -unfold C in |- *; apply RmaxLess1. -replace (/ INR (fact (2 * S (n0 + n) + 1) * fact (2 * (N - n0) + 1))) with - (Binomial.C (2 * S (S (N + n))) (2 * S (n0 + n) + 1) / - INR (fact (2 * S (S (N + n))))). -apply Rle_trans with - (Binomial.C (2 * S (S (N + n))) (S (S (N + n))) / - INR (fact (2 * S (S (N + n))))). -unfold Rdiv in |- *; - do 2 rewrite <- (Rmult_comm (/ INR (fact (2 * S (S (N + n)))))). -apply Rmult_le_compat_l. -left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. -apply C_maj. -apply le_trans with (2 * S (S (n0 + n)))%nat. -replace (2 * S (S (n0 + n)))%nat with (S (2 * S (n0 + n) + 1)). -apply le_n_Sn. -apply INR_eq; rewrite S_INR; rewrite plus_INR; do 2 rewrite mult_INR; - repeat rewrite S_INR; rewrite plus_INR; ring. -apply (fun m n p:nat => mult_le_compat_l p n m). -repeat apply le_n_S. -apply plus_le_compat_r. -apply le_trans with (pred (N - n)). -assumption. -apply le_S_n. -replace (S (pred (N - n))) with (N - n)%nat. -apply le_trans with N. -apply (fun p n m:nat => plus_le_reg_l n m p) with n. -rewrite <- le_plus_minus. -apply le_plus_r. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply le_n_Sn. -apply S_pred with 0%nat. -apply plus_lt_reg_l with n. -rewrite <- le_plus_minus. -replace (n + 0)%nat with n; [ idtac | ring ]. -apply le_lt_trans with (pred N). -assumption. -apply lt_pred_n_n; assumption. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -right. -unfold Rdiv in |- *; rewrite Rmult_comm. -unfold Binomial.C in |- *. -unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_l. -replace (2 * S (S (N + n)) - S (S (N + n)))%nat with (S (S (N + n))). -rewrite Rinv_mult_distr. -unfold Rsqr in |- *; reflexivity. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -apply INR_eq; do 2 rewrite S_INR; rewrite minus_INR. -rewrite mult_INR; repeat rewrite S_INR; rewrite plus_INR; ring. -apply le_n_2n. -apply INR_fact_neq_0. -unfold Rdiv in |- *; rewrite Rmult_comm. -unfold Binomial.C in |- *. -unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_l. -replace (2 * S (S (N + n)) - (2 * S (n0 + n) + 1))%nat with - (2 * (N - n0) + 1)%nat. -rewrite mult_INR. -reflexivity. -apply INR_eq; rewrite minus_INR. -do 2 rewrite plus_INR; do 3 rewrite mult_INR; repeat rewrite S_INR; - do 2 rewrite plus_INR; rewrite minus_INR. -ring. -apply le_trans with (pred (N - n)). -assumption. -apply le_S_n. -replace (S (pred (N - n))) with (N - n)%nat. -apply le_trans with N. -apply (fun p n m:nat => plus_le_reg_l n m p) with n. -rewrite <- le_plus_minus. -apply le_plus_r. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply le_n_Sn. -apply S_pred with 0%nat. -apply plus_lt_reg_l with n. -rewrite <- le_plus_minus. -replace (n + 0)%nat with n; [ idtac | ring ]. -apply le_lt_trans with (pred N). -assumption. -apply lt_pred_n_n; assumption. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply le_trans with (2 * S (S (n0 + n)))%nat. -replace (2 * S (S (n0 + n)))%nat with (S (2 * S (n0 + n) + 1)). -apply le_n_Sn. -apply INR_eq; rewrite S_INR; rewrite plus_INR; do 2 rewrite mult_INR; - repeat rewrite S_INR; rewrite plus_INR; ring. -apply (fun m n p:nat => mult_le_compat_l p n m). -repeat apply le_n_S. -apply plus_le_compat_r. -apply le_trans with (pred (N - n)). -assumption. -apply le_S_n. -replace (S (pred (N - n))) with (N - n)%nat. -apply le_trans with N. -apply (fun p n m:nat => plus_le_reg_l n m p) with n. -rewrite <- le_plus_minus. -apply le_plus_r. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply le_n_Sn. -apply S_pred with 0%nat. -apply plus_lt_reg_l with n. -rewrite <- le_plus_minus. -replace (n + 0)%nat with n; [ idtac | ring ]. -apply le_lt_trans with (pred N). -assumption. -apply lt_pred_n_n; assumption. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply INR_fact_neq_0. -apply Rle_trans with - (sum_f_R0 (fun k:nat => INR N / INR (fact (S (S N))) * C ^ (4 * S N)) - (pred N)). -apply sum_Rle; intros. -rewrite <- - (scal_sum (fun _:nat => C ^ (4 * S N)) (pred (N - n)) - (Rsqr (/ INR (fact (S (S (N + n))))))). -rewrite sum_cte. -rewrite <- Rmult_assoc. -do 2 rewrite <- (Rmult_comm (C ^ (4 * S N))). -rewrite Rmult_assoc. -apply Rmult_le_compat_l. -apply pow_le. -left; apply Rlt_le_trans with 1. -apply Rlt_0_1. -unfold C in |- *; apply RmaxLess1. -apply Rle_trans with (Rsqr (/ INR (fact (S (S (N + n))))) * INR N). -apply Rmult_le_compat_l. -apply Rle_0_sqr. -replace (S (pred (N - n))) with (N - n)%nat. -apply le_INR. -apply (fun p n m:nat => plus_le_reg_l n m p) with n. -rewrite <- le_plus_minus. -apply le_plus_r. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -apply S_pred with 0%nat. -apply plus_lt_reg_l with n. -rewrite <- le_plus_minus. -replace (n + 0)%nat with n; [ idtac | ring ]. -apply le_lt_trans with (pred N). -assumption. -apply lt_pred_n_n; assumption. -apply le_trans with (pred N). -assumption. -apply le_pred_n. -rewrite Rmult_comm; unfold Rdiv in |- *; apply Rmult_le_compat_l. -apply pos_INR. -apply Rle_trans with (/ INR (fact (S (S (N + n))))). -pattern (/ INR (fact (S (S (N + n))))) at 2 in |- *; rewrite <- Rmult_1_r. -unfold Rsqr in |- *. -apply Rmult_le_compat_l. -left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. -apply Rmult_le_reg_l with (INR (fact (S (S (N + n))))). -apply INR_fact_lt_0. -rewrite <- Rinv_r_sym. -rewrite Rmult_1_r. -replace 1 with (INR 1). -apply le_INR. -apply lt_le_S. -apply INR_lt; apply INR_fact_lt_0. -reflexivity. -apply INR_fact_neq_0. -apply Rmult_le_reg_l with (INR (fact (S (S (N + n))))). -apply INR_fact_lt_0. -rewrite <- Rinv_r_sym. -apply Rmult_le_reg_l with (INR (fact (S (S N)))). -apply INR_fact_lt_0. -rewrite Rmult_1_r. -rewrite (Rmult_comm (INR (fact (S (S N))))). -rewrite Rmult_assoc. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_r. -apply le_INR. -apply fact_le. -repeat apply le_n_S. -apply le_plus_l. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -rewrite sum_cte. -apply Rle_trans with (C ^ (4 * S N) / INR (fact N)). -rewrite <- (Rmult_comm (C ^ (4 * S N))). -unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l. -apply pow_le. -left; apply Rlt_le_trans with 1. -apply Rlt_0_1. -unfold C in |- *; apply RmaxLess1. -cut (S (pred N) = N). -intro; rewrite H0. -do 2 rewrite fact_simpl. -repeat rewrite mult_INR. -repeat rewrite Rinv_mult_distr. -apply Rle_trans with - (INR (S (S N)) * (/ INR (S (S N)) * (/ INR (S N) * / INR (fact N))) * INR N). -repeat rewrite Rmult_assoc. -rewrite (Rmult_comm (INR N)). -rewrite (Rmult_comm (INR (S (S N)))). -apply Rmult_le_compat_l. -repeat apply Rmult_le_pos. -left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn. -left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn. -left; apply Rinv_0_lt_compat. -apply INR_fact_lt_0. -apply pos_INR. -apply le_INR. -apply le_trans with (S N); apply le_n_Sn. -repeat rewrite <- Rmult_assoc. -rewrite <- Rinv_r_sym. -rewrite Rmult_1_l. -apply Rle_trans with (/ INR (S N) * / INR (fact N) * INR (S N)). -repeat rewrite Rmult_assoc. -repeat apply Rmult_le_compat_l. -left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn. -left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. -apply le_INR; apply le_n_Sn. -rewrite (Rmult_comm (/ INR (S N))). -rewrite Rmult_assoc. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_r; right; reflexivity. -apply not_O_INR; discriminate. -apply not_O_INR; discriminate. -apply not_O_INR; discriminate. -apply INR_fact_neq_0. -apply not_O_INR; discriminate. -apply prod_neq_R0; [ apply not_O_INR; discriminate | apply INR_fact_neq_0 ]. -symmetry in |- *; apply S_pred with 0%nat; assumption. -right. -unfold Majxy in |- *. -unfold C in |- *. -reflexivity. + y ^ (2 * (N - l) + 1)) (pred (N - k)))) ( + pred N)). + apply + (Rsum_abs + (fun k:nat => + sum_f_R0 + (fun l:nat => + (-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) * + x ^ (2 * S (l + k) + 1) * + ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) * + y ^ (2 * (N - l) + 1)) (pred (N - k))) ( + pred N)). + apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + Rabs + ((-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) * + x ^ (2 * S (l + k) + 1) * + ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) * + y ^ (2 * (N - l) + 1))) (pred (N - k))) ( + pred N)). + apply sum_Rle. + intros. + apply + (Rsum_abs + (fun l:nat => + (-1) ^ S (l + n) / INR (fact (2 * S (l + n) + 1)) * + x ^ (2 * S (l + n) + 1) * + ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) * + y ^ (2 * (N - l) + 1)) (pred (N - n))). + apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + / INR (fact (2 * S (l + k) + 1) * fact (2 * (N - l) + 1)) * + C ^ (2 * S (S (N + k)))) (pred (N - k))) ( + pred N)). + apply sum_Rle; intros. + apply sum_Rle; intros. + unfold Rdiv in |- *; repeat rewrite Rabs_mult. + do 2 rewrite pow_1_abs. + do 2 rewrite Rmult_1_l. + rewrite (Rabs_right (/ INR (fact (2 * S (n0 + n) + 1)))). + rewrite (Rabs_right (/ INR (fact (2 * (N - n0) + 1)))). + rewrite mult_INR. + rewrite Rinv_mult_distr. + repeat rewrite Rmult_assoc. + apply Rmult_le_compat_l. + left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. + rewrite <- Rmult_assoc. + rewrite <- (Rmult_comm (/ INR (fact (2 * (N - n0) + 1)))). + rewrite Rmult_assoc. + apply Rmult_le_compat_l. + left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. + do 2 rewrite <- RPow_abs. + apply Rle_trans with (Rabs x ^ (2 * S (n0 + n) + 1) * C ^ (2 * (N - n0) + 1)). + apply Rmult_le_compat_l. + apply pow_le; apply Rabs_pos. + apply pow_incr. + split. + apply Rabs_pos. + unfold C in |- *. + apply Rle_trans with (Rmax (Rabs x) (Rabs y)); apply RmaxLess2. + apply Rle_trans with (C ^ (2 * S (n0 + n) + 1) * C ^ (2 * (N - n0) + 1)). + do 2 rewrite <- (Rmult_comm (C ^ (2 * (N - n0) + 1))). + apply Rmult_le_compat_l. + apply pow_le. + apply Rle_trans with 1. + left; apply Rlt_0_1. + unfold C in |- *; apply RmaxLess1. + apply pow_incr. + split. + apply Rabs_pos. + unfold C in |- *; apply Rle_trans with (Rmax (Rabs x) (Rabs y)). + apply RmaxLess1. + apply RmaxLess2. + right. + replace (2 * S (S (N + n)))%nat with + (2 * (N - n0) + 1 + (2 * S (n0 + n) + 1))%nat. + repeat rewrite pow_add. + ring. + omega. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + apply Rle_ge; left; apply Rinv_0_lt_compat. + apply INR_fact_lt_0. + apply Rle_ge; left; apply Rinv_0_lt_compat. + apply INR_fact_lt_0. + apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + / INR (fact (2 * S (l + k) + 1) * fact (2 * (N - l) + 1)) * + C ^ (4 * S N)) (pred (N - k))) (pred N)). + apply sum_Rle; intros. + apply sum_Rle; intros. + apply Rmult_le_compat_l. + left; apply Rinv_0_lt_compat. + rewrite mult_INR; apply Rmult_lt_0_compat; apply INR_fact_lt_0. + apply Rle_pow. + unfold C in |- *; apply RmaxLess1. + replace (4 * S N)%nat with (2 * (2 * S N))%nat; [ idtac | ring ]. + apply (fun m n p:nat => mult_le_compat_l p n m). + replace (2 * S N)%nat with (S (S (N + N))). + repeat apply le_n_S. + apply plus_le_compat_l. + apply le_trans with (pred N). + assumption. + apply le_pred_n. + ring_nat. + apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => C ^ (4 * S N) * Rsqr (/ INR (fact (S (S (N + k)))))) + (pred (N - k))) (pred N)). + apply sum_Rle; intros. + apply sum_Rle; intros. + rewrite <- (Rmult_comm (C ^ (4 * S N))). + apply Rmult_le_compat_l. + apply pow_le. + left; apply Rlt_le_trans with 1. + apply Rlt_0_1. + unfold C in |- *; apply RmaxLess1. + replace (/ INR (fact (2 * S (n0 + n) + 1) * fact (2 * (N - n0) + 1))) with + (Binomial.C (2 * S (S (N + n))) (2 * S (n0 + n) + 1) / + INR (fact (2 * S (S (N + n))))). + apply Rle_trans with + (Binomial.C (2 * S (S (N + n))) (S (S (N + n))) / + INR (fact (2 * S (S (N + n))))). + unfold Rdiv in |- *; + do 2 rewrite <- (Rmult_comm (/ INR (fact (2 * S (S (N + n)))))). + apply Rmult_le_compat_l. + left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. + apply C_maj. + apply le_trans with (2 * S (S (n0 + n)))%nat. + replace (2 * S (S (n0 + n)))%nat with (S (2 * S (n0 + n) + 1)). + apply le_n_Sn. + ring_nat. + omega. + right. + unfold Rdiv in |- *; rewrite Rmult_comm. + unfold Binomial.C in |- *. + unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_l. + replace (2 * S (S (N + n)) - S (S (N + n)))%nat with (S (S (N + n))). + rewrite Rinv_mult_distr. + unfold Rsqr in |- *; reflexivity. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + omega. + apply INR_fact_neq_0. + unfold Rdiv in |- *; rewrite Rmult_comm. + unfold Binomial.C in |- *. + unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_l. + replace (2 * S (S (N + n)) - (2 * S (n0 + n) + 1))%nat with + (2 * (N - n0) + 1)%nat. + rewrite mult_INR. + reflexivity. + omega. + apply INR_fact_neq_0. + apply Rle_trans with + (sum_f_R0 (fun k:nat => INR N / INR (fact (S (S N))) * C ^ (4 * S N)) + (pred N)). + apply sum_Rle; intros. + rewrite <- + (scal_sum (fun _:nat => C ^ (4 * S N)) (pred (N - n)) + (Rsqr (/ INR (fact (S (S (N + n))))))). + rewrite sum_cte. + rewrite <- Rmult_assoc. + do 2 rewrite <- (Rmult_comm (C ^ (4 * S N))). + rewrite Rmult_assoc. + apply Rmult_le_compat_l. + apply pow_le. + left; apply Rlt_le_trans with 1. + apply Rlt_0_1. + unfold C in |- *; apply RmaxLess1. + apply Rle_trans with (Rsqr (/ INR (fact (S (S (N + n))))) * INR N). + apply Rmult_le_compat_l. + apply Rle_0_sqr. + replace (S (pred (N - n))) with (N - n)%nat. + apply le_INR. + omega. + omega. + rewrite Rmult_comm; unfold Rdiv in |- *; apply Rmult_le_compat_l. + apply pos_INR. + apply Rle_trans with (/ INR (fact (S (S (N + n))))). + pattern (/ INR (fact (S (S (N + n))))) at 2 in |- *; rewrite <- Rmult_1_r. + unfold Rsqr in |- *. + apply Rmult_le_compat_l. + left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. + apply Rmult_le_reg_l with (INR (fact (S (S (N + n))))). + apply INR_fact_lt_0. + rewrite <- Rinv_r_sym. + rewrite Rmult_1_r. + replace 1 with (INR 1). + apply le_INR. + apply lt_le_S. + apply INR_lt; apply INR_fact_lt_0. + reflexivity. + apply INR_fact_neq_0. + apply Rmult_le_reg_l with (INR (fact (S (S (N + n))))). + apply INR_fact_lt_0. + rewrite <- Rinv_r_sym. + apply Rmult_le_reg_l with (INR (fact (S (S N)))). + apply INR_fact_lt_0. + rewrite Rmult_1_r. + rewrite (Rmult_comm (INR (fact (S (S N))))). + rewrite Rmult_assoc. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_r. + apply le_INR. + apply fact_le. + omega. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + rewrite sum_cte. + apply Rle_trans with (C ^ (4 * S N) / INR (fact N)). + rewrite <- (Rmult_comm (C ^ (4 * S N))). + unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l. + apply pow_le. + left; apply Rlt_le_trans with 1. + apply Rlt_0_1. + unfold C in |- *; apply RmaxLess1. + cut (S (pred N) = N). + intro; rewrite H0. + do 2 rewrite fact_simpl. + repeat rewrite mult_INR. + repeat rewrite Rinv_mult_distr. + apply Rle_trans with + (INR (S (S N)) * (/ INR (S (S N)) * (/ INR (S N) * / INR (fact N))) * INR N). + repeat rewrite Rmult_assoc. + rewrite (Rmult_comm (INR N)). + rewrite (Rmult_comm (INR (S (S N)))). + apply Rmult_le_compat_l. + repeat apply Rmult_le_pos. + left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn. + left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn. + left; apply Rinv_0_lt_compat. + apply INR_fact_lt_0. + apply pos_INR. + apply le_INR. + apply le_trans with (S N); apply le_n_Sn. + repeat rewrite <- Rmult_assoc. + rewrite <- Rinv_r_sym. + rewrite Rmult_1_l. + apply Rle_trans with (/ INR (S N) * / INR (fact N) * INR (S N)). + repeat rewrite Rmult_assoc. + repeat apply Rmult_le_compat_l. + left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn. + left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. + apply le_INR; apply le_n_Sn. + rewrite (Rmult_comm (/ INR (S N))). + rewrite Rmult_assoc. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_r; right; reflexivity. + apply not_O_INR; discriminate. + apply not_O_INR; discriminate. + apply not_O_INR; discriminate. + apply INR_fact_neq_0. + apply not_O_INR; discriminate. + apply prod_neq_R0; [ apply not_O_INR; discriminate | apply INR_fact_neq_0 ]. + symmetry in |- *; apply S_pred with 0%nat; assumption. + right. + unfold Majxy in |- *. + unfold C in |- *. + reflexivity. Qed. Lemma reste1_cv_R0 : forall x y:R, Un_cv (Reste1 x y) 0. -intros. -assert (H := Majxy_cv_R0 x y). -unfold Un_cv in H; unfold R_dist in H. -unfold Un_cv in |- *; unfold R_dist in |- *; intros. -elim (H eps H0); intros N0 H1. -exists (S N0); intros. -unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r. -apply Rle_lt_trans with (Rabs (Majxy x y (pred n))). -rewrite (Rabs_right (Majxy x y (pred n))). -apply reste1_maj. -apply lt_le_trans with (S N0). -apply lt_O_Sn. -assumption. -apply Rle_ge. -unfold Majxy in |- *. -unfold Rdiv in |- *; apply Rmult_le_pos. -apply pow_le. -apply Rle_trans with 1. -left; apply Rlt_0_1. -apply RmaxLess1. -left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. -replace (Majxy x y (pred n)) with (Majxy x y (pred n) - 0); [ idtac | ring ]. -apply H1. -unfold ge in |- *; apply le_S_n. -replace (S (pred n)) with n. -assumption. -apply S_pred with 0%nat. -apply lt_le_trans with (S N0); [ apply lt_O_Sn | assumption ]. +Proof. + intros. + assert (H := Majxy_cv_R0 x y). + unfold Un_cv in H; unfold R_dist in H. + unfold Un_cv in |- *; unfold R_dist in |- *; intros. + elim (H eps H0); intros N0 H1. + exists (S N0); intros. + unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r. + apply Rle_lt_trans with (Rabs (Majxy x y (pred n))). + rewrite (Rabs_right (Majxy x y (pred n))). + apply reste1_maj. + apply lt_le_trans with (S N0). + apply lt_O_Sn. + assumption. + apply Rle_ge. + unfold Majxy in |- *. + unfold Rdiv in |- *; apply Rmult_le_pos. + apply pow_le. + apply Rle_trans with 1. + left; apply Rlt_0_1. + apply RmaxLess1. + left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. + replace (Majxy x y (pred n)) with (Majxy x y (pred n) - 0); [ idtac | ring ]. + apply H1. + unfold ge in |- *; apply le_S_n. + replace (S (pred n)) with n. + assumption. + apply S_pred with 0%nat. + apply lt_le_trans with (S N0); [ apply lt_O_Sn | assumption ]. Qed. Lemma reste2_cv_R0 : forall x y:R, Un_cv (Reste2 x y) 0. -intros. -assert (H := Majxy_cv_R0 x y). -unfold Un_cv in H; unfold R_dist in H. -unfold Un_cv in |- *; unfold R_dist in |- *; intros. -elim (H eps H0); intros N0 H1. -exists (S N0); intros. -unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r. -apply Rle_lt_trans with (Rabs (Majxy x y n)). -rewrite (Rabs_right (Majxy x y n)). -apply reste2_maj. -apply lt_le_trans with (S N0). -apply lt_O_Sn. -assumption. -apply Rle_ge. -unfold Majxy in |- *. -unfold Rdiv in |- *; apply Rmult_le_pos. -apply pow_le. -apply Rle_trans with 1. -left; apply Rlt_0_1. -apply RmaxLess1. -left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. -replace (Majxy x y n) with (Majxy x y n - 0); [ idtac | ring ]. -apply H1. -unfold ge in |- *; apply le_trans with (S N0). -apply le_n_Sn. -exact H2. +Proof. + intros. + assert (H := Majxy_cv_R0 x y). + unfold Un_cv in H; unfold R_dist in H. + unfold Un_cv in |- *; unfold R_dist in |- *; intros. + elim (H eps H0); intros N0 H1. + exists (S N0); intros. + unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r. + apply Rle_lt_trans with (Rabs (Majxy x y n)). + rewrite (Rabs_right (Majxy x y n)). + apply reste2_maj. + apply lt_le_trans with (S N0). + apply lt_O_Sn. + assumption. + apply Rle_ge. + unfold Majxy in |- *. + unfold Rdiv in |- *; apply Rmult_le_pos. + apply pow_le. + apply Rle_trans with 1. + left; apply Rlt_0_1. + apply RmaxLess1. + left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. + replace (Majxy x y n) with (Majxy x y n - 0); [ idtac | ring ]. + apply H1. + unfold ge in |- *; apply le_trans with (S N0). + apply le_n_Sn. + exact H2. Qed. Lemma reste_cv_R0 : forall x y:R, Un_cv (Reste x y) 0. -intros. -unfold Reste in |- *. -set (An := fun n:nat => Reste2 x y n). -set (Bn := fun n:nat => Reste1 x y (S n)). -cut - (Un_cv (fun n:nat => An n - Bn n) (0 - 0) -> - Un_cv (fun N:nat => Reste2 x y N - Reste1 x y (S N)) 0). -intro. -apply H. -apply CV_minus. -unfold An in |- *. -replace (fun n:nat => Reste2 x y n) with (Reste2 x y). -apply reste2_cv_R0. -reflexivity. -unfold Bn in |- *. -assert (H0 := reste1_cv_R0 x y). -unfold Un_cv in H0; unfold R_dist in H0. -unfold Un_cv in |- *; unfold R_dist in |- *; intros. -elim (H0 eps H1); intros N0 H2. -exists N0; intros. -apply H2. -unfold ge in |- *; apply le_trans with (S N0). -apply le_n_Sn. -apply le_n_S; assumption. -unfold An, Bn in |- *. -intro. -replace 0 with (0 - 0); [ idtac | ring ]. -exact H. +Proof. + intros. + unfold Reste in |- *. + set (An := fun n:nat => Reste2 x y n). + set (Bn := fun n:nat => Reste1 x y (S n)). + cut + (Un_cv (fun n:nat => An n - Bn n) (0 - 0) -> + Un_cv (fun N:nat => Reste2 x y N - Reste1 x y (S N)) 0). + intro. + apply H. + apply CV_minus. + unfold An in |- *. + replace (fun n:nat => Reste2 x y n) with (Reste2 x y). + apply reste2_cv_R0. + reflexivity. + unfold Bn in |- *. + assert (H0 := reste1_cv_R0 x y). + unfold Un_cv in H0; unfold R_dist in H0. + unfold Un_cv in |- *; unfold R_dist in |- *; intros. + elim (H0 eps H1); intros N0 H2. + exists N0; intros. + apply H2. + unfold ge in |- *; apply le_trans with (S N0). + apply le_n_Sn. + apply le_n_S; assumption. + unfold An, Bn in |- *. + intro. + replace 0 with (0 - 0); [ idtac | ring ]. + exact H. Qed. Theorem cos_plus : forall x y:R, cos (x + y) = cos x * cos y - sin x * sin y. -intros. -cut (Un_cv (C1 x y) (cos x * cos y - sin x * sin y)). -cut (Un_cv (C1 x y) (cos (x + y))). -intros. -apply UL_sequence with (C1 x y); assumption. -apply C1_cvg. -unfold Un_cv in |- *; unfold R_dist in |- *. -intros. -assert (H0 := A1_cvg x). -assert (H1 := A1_cvg y). -assert (H2 := B1_cvg x). -assert (H3 := B1_cvg y). -assert (H4 := CV_mult _ _ _ _ H0 H1). -assert (H5 := CV_mult _ _ _ _ H2 H3). -assert (H6 := reste_cv_R0 x y). -unfold Un_cv in H4; unfold Un_cv in H5; unfold Un_cv in H6. -unfold R_dist in H4; unfold R_dist in H5; unfold R_dist in H6. -cut (0 < eps / 3); - [ intro - | unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. -elim (H4 (eps / 3) H7); intros N1 H8. -elim (H5 (eps / 3) H7); intros N2 H9. -elim (H6 (eps / 3) H7); intros N3 H10. -set (N := S (S (max (max N1 N2) N3))). -exists N. -intros. -cut (n = S (pred n)). -intro; rewrite H12. -rewrite <- cos_plus_form. -rewrite <- H12. -apply Rle_lt_trans with - (Rabs (A1 x n * A1 y n - cos x * cos y) + - Rabs (sin x * sin y - B1 x (pred n) * B1 y (pred n) + Reste x y (pred n))). -replace - (A1 x n * A1 y n - B1 x (pred n) * B1 y (pred n) + Reste x y (pred n) - - (cos x * cos y - sin x * sin y)) with - (A1 x n * A1 y n - cos x * cos y + - (sin x * sin y - B1 x (pred n) * B1 y (pred n) + Reste x y (pred n))); - [ apply Rabs_triang | ring ]. -replace eps with (eps / 3 + (eps / 3 + eps / 3)). -apply Rplus_lt_compat. -apply H8. -unfold ge in |- *; apply le_trans with N. -unfold N in |- *. -apply le_trans with (max N1 N2). -apply le_max_l. -apply le_trans with (max (max N1 N2) N3). -apply le_max_l. -apply le_trans with (S (max (max N1 N2) N3)); apply le_n_Sn. -assumption. -apply Rle_lt_trans with - (Rabs (sin x * sin y - B1 x (pred n) * B1 y (pred n)) + - Rabs (Reste x y (pred n))). -apply Rabs_triang. -apply Rplus_lt_compat. -rewrite <- Rabs_Ropp. -rewrite Ropp_minus_distr. -apply H9. -unfold ge in |- *; apply le_trans with (max N1 N2). -apply le_max_r. -apply le_S_n. -rewrite <- H12. -apply le_trans with N. -unfold N in |- *. -apply le_n_S. -apply le_trans with (max (max N1 N2) N3). -apply le_max_l. -apply le_n_Sn. -assumption. -replace (Reste x y (pred n)) with (Reste x y (pred n) - 0). -apply H10. -unfold ge in |- *. -apply le_S_n. -rewrite <- H12. -apply le_trans with N. -unfold N in |- *. -apply le_n_S. -apply le_trans with (max (max N1 N2) N3). -apply le_max_r. -apply le_n_Sn. -assumption. -ring. -pattern eps at 4 in |- *; replace eps with (3 * (eps / 3)). -ring. -unfold Rdiv in |- *. -rewrite <- Rmult_assoc. -apply Rinv_r_simpl_m. -discrR. -apply lt_le_trans with (pred N). -unfold N in |- *; simpl in |- *; apply lt_O_Sn. -apply le_S_n. -rewrite <- H12. -replace (S (pred N)) with N. -assumption. -unfold N in |- *; simpl in |- *; reflexivity. -cut (0 < N)%nat. -intro. -cut (0 < n)%nat. -intro. -apply S_pred with 0%nat; assumption. -apply lt_le_trans with N; assumption. -unfold N in |- *; apply lt_O_Sn. -Qed.
\ No newline at end of file +Proof. + intros. + cut (Un_cv (C1 x y) (cos x * cos y - sin x * sin y)). + cut (Un_cv (C1 x y) (cos (x + y))). + intros. + apply UL_sequence with (C1 x y); assumption. + apply C1_cvg. + unfold Un_cv in |- *; unfold R_dist in |- *. + intros. + assert (H0 := A1_cvg x). + assert (H1 := A1_cvg y). + assert (H2 := B1_cvg x). + assert (H3 := B1_cvg y). + assert (H4 := CV_mult _ _ _ _ H0 H1). + assert (H5 := CV_mult _ _ _ _ H2 H3). + assert (H6 := reste_cv_R0 x y). + unfold Un_cv in H4; unfold Un_cv in H5; unfold Un_cv in H6. + unfold R_dist in H4; unfold R_dist in H5; unfold R_dist in H6. + cut (0 < eps / 3); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. + elim (H4 (eps / 3) H7); intros N1 H8. + elim (H5 (eps / 3) H7); intros N2 H9. + elim (H6 (eps / 3) H7); intros N3 H10. + set (N := S (S (max (max N1 N2) N3))). + exists N. + intros. + cut (n = S (pred n)). + intro; rewrite H12. + rewrite <- cos_plus_form. + rewrite <- H12. + apply Rle_lt_trans with + (Rabs (A1 x n * A1 y n - cos x * cos y) + + Rabs (sin x * sin y - B1 x (pred n) * B1 y (pred n) + Reste x y (pred n))). + replace + (A1 x n * A1 y n - B1 x (pred n) * B1 y (pred n) + Reste x y (pred n) - + (cos x * cos y - sin x * sin y)) with + (A1 x n * A1 y n - cos x * cos y + + (sin x * sin y - B1 x (pred n) * B1 y (pred n) + Reste x y (pred n))); + [ apply Rabs_triang | ring ]. + replace eps with (eps / 3 + (eps / 3 + eps / 3)). + apply Rplus_lt_compat. + apply H8. + unfold ge in |- *; apply le_trans with N. + unfold N in |- *. + apply le_trans with (max N1 N2). + apply le_max_l. + apply le_trans with (max (max N1 N2) N3). + apply le_max_l. + apply le_trans with (S (max (max N1 N2) N3)); apply le_n_Sn. + assumption. + apply Rle_lt_trans with + (Rabs (sin x * sin y - B1 x (pred n) * B1 y (pred n)) + + Rabs (Reste x y (pred n))). + apply Rabs_triang. + apply Rplus_lt_compat. + rewrite <- Rabs_Ropp. + rewrite Ropp_minus_distr. + apply H9. + unfold ge in |- *; apply le_trans with (max N1 N2). + apply le_max_r. + apply le_S_n. + rewrite <- H12. + apply le_trans with N. + unfold N in |- *. + apply le_n_S. + apply le_trans with (max (max N1 N2) N3). + apply le_max_l. + apply le_n_Sn. + assumption. + replace (Reste x y (pred n)) with (Reste x y (pred n) - 0). + apply H10. + unfold ge in |- *. + apply le_S_n. + rewrite <- H12. + apply le_trans with N. + unfold N in |- *. + apply le_n_S. + apply le_trans with (max (max N1 N2) N3). + apply le_max_r. + apply le_n_Sn. + assumption. + ring. + pattern eps at 4 in |- *; replace eps with (3 * (eps / 3)). + ring. + unfold Rdiv in |- *. + rewrite <- Rmult_assoc. + apply Rinv_r_simpl_m. + discrR. + apply lt_le_trans with (pred N). + unfold N in |- *; simpl in |- *; apply lt_O_Sn. + apply le_S_n. + rewrite <- H12. + replace (S (pred N)) with N. + assumption. + unfold N in |- *; simpl in |- *; reflexivity. + cut (0 < N)%nat. + intro. + cut (0 < n)%nat. + intro. + apply S_pred with 0%nat; assumption. + apply lt_le_trans with N; assumption. + unfold N in |- *; apply lt_O_Sn. +Qed. diff --git a/theories/Reals/Cos_rel.v b/theories/Reals/Cos_rel.v index 8320382c..ac8ffbeb 100644 --- a/theories/Reals/Cos_rel.v +++ b/theories/Reals/Cos_rel.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Cos_rel.v 6245 2004-10-20 13:50:08Z barras $ i*) +(*i $Id: Cos_rel.v 9178 2006-09-26 11:18:22Z barras $ i*) Require Import Rbase. Require Import Rfunctions. @@ -83,7 +83,6 @@ replace ((-1) ^ (n - l) / INR (fact (2 * (n - l) + 1)) * y ^ (2 * (n - l) + 1))) (pred (n - k))) ( pred n)) with (Reste2 x y n). -ring. replace (sum_f_R0 (fun k:nat => @@ -98,7 +97,7 @@ replace sum_f_R0 (fun l:nat => C (2 * k) (2 * l) * x ^ (2 * l) * y ^ (2 * (k - l))) k) (S n)). -set +pose (sin_nnn := fun n:nat => match n with @@ -109,8 +108,10 @@ set (fun l:nat => C (2 * S p) (S (2 * l)) * x ^ S (2 * l) * y ^ S (2 * (p - l))) p end). +ring_simplify. replace - (- +(* (- old ring compat *) + (-1 * sum_f_R0 (fun k:nat => sum_f_R0 @@ -123,19 +124,13 @@ unfold C1 in |- *. apply sum_eq; intros. induction i as [| i Hreci]. simpl in |- *. -rewrite Rplus_0_l. -replace (C 0 0) with 1. -unfold Rdiv in |- *; rewrite Rinv_1. -ring. -unfold C in |- *. -rewrite <- minus_n_n. -simpl in |- *. -unfold Rdiv in |- *; rewrite Rmult_1_r; rewrite Rinv_1; ring. +unfold C in |- *; simpl in |- *. +field; discrR. unfold sin_nnn in |- *. rewrite <- Rmult_plus_distr_l. apply Rmult_eq_compat_l. rewrite binomial. -set (Wn := fun i0:nat => C (2 * S i) i0 * x ^ i0 * y ^ (2 * S i - i0)). +pose (Wn := fun i0:nat => C (2 * S i) i0 * x ^ i0 * y ^ (2 * S i - i0)). replace (sum_f_R0 (fun l:nat => C (2 * S i) (2 * l) * x ^ (2 * l) * y ^ (2 * (S i - l))) @@ -145,42 +140,39 @@ replace (fun l:nat => C (2 * S i) (S (2 * l)) * x ^ S (2 * l) * y ^ S (2 * (i - l))) i) with (sum_f_R0 (fun l:nat => Wn (S (2 * l))) i). -rewrite Rplus_comm. +(*rewrite Rplus_comm.*) (* compatibility old ring... *) apply sum_decomposition. apply sum_eq; intros. unfold Wn in |- *. apply Rmult_eq_compat_l. replace (2 * S i - S (2 * i0))%nat with (S (2 * (i - i0))). reflexivity. -apply INR_eq. -rewrite S_INR; rewrite mult_INR. -repeat rewrite minus_INR. -rewrite mult_INR; repeat rewrite S_INR. -rewrite mult_INR; repeat rewrite S_INR; ring. -replace (2 * S i)%nat with (S (S (2 * i))). -apply le_n_S. -apply le_trans with (2 * i)%nat. -apply (fun m n p:nat => mult_le_compat_l p n m); assumption. -apply le_n_Sn. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. -assumption. +omega. apply sum_eq; intros. unfold Wn in |- *. apply Rmult_eq_compat_l. replace (2 * S i - 2 * i0)%nat with (2 * (S i - i0))%nat. reflexivity. -apply INR_eq. -rewrite mult_INR. -repeat rewrite minus_INR. -rewrite mult_INR; repeat rewrite S_INR. -rewrite mult_INR; repeat rewrite S_INR; ring. -apply (fun m n p:nat => mult_le_compat_l p n m); assumption. -assumption. -rewrite <- (Ropp_involutive (sum_f_R0 sin_nnn (S n))). -apply Ropp_eq_compat. -replace (- sum_f_R0 sin_nnn (S n)) with (-1 * sum_f_R0 sin_nnn (S n)); - [ idtac | ring ]. +omega. +replace (sum_f_R0 sin_nnn (S n)) with (-1 * (-1 * sum_f_R0 sin_nnn (S n))). +(*replace (* compatibility old ring... *) + (- + sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun p:nat => + (-1) ^ p / INR (fact (2 * p + 1)) * x ^ (2 * p + 1) * + ((-1) ^ (k - p) / INR (fact (2 * (k - p) + 1)) * + y ^ (2 * (k - p) + 1))) k) n) with + (-1 * + sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun p:nat => + (-1) ^ p / INR (fact (2 * p + 1)) * x ^ (2 * p + 1) * + ((-1) ^ (k - p) / INR (fact (2 * (k - p) + 1)) * + y ^ (2 * (k - p) + 1))) k) n);[idtac|ring].*) +apply Rmult_eq_compat_l. rewrite scal_sum. rewrite decomp_sum. replace (sin_nnn 0%nat) with 0. @@ -218,25 +210,13 @@ replace (S (2 * i0)) with (2 * i0 + 1)%nat; [ apply Rmult_eq_compat_l | ring ]. replace (2 * S i - (2 * i0 + 1))%nat with (2 * (i - i0) + 1)%nat. reflexivity. -apply INR_eq. -rewrite plus_INR; rewrite mult_INR; repeat rewrite minus_INR. -rewrite plus_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; ring. -replace (2 * i0 + 1)%nat with (S (2 * i0)). -replace (2 * S i)%nat with (S (S (2 * i))). -apply le_n_S. -apply le_trans with (2 * i)%nat. -apply (fun m n p:nat => mult_le_compat_l p n m); assumption. -apply le_n_Sn. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. -apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; - repeat rewrite S_INR; ring. -assumption. +omega. apply INR_fact_neq_0. apply INR_fact_neq_0. apply INR_fact_neq_0. reflexivity. apply lt_O_Sn. +ring. apply sum_eq; intros. rewrite scal_sum. apply sum_eq; intros. @@ -259,11 +239,7 @@ rewrite Rmult_1_l. rewrite Rinv_mult_distr. replace (2 * i - 2 * i0)%nat with (2 * (i - i0))%nat. reflexivity. -apply INR_eq. -rewrite mult_INR; repeat rewrite minus_INR. -do 2 rewrite mult_INR; repeat rewrite S_INR; ring. -apply (fun m n p:nat => mult_le_compat_l p n m); assumption. -assumption. +omega. apply INR_fact_neq_0. apply INR_fact_neq_0. apply INR_fact_neq_0. diff --git a/theories/Reals/DiscrR.v b/theories/Reals/DiscrR.v index 1c663288..a16af05c 100644 --- a/theories/Reals/DiscrR.v +++ b/theories/Reals/DiscrR.v @@ -6,13 +6,13 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: DiscrR.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: DiscrR.v 9178 2006-09-26 11:18:22Z barras $ i*) Require Import RIneq. Require Import Omega. Open Local Scope R_scope. Lemma Rlt_R0_R2 : 0 < 2. -replace 2 with (INR 2); [ apply lt_INR_0; apply lt_O_Sn | reflexivity ]. +change 2 with (INR 2); apply lt_INR_0; apply lt_O_Sn. Qed. Lemma Rplus_lt_pos : forall x y:R, 0 < x -> 0 < y -> 0 < x + y. @@ -36,17 +36,14 @@ Ltac discrR := try match goal with | |- (?X1 <> ?X2) => - replace 2 with (IZR 2); - [ replace 1 with (IZR 1); - [ replace 0 with (IZR 0); - [ repeat - rewrite <- plus_IZR || - rewrite <- mult_IZR || - rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; - apply IZR_neq; try discriminate - | reflexivity ] - | reflexivity ] - | reflexivity ] + change 2 with (IZR 2); + change 1 with (IZR 1); + change 0 with (IZR 0); + repeat + rewrite <- plus_IZR || + rewrite <- mult_IZR || + rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; + apply IZR_neq; try discriminate end. Ltac prove_sup0 := @@ -60,17 +57,13 @@ Ltac prove_sup0 := end. Ltac omega_sup := - replace 2 with (IZR 2); - [ replace 1 with (IZR 1); - [ replace 0 with (IZR 0); - [ repeat - rewrite <- plus_IZR || - rewrite <- mult_IZR || - rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; - apply IZR_lt; omega - | reflexivity ] - | reflexivity ] - | reflexivity ]. + change 2 with (IZR 2); + change 1 with (IZR 1); + change 0 with (IZR 0); + repeat + rewrite <- plus_IZR || + rewrite <- mult_IZR || rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; + apply IZR_lt; omega. Ltac prove_sup := match goal with @@ -84,14 +77,10 @@ Ltac prove_sup := end. Ltac Rcompute := - replace 2 with (IZR 2); - [ replace 1 with (IZR 1); - [ replace 0 with (IZR 0); - [ repeat - rewrite <- plus_IZR || - rewrite <- mult_IZR || - rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; - apply IZR_eq; try reflexivity - | reflexivity ] - | reflexivity ] - | reflexivity ].
\ No newline at end of file + change 2 with (IZR 2); + change 1 with (IZR 1); + change 0 with (IZR 0); + repeat + rewrite <- plus_IZR || + rewrite <- mult_IZR || rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; + apply IZR_eq; try reflexivity. diff --git a/theories/Reals/Exp_prop.v b/theories/Reals/Exp_prop.v index 90ea93ef..5dafec83 100644 --- a/theories/Reals/Exp_prop.v +++ b/theories/Reals/Exp_prop.v @@ -5,8 +5,8 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) - -(*i $Id: Exp_prop.v 8670 2006-03-28 22:16:14Z herbelin $ i*) + +(*i $Id: Exp_prop.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -24,988 +24,972 @@ Definition E1 (x:R) (N:nat) : R := sum_f_R0 (fun k:nat => / INR (fact k) * x ^ k) N. Lemma E1_cvg : forall x:R, Un_cv (E1 x) (exp x). -intro; unfold exp in |- *; unfold projT1 in |- *. -case (exist_exp x); intro. -unfold exp_in, Un_cv in |- *; unfold infinit_sum, E1 in |- *; trivial. +Proof. + intro; unfold exp in |- *; unfold projT1 in |- *. + case (exist_exp x); intro. + unfold exp_in, Un_cv in |- *; unfold infinit_sum, E1 in |- *; trivial. Qed. Definition Reste_E (x y:R) (N:nat) : R := sum_f_R0 - (fun k:nat => - sum_f_R0 - (fun l:nat => - / INR (fact (S (l + k))) * x ^ S (l + k) * - (/ INR (fact (N - l)) * y ^ (N - l))) ( - pred (N - k))) (pred N). + (fun k:nat => + sum_f_R0 + (fun l:nat => + / INR (fact (S (l + k))) * x ^ S (l + k) * + (/ INR (fact (N - l)) * y ^ (N - l))) ( + pred (N - k))) (pred N). Lemma exp_form : - forall (x y:R) (n:nat), - (0 < n)%nat -> E1 x n * E1 y n - Reste_E x y n = E1 (x + y) n. -intros; unfold E1 in |- *. -rewrite cauchy_finite. -unfold Reste_E in |- *; unfold Rminus in |- *; rewrite Rplus_assoc; - rewrite Rplus_opp_r; rewrite Rplus_0_r; apply sum_eq; - intros. -rewrite binomial. -rewrite scal_sum; apply sum_eq; intros. -unfold C in |- *; unfold Rdiv in |- *; repeat rewrite Rmult_assoc; - rewrite (Rmult_comm (INR (fact i))); repeat rewrite Rmult_assoc; - rewrite <- Rinv_l_sym. -rewrite Rmult_1_r; rewrite Rinv_mult_distr. -ring. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -apply H. + forall (x y:R) (n:nat), + (0 < n)%nat -> E1 x n * E1 y n - Reste_E x y n = E1 (x + y) n. +Proof. + intros; unfold E1 in |- *. + rewrite cauchy_finite. + unfold Reste_E in |- *; unfold Rminus in |- *; rewrite Rplus_assoc; + rewrite Rplus_opp_r; rewrite Rplus_0_r; apply sum_eq; + intros. + rewrite binomial. + rewrite scal_sum; apply sum_eq; intros. + unfold C in |- *; unfold Rdiv in |- *; repeat rewrite Rmult_assoc; + rewrite (Rmult_comm (INR (fact i))); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. + rewrite Rmult_1_r; rewrite Rinv_mult_distr. + ring. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + apply H. Qed. Definition maj_Reste_E (x y:R) (N:nat) : R := 4 * (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * N) / - Rsqr (INR (fact (div2 (pred N))))). + Rsqr (INR (fact (div2 (pred N))))). Lemma Rle_Rinv : forall x y:R, 0 < x -> 0 < y -> x <= y -> / y <= / x. -intros; apply Rmult_le_reg_l with x. -apply H. -rewrite <- Rinv_r_sym. -apply Rmult_le_reg_l with y. -apply H0. -rewrite Rmult_1_r; rewrite Rmult_comm; rewrite Rmult_assoc; - rewrite <- Rinv_l_sym. -rewrite Rmult_1_r; apply H1. -red in |- *; intro; rewrite H2 in H0; elim (Rlt_irrefl _ H0). -red in |- *; intro; rewrite H2 in H; elim (Rlt_irrefl _ H). +Proof. + intros; apply Rmult_le_reg_l with x. + apply H. + rewrite <- Rinv_r_sym. + apply Rmult_le_reg_l with y. + apply H0. + rewrite Rmult_1_r; rewrite Rmult_comm; rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. + rewrite Rmult_1_r; apply H1. + red in |- *; intro; rewrite H2 in H0; elim (Rlt_irrefl _ H0). + red in |- *; intro; rewrite H2 in H; elim (Rlt_irrefl _ H). Qed. (**********) Lemma div2_double : forall N:nat, div2 (2 * N) = N. -intro; induction N as [| N HrecN]. -reflexivity. -replace (2 * S N)%nat with (S (S (2 * N))). -simpl in |- *; simpl in HrecN; rewrite HrecN; reflexivity. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. +Proof. + intro; induction N as [| N HrecN]. + reflexivity. + replace (2 * S N)%nat with (S (S (2 * N))). + simpl in |- *; simpl in HrecN; rewrite HrecN; reflexivity. + ring_nat. Qed. Lemma div2_S_double : forall N:nat, div2 (S (2 * N)) = N. -intro; induction N as [| N HrecN]. -reflexivity. -replace (2 * S N)%nat with (S (S (2 * N))). -simpl in |- *; simpl in HrecN; rewrite HrecN; reflexivity. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. +Proof. + intro; induction N as [| N HrecN]. + reflexivity. + replace (2 * S N)%nat with (S (S (2 * N))). + simpl in |- *; simpl in HrecN; rewrite HrecN; reflexivity. + ring_nat. Qed. Lemma div2_not_R0 : forall N:nat, (1 < N)%nat -> (0 < div2 N)%nat. -intros; induction N as [| N HrecN]. -elim (lt_n_O _ H). -cut ((1 < N)%nat \/ N = 1%nat). -intro; elim H0; intro. -assert (H2 := even_odd_dec N). -elim H2; intro. -rewrite <- (even_div2 _ a); apply HrecN; assumption. -rewrite <- (odd_div2 _ b); apply lt_O_Sn. -rewrite H1; simpl in |- *; apply lt_O_Sn. -inversion H. -right; reflexivity. -left; apply lt_le_trans with 2%nat; [ apply lt_n_Sn | apply H1 ]. +Proof. + intros; induction N as [| N HrecN]. + elim (lt_n_O _ H). + cut ((1 < N)%nat \/ N = 1%nat). + intro; elim H0; intro. + assert (H2 := even_odd_dec N). + elim H2; intro. + rewrite <- (even_div2 _ a); apply HrecN; assumption. + rewrite <- (odd_div2 _ b); apply lt_O_Sn. + rewrite H1; simpl in |- *; apply lt_O_Sn. + inversion H. + right; reflexivity. + left; apply lt_le_trans with 2%nat; [ apply lt_n_Sn | apply H1 ]. Qed. Lemma Reste_E_maj : - forall (x y:R) (N:nat), - (0 < N)%nat -> Rabs (Reste_E x y N) <= maj_Reste_E x y N. -intros; set (M := Rmax 1 (Rmax (Rabs x) (Rabs y))). -apply Rle_trans with - (M ^ (2 * N) * - sum_f_R0 - (fun k:nat => - sum_f_R0 (fun l:nat => / Rsqr (INR (fact (div2 (S N))))) - (pred (N - k))) (pred N)). -unfold Reste_E in |- *. -apply Rle_trans with - (sum_f_R0 - (fun k:nat => - Rabs - (sum_f_R0 - (fun l:nat => - / INR (fact (S (l + k))) * x ^ S (l + k) * - (/ INR (fact (N - l)) * y ^ (N - l))) ( - pred (N - k)))) (pred N)). -apply - (Rsum_abs - (fun k:nat => - sum_f_R0 - (fun l:nat => + forall (x y:R) (N:nat), + (0 < N)%nat -> Rabs (Reste_E x y N) <= maj_Reste_E x y N. +Proof. + intros; set (M := Rmax 1 (Rmax (Rabs x) (Rabs y))). + apply Rle_trans with + (M ^ (2 * N) * + sum_f_R0 + (fun k:nat => + sum_f_R0 (fun l:nat => / Rsqr (INR (fact (div2 (S N))))) + (pred (N - k))) (pred N)). + unfold Reste_E in |- *. + apply Rle_trans with + (sum_f_R0 + (fun k:nat => + Rabs + (sum_f_R0 + (fun l:nat => / INR (fact (S (l + k))) * x ^ S (l + k) * (/ INR (fact (N - l)) * y ^ (N - l))) ( - pred (N - k))) (pred N)). -apply Rle_trans with - (sum_f_R0 - (fun k:nat => - sum_f_R0 - (fun l:nat => - Rabs - (/ INR (fact (S (l + k))) * x ^ S (l + k) * - (/ INR (fact (N - l)) * y ^ (N - l)))) ( - pred (N - k))) (pred N)). -apply sum_Rle; intros. -apply - (Rsum_abs - (fun l:nat => - / INR (fact (S (l + n))) * x ^ S (l + n) * - (/ INR (fact (N - l)) * y ^ (N - l)))). -apply Rle_trans with - (sum_f_R0 - (fun k:nat => - sum_f_R0 - (fun l:nat => - M ^ (2 * N) * / INR (fact (S l)) * / INR (fact (N - l))) - (pred (N - k))) (pred N)). -apply sum_Rle; intros. -apply sum_Rle; intros. -repeat rewrite Rabs_mult. -do 2 rewrite <- RPow_abs. -rewrite (Rabs_right (/ INR (fact (S (n0 + n))))). -rewrite (Rabs_right (/ INR (fact (N - n0)))). -replace - (/ INR (fact (S (n0 + n))) * Rabs x ^ S (n0 + n) * - (/ INR (fact (N - n0)) * Rabs y ^ (N - n0))) with - (/ INR (fact (N - n0)) * / INR (fact (S (n0 + n))) * Rabs x ^ S (n0 + n) * - Rabs y ^ (N - n0)); [ idtac | ring ]. -rewrite <- (Rmult_comm (/ INR (fact (N - n0)))). -repeat rewrite Rmult_assoc. -apply Rmult_le_compat_l. -left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. -apply Rle_trans with - (/ INR (fact (S n0)) * Rabs x ^ S (n0 + n) * Rabs y ^ (N - n0)). -rewrite (Rmult_comm (/ INR (fact (S (n0 + n))))); - rewrite (Rmult_comm (/ INR (fact (S n0)))); repeat rewrite Rmult_assoc; - apply Rmult_le_compat_l. -apply pow_le; apply Rabs_pos. -rewrite (Rmult_comm (/ INR (fact (S n0)))); apply Rmult_le_compat_l. -apply pow_le; apply Rabs_pos. -apply Rle_Rinv. -apply INR_fact_lt_0. -apply INR_fact_lt_0. -apply le_INR; apply fact_le; apply le_n_S. -apply le_plus_l. -rewrite (Rmult_comm (M ^ (2 * N))); rewrite Rmult_assoc; - apply Rmult_le_compat_l. -left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. -apply Rle_trans with (M ^ S (n0 + n) * Rabs y ^ (N - n0)). -do 2 rewrite <- (Rmult_comm (Rabs y ^ (N - n0))). -apply Rmult_le_compat_l. -apply pow_le; apply Rabs_pos. -apply pow_incr; split. -apply Rabs_pos. -apply Rle_trans with (Rmax (Rabs x) (Rabs y)). -apply RmaxLess1. -unfold M in |- *; apply RmaxLess2. -apply Rle_trans with (M ^ S (n0 + n) * M ^ (N - n0)). -apply Rmult_le_compat_l. -apply pow_le; apply Rle_trans with 1. -left; apply Rlt_0_1. -unfold M in |- *; apply RmaxLess1. -apply pow_incr; split. -apply Rabs_pos. -apply Rle_trans with (Rmax (Rabs x) (Rabs y)). -apply RmaxLess2. -unfold M in |- *; apply RmaxLess2. -rewrite <- pow_add; replace (S (n0 + n) + (N - n0))%nat with (N + S n)%nat. -apply Rle_pow. -unfold M in |- *; apply RmaxLess1. -replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ]. -apply plus_le_compat_l. -replace N with (S (pred N)). -apply le_n_S; apply H0. -symmetry in |- *; apply S_pred with 0%nat; apply H. -apply INR_eq; do 2 rewrite plus_INR; do 2 rewrite S_INR; rewrite plus_INR; - rewrite minus_INR. -ring. -apply le_trans with (pred (N - n)). -apply H1. -apply le_S_n. -replace (S (pred (N - n))) with (N - n)%nat. -apply le_trans with N. -apply (fun p n m:nat => plus_le_reg_l n m p) with n. -rewrite <- le_plus_minus. -apply le_plus_r. -apply le_trans with (pred N). -apply H0. -apply le_pred_n. -apply le_n_Sn. -apply S_pred with 0%nat. -apply plus_lt_reg_l with n. -rewrite <- le_plus_minus. -replace (n + 0)%nat with n; [ idtac | ring ]. -apply le_lt_trans with (pred N). -apply H0. -apply lt_pred_n_n. -apply H. -apply le_trans with (pred N). -apply H0. -apply le_pred_n. -apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. -apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. -rewrite scal_sum. -apply sum_Rle; intros. -rewrite <- Rmult_comm. -rewrite scal_sum. -apply sum_Rle; intros. -rewrite (Rmult_comm (/ Rsqr (INR (fact (div2 (S N)))))). -rewrite Rmult_assoc; apply Rmult_le_compat_l. -apply pow_le. -apply Rle_trans with 1. -left; apply Rlt_0_1. -unfold M in |- *; apply RmaxLess1. -assert (H2 := even_odd_cor N). -elim H2; intros N0 H3. -elim H3; intro. -apply Rle_trans with (/ INR (fact n0) * / INR (fact (N - n0))). -do 2 rewrite <- (Rmult_comm (/ INR (fact (N - n0)))). -apply Rmult_le_compat_l. -left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. -apply Rle_Rinv. -apply INR_fact_lt_0. -apply INR_fact_lt_0. -apply le_INR. -apply fact_le. -apply le_n_Sn. -replace (/ INR (fact n0) * / INR (fact (N - n0))) with - (C N n0 / INR (fact N)). -pattern N at 1 in |- *; rewrite H4. -apply Rle_trans with (C N N0 / INR (fact N)). -unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ INR (fact N))). -apply Rmult_le_compat_l. -left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. -rewrite H4. -apply C_maj. -rewrite <- H4; apply le_trans with (pred (N - n)). -apply H1. -apply le_S_n. -replace (S (pred (N - n))) with (N - n)%nat. -apply le_trans with N. -apply (fun p n m:nat => plus_le_reg_l n m p) with n. -rewrite <- le_plus_minus. -apply le_plus_r. -apply le_trans with (pred N). -apply H0. -apply le_pred_n. -apply le_n_Sn. -apply S_pred with 0%nat. -apply plus_lt_reg_l with n. -rewrite <- le_plus_minus. -replace (n + 0)%nat with n; [ idtac | ring ]. -apply le_lt_trans with (pred N). -apply H0. -apply lt_pred_n_n. -apply H. -apply le_trans with (pred N). -apply H0. -apply le_pred_n. -replace (C N N0 / INR (fact N)) with (/ Rsqr (INR (fact N0))). -rewrite H4; rewrite div2_S_double; right; reflexivity. -unfold Rsqr, C, Rdiv in |- *. -repeat rewrite Rinv_mult_distr. -rewrite (Rmult_comm (INR (fact N))). -repeat rewrite Rmult_assoc. -rewrite <- Rinv_r_sym. -rewrite Rmult_1_r; replace (N - N0)%nat with N0. -ring. -replace N with (N0 + N0)%nat. -symmetry in |- *; apply minus_plus. -rewrite H4. -apply INR_eq; rewrite plus_INR; rewrite mult_INR; do 2 rewrite S_INR; ring. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -unfold C, Rdiv in |- *. -rewrite (Rmult_comm (INR (fact N))). -repeat rewrite Rmult_assoc. -rewrite <- Rinv_r_sym. -rewrite Rinv_mult_distr. -rewrite Rmult_1_r; ring. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -replace (/ INR (fact (S n0)) * / INR (fact (N - n0))) with - (C (S N) (S n0) / INR (fact (S N))). -apply Rle_trans with (C (S N) (S N0) / INR (fact (S N))). -unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ INR (fact (S N)))). -apply Rmult_le_compat_l. -left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. -cut (S N = (2 * S N0)%nat). -intro; rewrite H5; apply C_maj. -rewrite <- H5; apply le_n_S. -apply le_trans with (pred (N - n)). -apply H1. -apply le_S_n. -replace (S (pred (N - n))) with (N - n)%nat. -apply le_trans with N. -apply (fun p n m:nat => plus_le_reg_l n m p) with n. -rewrite <- le_plus_minus. -apply le_plus_r. -apply le_trans with (pred N). -apply H0. -apply le_pred_n. -apply le_n_Sn. -apply S_pred with 0%nat. -apply plus_lt_reg_l with n. -rewrite <- le_plus_minus. -replace (n + 0)%nat with n; [ idtac | ring ]. -apply le_lt_trans with (pred N). -apply H0. -apply lt_pred_n_n. -apply H. -apply le_trans with (pred N). -apply H0. -apply le_pred_n. -apply INR_eq; rewrite H4. -do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; ring. -cut (S N = (2 * S N0)%nat). -intro. -replace (C (S N) (S N0) / INR (fact (S N))) with (/ Rsqr (INR (fact (S N0)))). -rewrite H5; rewrite div2_double. -right; reflexivity. -unfold Rsqr, C, Rdiv in |- *. -repeat rewrite Rinv_mult_distr. -replace (S N - S N0)%nat with (S N0). -rewrite (Rmult_comm (INR (fact (S N)))). -repeat rewrite Rmult_assoc. -rewrite <- Rinv_r_sym. -rewrite Rmult_1_r; reflexivity. -apply INR_fact_neq_0. -replace (S N) with (S N0 + S N0)%nat. -symmetry in |- *; apply minus_plus. -rewrite H5; ring. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -apply INR_eq; rewrite H4; do 2 rewrite S_INR; do 2 rewrite mult_INR; - repeat rewrite S_INR; ring. -unfold C, Rdiv in |- *. -rewrite (Rmult_comm (INR (fact (S N)))). -rewrite Rmult_assoc; rewrite <- Rinv_r_sym. -rewrite Rmult_1_r; rewrite Rinv_mult_distr. -reflexivity. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -unfold maj_Reste_E in |- *. -unfold Rdiv in |- *; rewrite (Rmult_comm 4). -rewrite Rmult_assoc. -apply Rmult_le_compat_l. -apply pow_le. -apply Rle_trans with 1. -left; apply Rlt_0_1. -apply RmaxLess1. -apply Rle_trans with - (sum_f_R0 (fun k:nat => INR (N - k) * / Rsqr (INR (fact (div2 (S N))))) - (pred N)). -apply sum_Rle; intros. -rewrite sum_cte. -replace (S (pred (N - n))) with (N - n)%nat. -right; apply Rmult_comm. -apply S_pred with 0%nat. -apply plus_lt_reg_l with n. -rewrite <- le_plus_minus. -replace (n + 0)%nat with n; [ idtac | ring ]. -apply le_lt_trans with (pred N). -apply H0. -apply lt_pred_n_n. -apply H. -apply le_trans with (pred N). -apply H0. -apply le_pred_n. -apply Rle_trans with - (sum_f_R0 (fun k:nat => INR N * / Rsqr (INR (fact (div2 (S N))))) (pred N)). -apply sum_Rle; intros. -do 2 rewrite <- (Rmult_comm (/ Rsqr (INR (fact (div2 (S N)))))). -apply Rmult_le_compat_l. -left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt. -apply INR_fact_neq_0. -apply le_INR. -apply (fun p n m:nat => plus_le_reg_l n m p) with n. -rewrite <- le_plus_minus. -apply le_plus_r. -apply le_trans with (pred N). -apply H0. -apply le_pred_n. -rewrite sum_cte; replace (S (pred N)) with N. -cut (div2 (S N) = S (div2 (pred N))). -intro; rewrite H0. -rewrite fact_simpl; rewrite mult_comm; rewrite mult_INR; rewrite Rsqr_mult. -rewrite Rinv_mult_distr. -rewrite (Rmult_comm (INR N)); repeat rewrite Rmult_assoc; - apply Rmult_le_compat_l. -left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt; apply INR_fact_neq_0. -rewrite <- H0. -cut (INR N <= INR (2 * div2 (S N))). -intro; apply Rmult_le_reg_l with (Rsqr (INR (div2 (S N)))). -apply Rsqr_pos_lt. -apply not_O_INR; red in |- *; intro. -cut (1 < S N)%nat. -intro; assert (H4 := div2_not_R0 _ H3). -rewrite H2 in H4; elim (lt_n_O _ H4). -apply lt_n_S; apply H. -repeat rewrite <- Rmult_assoc. -rewrite <- Rinv_r_sym. -rewrite Rmult_1_l. -replace (INR N * INR N) with (Rsqr (INR N)); [ idtac | reflexivity ]. -rewrite Rmult_assoc. -rewrite Rmult_comm. -replace 4 with (Rsqr 2); [ idtac | ring_Rsqr ]. -rewrite <- Rsqr_mult. -apply Rsqr_incr_1. -replace 2 with (INR 2). -rewrite <- mult_INR; apply H1. -reflexivity. -left; apply lt_INR_0; apply H. -left; apply Rmult_lt_0_compat. -prove_sup0. -apply lt_INR_0; apply div2_not_R0. -apply lt_n_S; apply H. -cut (1 < S N)%nat. -intro; unfold Rsqr in |- *; apply prod_neq_R0; apply not_O_INR; intro; - assert (H4 := div2_not_R0 _ H2); rewrite H3 in H4; - elim (lt_n_O _ H4). -apply lt_n_S; apply H. -assert (H1 := even_odd_cor N). -elim H1; intros N0 H2. -elim H2; intro. -pattern N at 2 in |- *; rewrite H3. -rewrite div2_S_double. -right; rewrite H3; reflexivity. -pattern N at 2 in |- *; rewrite H3. -replace (S (S (2 * N0))) with (2 * S N0)%nat. -rewrite div2_double. -rewrite H3. -rewrite S_INR; do 2 rewrite mult_INR. -rewrite (S_INR N0). -rewrite Rmult_plus_distr_l. -apply Rplus_le_compat_l. -rewrite Rmult_1_r. -simpl in |- *. -pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; - apply Rlt_0_1. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. -unfold Rsqr in |- *; apply prod_neq_R0; apply INR_fact_neq_0. -unfold Rsqr in |- *; apply prod_neq_R0; apply not_O_INR; discriminate. -assert (H0 := even_odd_cor N). -elim H0; intros N0 H1. -elim H1; intro. -cut (0 < N0)%nat. -intro; rewrite H2. -rewrite div2_S_double. -replace (2 * N0)%nat with (S (S (2 * pred N0))). -replace (pred (S (S (2 * pred N0)))) with (S (2 * pred N0)). -rewrite div2_S_double. -apply S_pred with 0%nat; apply H3. -reflexivity. -replace N0 with (S (pred N0)). -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. -symmetry in |- *; apply S_pred with 0%nat; apply H3. -rewrite H2 in H. -apply neq_O_lt. -red in |- *; intro. -rewrite <- H3 in H. -simpl in H. -elim (lt_n_O _ H). -rewrite H2. -replace (pred (S (2 * N0))) with (2 * N0)%nat; [ idtac | reflexivity ]. -replace (S (S (2 * N0))) with (2 * S N0)%nat. -do 2 rewrite div2_double. -reflexivity. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. -apply S_pred with 0%nat; apply H. + pred (N - k)))) (pred N)). + apply + (Rsum_abs + (fun k:nat => + sum_f_R0 + (fun l:nat => + / INR (fact (S (l + k))) * x ^ S (l + k) * + (/ INR (fact (N - l)) * y ^ (N - l))) ( + pred (N - k))) (pred N)). + apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + Rabs + (/ INR (fact (S (l + k))) * x ^ S (l + k) * + (/ INR (fact (N - l)) * y ^ (N - l)))) ( + pred (N - k))) (pred N)). + apply sum_Rle; intros. + apply + (Rsum_abs + (fun l:nat => + / INR (fact (S (l + n))) * x ^ S (l + n) * + (/ INR (fact (N - l)) * y ^ (N - l)))). + apply Rle_trans with + (sum_f_R0 + (fun k:nat => + sum_f_R0 + (fun l:nat => + M ^ (2 * N) * / INR (fact (S l)) * / INR (fact (N - l))) + (pred (N - k))) (pred N)). + apply sum_Rle; intros. + apply sum_Rle; intros. + repeat rewrite Rabs_mult. + do 2 rewrite <- RPow_abs. + rewrite (Rabs_right (/ INR (fact (S (n0 + n))))). + rewrite (Rabs_right (/ INR (fact (N - n0)))). + replace + (/ INR (fact (S (n0 + n))) * Rabs x ^ S (n0 + n) * + (/ INR (fact (N - n0)) * Rabs y ^ (N - n0))) with + (/ INR (fact (N - n0)) * / INR (fact (S (n0 + n))) * Rabs x ^ S (n0 + n) * + Rabs y ^ (N - n0)); [ idtac | ring ]. + rewrite <- (Rmult_comm (/ INR (fact (N - n0)))). + repeat rewrite Rmult_assoc. + apply Rmult_le_compat_l. + left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. + apply Rle_trans with + (/ INR (fact (S n0)) * Rabs x ^ S (n0 + n) * Rabs y ^ (N - n0)). + rewrite (Rmult_comm (/ INR (fact (S (n0 + n))))); + rewrite (Rmult_comm (/ INR (fact (S n0)))); repeat rewrite Rmult_assoc; + apply Rmult_le_compat_l. + apply pow_le; apply Rabs_pos. + rewrite (Rmult_comm (/ INR (fact (S n0)))); apply Rmult_le_compat_l. + apply pow_le; apply Rabs_pos. + apply Rle_Rinv. + apply INR_fact_lt_0. + apply INR_fact_lt_0. + apply le_INR; apply fact_le; apply le_n_S. + apply le_plus_l. + rewrite (Rmult_comm (M ^ (2 * N))); rewrite Rmult_assoc; + apply Rmult_le_compat_l. + left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. + apply Rle_trans with (M ^ S (n0 + n) * Rabs y ^ (N - n0)). + do 2 rewrite <- (Rmult_comm (Rabs y ^ (N - n0))). + apply Rmult_le_compat_l. + apply pow_le; apply Rabs_pos. + apply pow_incr; split. + apply Rabs_pos. + apply Rle_trans with (Rmax (Rabs x) (Rabs y)). + apply RmaxLess1. + unfold M in |- *; apply RmaxLess2. + apply Rle_trans with (M ^ S (n0 + n) * M ^ (N - n0)). + apply Rmult_le_compat_l. + apply pow_le; apply Rle_trans with 1. + left; apply Rlt_0_1. + unfold M in |- *; apply RmaxLess1. + apply pow_incr; split. + apply Rabs_pos. + apply Rle_trans with (Rmax (Rabs x) (Rabs y)). + apply RmaxLess2. + unfold M in |- *; apply RmaxLess2. + rewrite <- pow_add; replace (S (n0 + n) + (N - n0))%nat with (N + S n)%nat. + apply Rle_pow. + unfold M in |- *; apply RmaxLess1. + replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ]. + apply plus_le_compat_l. + replace N with (S (pred N)). + apply le_n_S; apply H0. + symmetry in |- *; apply S_pred with 0%nat; apply H. + apply INR_eq; do 2 rewrite plus_INR; do 2 rewrite S_INR; rewrite plus_INR; + rewrite minus_INR. + ring. + apply le_trans with (pred (N - n)). + apply H1. + apply le_S_n. + replace (S (pred (N - n))) with (N - n)%nat. + apply le_trans with N. + apply (fun p n m:nat => plus_le_reg_l n m p) with n. + rewrite <- le_plus_minus. + apply le_plus_r. + apply le_trans with (pred N). + apply H0. + apply le_pred_n. + apply le_n_Sn. + apply S_pred with 0%nat. + apply plus_lt_reg_l with n. + rewrite <- le_plus_minus. + replace (n + 0)%nat with n; [ idtac | ring ]. + apply le_lt_trans with (pred N). + apply H0. + apply lt_pred_n_n. + apply H. + apply le_trans with (pred N). + apply H0. + apply le_pred_n. + apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. + apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. + rewrite scal_sum. + apply sum_Rle; intros. + rewrite <- Rmult_comm. + rewrite scal_sum. + apply sum_Rle; intros. + rewrite (Rmult_comm (/ Rsqr (INR (fact (div2 (S N)))))). + rewrite Rmult_assoc; apply Rmult_le_compat_l. + apply pow_le. + apply Rle_trans with 1. + left; apply Rlt_0_1. + unfold M in |- *; apply RmaxLess1. + assert (H2 := even_odd_cor N). + elim H2; intros N0 H3. + elim H3; intro. + apply Rle_trans with (/ INR (fact n0) * / INR (fact (N - n0))). + do 2 rewrite <- (Rmult_comm (/ INR (fact (N - n0)))). + apply Rmult_le_compat_l. + left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. + apply Rle_Rinv. + apply INR_fact_lt_0. + apply INR_fact_lt_0. + apply le_INR. + apply fact_le. + apply le_n_Sn. + replace (/ INR (fact n0) * / INR (fact (N - n0))) with + (C N n0 / INR (fact N)). + pattern N at 1 in |- *; rewrite H4. + apply Rle_trans with (C N N0 / INR (fact N)). + unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ INR (fact N))). + apply Rmult_le_compat_l. + left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. + rewrite H4. + apply C_maj. + rewrite <- H4; apply le_trans with (pred (N - n)). + apply H1. + apply le_S_n. + replace (S (pred (N - n))) with (N - n)%nat. + apply le_trans with N. + apply (fun p n m:nat => plus_le_reg_l n m p) with n. + rewrite <- le_plus_minus. + apply le_plus_r. + apply le_trans with (pred N). + apply H0. + apply le_pred_n. + apply le_n_Sn. + apply S_pred with 0%nat. + apply plus_lt_reg_l with n. + rewrite <- le_plus_minus. + replace (n + 0)%nat with n; [ idtac | ring ]. + apply le_lt_trans with (pred N). + apply H0. + apply lt_pred_n_n. + apply H. + apply le_trans with (pred N). + apply H0. + apply le_pred_n. + replace (C N N0 / INR (fact N)) with (/ Rsqr (INR (fact N0))). + rewrite H4; rewrite div2_S_double; right; reflexivity. + unfold Rsqr, C, Rdiv in |- *. + repeat rewrite Rinv_mult_distr. + rewrite (Rmult_comm (INR (fact N))). + repeat rewrite Rmult_assoc. + rewrite <- Rinv_r_sym. + rewrite Rmult_1_r; replace (N - N0)%nat with N0. + ring. + replace N with (N0 + N0)%nat. + symmetry in |- *; apply minus_plus. + rewrite H4. + ring. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + unfold C, Rdiv in |- *. + rewrite (Rmult_comm (INR (fact N))). + repeat rewrite Rmult_assoc. + rewrite <- Rinv_r_sym. + rewrite Rinv_mult_distr. + rewrite Rmult_1_r; ring. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + replace (/ INR (fact (S n0)) * / INR (fact (N - n0))) with + (C (S N) (S n0) / INR (fact (S N))). + apply Rle_trans with (C (S N) (S N0) / INR (fact (S N))). + unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ INR (fact (S N)))). + apply Rmult_le_compat_l. + left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. + cut (S N = (2 * S N0)%nat). + intro; rewrite H5; apply C_maj. + rewrite <- H5; apply le_n_S. + apply le_trans with (pred (N - n)). + apply H1. + apply le_S_n. + replace (S (pred (N - n))) with (N - n)%nat. + apply le_trans with N. + apply (fun p n m:nat => plus_le_reg_l n m p) with n. + rewrite <- le_plus_minus. + apply le_plus_r. + apply le_trans with (pred N). + apply H0. + apply le_pred_n. + apply le_n_Sn. + apply S_pred with 0%nat. + apply plus_lt_reg_l with n. + rewrite <- le_plus_minus. + replace (n + 0)%nat with n; [ idtac | ring ]. + apply le_lt_trans with (pred N). + apply H0. + apply lt_pred_n_n. + apply H. + apply le_trans with (pred N). + apply H0. + apply le_pred_n. + rewrite H4; ring_nat. + cut (S N = (2 * S N0)%nat). + intro. + replace (C (S N) (S N0) / INR (fact (S N))) with (/ Rsqr (INR (fact (S N0)))). + rewrite H5; rewrite div2_double. + right; reflexivity. + unfold Rsqr, C, Rdiv in |- *. + repeat rewrite Rinv_mult_distr. + replace (S N - S N0)%nat with (S N0). + rewrite (Rmult_comm (INR (fact (S N)))). + repeat rewrite Rmult_assoc. + rewrite <- Rinv_r_sym. + rewrite Rmult_1_r; reflexivity. + apply INR_fact_neq_0. + replace (S N) with (S N0 + S N0)%nat. + symmetry in |- *; apply minus_plus. + rewrite H5; ring. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + rewrite H4; ring_nat. + unfold C, Rdiv in |- *. + rewrite (Rmult_comm (INR (fact (S N)))). + rewrite Rmult_assoc; rewrite <- Rinv_r_sym. + rewrite Rmult_1_r; rewrite Rinv_mult_distr. + reflexivity. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + unfold maj_Reste_E in |- *. + unfold Rdiv in |- *; rewrite (Rmult_comm 4). + rewrite Rmult_assoc. + apply Rmult_le_compat_l. + apply pow_le. + apply Rle_trans with 1. + left; apply Rlt_0_1. + apply RmaxLess1. + apply Rle_trans with + (sum_f_R0 (fun k:nat => INR (N - k) * / Rsqr (INR (fact (div2 (S N))))) + (pred N)). + apply sum_Rle; intros. + rewrite sum_cte. + replace (S (pred (N - n))) with (N - n)%nat. + right; apply Rmult_comm. + apply S_pred with 0%nat. + apply plus_lt_reg_l with n. + rewrite <- le_plus_minus. + replace (n + 0)%nat with n; [ idtac | ring ]. + apply le_lt_trans with (pred N). + apply H0. + apply lt_pred_n_n. + apply H. + apply le_trans with (pred N). + apply H0. + apply le_pred_n. + apply Rle_trans with + (sum_f_R0 (fun k:nat => INR N * / Rsqr (INR (fact (div2 (S N))))) (pred N)). + apply sum_Rle; intros. + do 2 rewrite <- (Rmult_comm (/ Rsqr (INR (fact (div2 (S N)))))). + apply Rmult_le_compat_l. + left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt. + apply INR_fact_neq_0. + apply le_INR. + apply (fun p n m:nat => plus_le_reg_l n m p) with n. + rewrite <- le_plus_minus. + apply le_plus_r. + apply le_trans with (pred N). + apply H0. + apply le_pred_n. + rewrite sum_cte; replace (S (pred N)) with N. + cut (div2 (S N) = S (div2 (pred N))). + intro; rewrite H0. + rewrite fact_simpl; rewrite mult_comm; rewrite mult_INR; rewrite Rsqr_mult. + rewrite Rinv_mult_distr. + rewrite (Rmult_comm (INR N)); repeat rewrite Rmult_assoc; + apply Rmult_le_compat_l. + left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt; apply INR_fact_neq_0. + rewrite <- H0. + cut (INR N <= INR (2 * div2 (S N))). + intro; apply Rmult_le_reg_l with (Rsqr (INR (div2 (S N)))). + apply Rsqr_pos_lt. + apply not_O_INR; red in |- *; intro. + cut (1 < S N)%nat. + intro; assert (H4 := div2_not_R0 _ H3). + rewrite H2 in H4; elim (lt_n_O _ H4). + apply lt_n_S; apply H. + repeat rewrite <- Rmult_assoc. + rewrite <- Rinv_r_sym. + rewrite Rmult_1_l. + replace (INR N * INR N) with (Rsqr (INR N)); [ idtac | reflexivity ]. + rewrite Rmult_assoc. + rewrite Rmult_comm. + replace 4 with (Rsqr 2); [ idtac | ring_Rsqr ]. + rewrite <- Rsqr_mult. + apply Rsqr_incr_1. + replace 2 with (INR 2). + rewrite <- mult_INR; apply H1. + reflexivity. + left; apply lt_INR_0; apply H. + left; apply Rmult_lt_0_compat. + prove_sup0. + apply lt_INR_0; apply div2_not_R0. + apply lt_n_S; apply H. + cut (1 < S N)%nat. + intro; unfold Rsqr in |- *; apply prod_neq_R0; apply not_O_INR; intro; + assert (H4 := div2_not_R0 _ H2); rewrite H3 in H4; + elim (lt_n_O _ H4). + apply lt_n_S; apply H. + assert (H1 := even_odd_cor N). + elim H1; intros N0 H2. + elim H2; intro. + pattern N at 2 in |- *; rewrite H3. + rewrite div2_S_double. + right; rewrite H3; reflexivity. + pattern N at 2 in |- *; rewrite H3. + replace (S (S (2 * N0))) with (2 * S N0)%nat. + rewrite div2_double. + rewrite H3. + rewrite S_INR; do 2 rewrite mult_INR. + rewrite (S_INR N0). + rewrite Rmult_plus_distr_l. + apply Rplus_le_compat_l. + rewrite Rmult_1_r. + simpl in |- *. + pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; + apply Rlt_0_1. + ring_nat. + unfold Rsqr in |- *; apply prod_neq_R0; apply INR_fact_neq_0. + unfold Rsqr in |- *; apply prod_neq_R0; apply not_O_INR; discriminate. + assert (H0 := even_odd_cor N). + elim H0; intros N0 H1. + elim H1; intro. + cut (0 < N0)%nat. + intro; rewrite H2. + rewrite div2_S_double. + replace (2 * N0)%nat with (S (S (2 * pred N0))). + replace (pred (S (S (2 * pred N0)))) with (S (2 * pred N0)). + rewrite div2_S_double. + apply S_pred with 0%nat; apply H3. + reflexivity. + omega. + omega. + rewrite H2. + replace (pred (S (2 * N0))) with (2 * N0)%nat; [ idtac | reflexivity ]. + replace (S (S (2 * N0))) with (2 * S N0)%nat. + do 2 rewrite div2_double. + reflexivity. + ring_nat. + apply S_pred with 0%nat; apply H. Qed. Lemma maj_Reste_cv_R0 : forall x y:R, Un_cv (maj_Reste_E x y) 0. -intros; assert (H := Majxy_cv_R0 x y). -unfold Un_cv in H; unfold Un_cv in |- *; intros. -cut (0 < eps / 4); - [ intro - | unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. -elim (H _ H1); intros N0 H2. -exists (max (2 * S N0) 2); intros. -unfold R_dist in H2; unfold R_dist in |- *; rewrite Rminus_0_r; - unfold Majxy in H2; unfold maj_Reste_E in |- *. -rewrite Rabs_right. -apply Rle_lt_trans with - (4 * +Proof. + intros; assert (H := Majxy_cv_R0 x y). + unfold Un_cv in H; unfold Un_cv in |- *; intros. + cut (0 < eps / 4); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. + elim (H _ H1); intros N0 H2. + exists (max (2 * S N0) 2); intros. + unfold R_dist in H2; unfold R_dist in |- *; rewrite Rminus_0_r; + unfold Majxy in H2; unfold maj_Reste_E in |- *. + rewrite Rabs_right. + apply Rle_lt_trans with + (4 * + (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n))) / + INR (fact (div2 (pred n))))). + apply Rmult_le_compat_l. + left; prove_sup0. + unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr. + rewrite (Rmult_comm (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n))); + rewrite + (Rmult_comm (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n))))) + ; rewrite Rmult_assoc; apply Rmult_le_compat_l. + left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. + apply Rle_trans with (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n)). + rewrite Rmult_comm; + pattern (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n)) at 2 in |- *; + rewrite <- Rmult_1_r; apply Rmult_le_compat_l. + apply pow_le; apply Rle_trans with 1. + left; apply Rlt_0_1. + apply RmaxLess1. + apply Rmult_le_reg_l with (INR (fact (div2 (pred n)))). + apply INR_fact_lt_0. + rewrite Rmult_1_r; rewrite <- Rinv_r_sym. + replace 1 with (INR 1); [ apply le_INR | reflexivity ]. + apply lt_le_S. + apply INR_lt. + apply INR_fact_lt_0. + apply INR_fact_neq_0. + apply Rle_pow. + apply RmaxLess1. + assert (H4 := even_odd_cor n). + elim H4; intros N1 H5. + elim H5; intro. + cut (0 < N1)%nat. + intro. + rewrite H6. + replace (pred (2 * N1)) with (S (2 * pred N1)). + rewrite div2_S_double. + omega. + omega. + assert (0 < n)%nat. + apply lt_le_trans with 2%nat. + apply lt_O_Sn. + apply le_trans with (max (2 * S N0) 2). + apply le_max_r. + apply H3. + omega. + rewrite H6. + replace (pred (S (2 * N1))) with (2 * N1)%nat. + rewrite div2_double. + replace (4 * S N1)%nat with (2 * (2 * S N1))%nat. + apply (fun m n p:nat => mult_le_compat_l p n m). + replace (2 * S N1)%nat with (S (S (2 * N1))). + apply le_n_Sn. + ring_nat. + ring_nat. + reflexivity. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + apply Rmult_lt_reg_l with (/ 4). + apply Rinv_0_lt_compat; prove_sup0. + rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_l; rewrite Rmult_comm. + replace (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n))) / - INR (fact (div2 (pred n))))). -apply Rmult_le_compat_l. -left; prove_sup0. -unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr. -rewrite (Rmult_comm (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n))); - rewrite - (Rmult_comm (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n))))) - ; rewrite Rmult_assoc; apply Rmult_le_compat_l. -left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. -apply Rle_trans with (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n)). -rewrite Rmult_comm; - pattern (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n)) at 2 in |- *; - rewrite <- Rmult_1_r; apply Rmult_le_compat_l. -apply pow_le; apply Rle_trans with 1. -left; apply Rlt_0_1. -apply RmaxLess1. -apply Rmult_le_reg_l with (INR (fact (div2 (pred n)))). -apply INR_fact_lt_0. -rewrite Rmult_1_r; rewrite <- Rinv_r_sym. -replace 1 with (INR 1); [ apply le_INR | reflexivity ]. -apply lt_le_S. -apply INR_lt. -apply INR_fact_lt_0. -apply INR_fact_neq_0. -apply Rle_pow. -apply RmaxLess1. -assert (H4 := even_odd_cor n). -elim H4; intros N1 H5. -elim H5; intro. -cut (0 < N1)%nat. -intro. -rewrite H6. -replace (pred (2 * N1)) with (S (2 * pred N1)). -rewrite div2_S_double. -replace (S (pred N1)) with N1. -apply INR_le. -right. -do 3 rewrite mult_INR; repeat rewrite S_INR; ring. -apply S_pred with 0%nat; apply H7. -replace (2 * N1)%nat with (S (S (2 * pred N1))). -reflexivity. -pattern N1 at 2 in |- *; replace N1 with (S (pred N1)). -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. -symmetry in |- *; apply S_pred with 0%nat; apply H7. -apply INR_lt. -apply Rmult_lt_reg_l with (INR 2). -simpl in |- *; prove_sup0. -rewrite Rmult_0_r; rewrite <- mult_INR. -apply lt_INR_0. -rewrite <- H6. -apply lt_le_trans with 2%nat. -apply lt_O_Sn. -apply le_trans with (max (2 * S N0) 2). -apply le_max_r. -apply H3. -rewrite H6. -replace (pred (S (2 * N1))) with (2 * N1)%nat. -rewrite div2_double. -replace (4 * S N1)%nat with (2 * (2 * S N1))%nat. -apply (fun m n p:nat => mult_le_compat_l p n m). -replace (2 * S N1)%nat with (S (S (2 * N1))). -apply le_n_Sn. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. -ring. -reflexivity. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -apply Rmult_lt_reg_l with (/ 4). -apply Rinv_0_lt_compat; prove_sup0. -rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_l; rewrite Rmult_comm. -replace - (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n))) / - INR (fact (div2 (pred n)))) with - (Rabs + INR (fact (div2 (pred n)))) with + (Rabs (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n))) / - INR (fact (div2 (pred n))) - 0)). -apply H2; unfold ge in |- *. -cut (2 * S N0 <= n)%nat. -intro; apply le_S_n. -apply INR_le; apply Rmult_le_reg_l with (INR 2). -simpl in |- *; prove_sup0. -do 2 rewrite <- mult_INR; apply le_INR. -apply le_trans with n. -apply H4. -assert (H5 := even_odd_cor n). -elim H5; intros N1 H6. -elim H6; intro. -cut (0 < N1)%nat. -intro. -rewrite H7. -apply (fun m n p:nat => mult_le_compat_l p n m). -replace (pred (2 * N1)) with (S (2 * pred N1)). -rewrite div2_S_double. -replace (S (pred N1)) with N1. -apply le_n. -apply S_pred with 0%nat; apply H8. -replace (2 * N1)%nat with (S (S (2 * pred N1))). -reflexivity. -pattern N1 at 2 in |- *; replace N1 with (S (pred N1)). -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. -symmetry in |- *; apply S_pred with 0%nat; apply H8. -apply INR_lt. -apply Rmult_lt_reg_l with (INR 2). -simpl in |- *; prove_sup0. -rewrite Rmult_0_r; rewrite <- mult_INR. -apply lt_INR_0. -rewrite <- H7. -apply lt_le_trans with 2%nat. -apply lt_O_Sn. -apply le_trans with (max (2 * S N0) 2). -apply le_max_r. -apply H3. -rewrite H7. -replace (pred (S (2 * N1))) with (2 * N1)%nat. -rewrite div2_double. -replace (2 * S N1)%nat with (S (S (2 * N1))). -apply le_n_Sn. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. -reflexivity. -apply le_trans with (max (2 * S N0) 2). -apply le_max_l. -apply H3. -rewrite Rminus_0_r; apply Rabs_right. -apply Rle_ge. -unfold Rdiv in |- *; repeat apply Rmult_le_pos. -apply pow_le. -apply Rle_trans with 1. -left; apply Rlt_0_1. -apply RmaxLess1. -left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. -discrR. -apply Rle_ge. -unfold Rdiv in |- *; apply Rmult_le_pos. -left; prove_sup0. -apply Rmult_le_pos. -apply pow_le. -apply Rle_trans with 1. -left; apply Rlt_0_1. -apply RmaxLess1. -left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt; apply INR_fact_neq_0. + INR (fact (div2 (pred n))) - 0)). + apply H2; unfold ge in |- *. + cut (2 * S N0 <= n)%nat. + intro; apply le_S_n. + apply INR_le; apply Rmult_le_reg_l with (INR 2). + simpl in |- *; prove_sup0. + do 2 rewrite <- mult_INR; apply le_INR. + apply le_trans with n. + apply H4. + assert (H5 := even_odd_cor n). + elim H5; intros N1 H6. + elim H6; intro. + cut (0 < N1)%nat. + intro. + rewrite H7. + apply (fun m n p:nat => mult_le_compat_l p n m). + replace (pred (2 * N1)) with (S (2 * pred N1)). + rewrite div2_S_double. + replace (S (pred N1)) with N1. + apply le_n. + apply S_pred with 0%nat; apply H8. + replace (2 * N1)%nat with (S (S (2 * pred N1))). + reflexivity. + pattern N1 at 2 in |- *; replace N1 with (S (pred N1)). + ring_nat. + symmetry in |- *; apply S_pred with 0%nat; apply H8. + apply INR_lt. + apply Rmult_lt_reg_l with (INR 2). + simpl in |- *; prove_sup0. + rewrite Rmult_0_r; rewrite <- mult_INR. + apply lt_INR_0. + rewrite <- H7. + apply lt_le_trans with 2%nat. + apply lt_O_Sn. + apply le_trans with (max (2 * S N0) 2). + apply le_max_r. + apply H3. + rewrite H7. + replace (pred (S (2 * N1))) with (2 * N1)%nat. + rewrite div2_double. + replace (2 * S N1)%nat with (S (S (2 * N1))). + apply le_n_Sn. + ring_nat. + reflexivity. + apply le_trans with (max (2 * S N0) 2). + apply le_max_l. + apply H3. + rewrite Rminus_0_r; apply Rabs_right. + apply Rle_ge. + unfold Rdiv in |- *; repeat apply Rmult_le_pos. + apply pow_le. + apply Rle_trans with 1. + left; apply Rlt_0_1. + apply RmaxLess1. + left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. + discrR. + apply Rle_ge. + unfold Rdiv in |- *; apply Rmult_le_pos. + left; prove_sup0. + apply Rmult_le_pos. + apply pow_le. + apply Rle_trans with 1. + left; apply Rlt_0_1. + apply RmaxLess1. + left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt; apply INR_fact_neq_0. Qed. (**********) Lemma Reste_E_cv : forall x y:R, Un_cv (Reste_E x y) 0. -intros; assert (H := maj_Reste_cv_R0 x y). -unfold Un_cv in H; unfold Un_cv in |- *; intros; elim (H _ H0); intros. -exists (max x0 1); intros. -unfold R_dist in |- *; rewrite Rminus_0_r. -apply Rle_lt_trans with (maj_Reste_E x y n). -apply Reste_E_maj. -apply lt_le_trans with 1%nat. -apply lt_O_Sn. -apply le_trans with (max x0 1). -apply le_max_r. -apply H2. -replace (maj_Reste_E x y n) with (R_dist (maj_Reste_E x y n) 0). -apply H1. -unfold ge in |- *; apply le_trans with (max x0 1). -apply le_max_l. -apply H2. -unfold R_dist in |- *; rewrite Rminus_0_r; apply Rabs_right. -apply Rle_ge; apply Rle_trans with (Rabs (Reste_E x y n)). -apply Rabs_pos. -apply Reste_E_maj. -apply lt_le_trans with 1%nat. -apply lt_O_Sn. -apply le_trans with (max x0 1). -apply le_max_r. -apply H2. +Proof. + intros; assert (H := maj_Reste_cv_R0 x y). + unfold Un_cv in H; unfold Un_cv in |- *; intros; elim (H _ H0); intros. + exists (max x0 1); intros. + unfold R_dist in |- *; rewrite Rminus_0_r. + apply Rle_lt_trans with (maj_Reste_E x y n). + apply Reste_E_maj. + apply lt_le_trans with 1%nat. + apply lt_O_Sn. + apply le_trans with (max x0 1). + apply le_max_r. + apply H2. + replace (maj_Reste_E x y n) with (R_dist (maj_Reste_E x y n) 0). + apply H1. + unfold ge in |- *; apply le_trans with (max x0 1). + apply le_max_l. + apply H2. + unfold R_dist in |- *; rewrite Rminus_0_r; apply Rabs_right. + apply Rle_ge; apply Rle_trans with (Rabs (Reste_E x y n)). + apply Rabs_pos. + apply Reste_E_maj. + apply lt_le_trans with 1%nat. + apply lt_O_Sn. + apply le_trans with (max x0 1). + apply le_max_r. + apply H2. Qed. (**********) Lemma exp_plus : forall x y:R, exp (x + y) = exp x * exp y. -intros; assert (H0 := E1_cvg x). -assert (H := E1_cvg y). -assert (H1 := E1_cvg (x + y)). -eapply UL_sequence. -apply H1. -assert (H2 := CV_mult _ _ _ _ H0 H). -assert (H3 := CV_minus _ _ _ _ H2 (Reste_E_cv x y)). -unfold Un_cv in |- *; unfold Un_cv in H3; intros. -elim (H3 _ H4); intros. -exists (S x0); intros. -rewrite <- (exp_form x y n). -rewrite Rminus_0_r in H5. -apply H5. -unfold ge in |- *; apply le_trans with (S x0). -apply le_n_Sn. -apply H6. -apply lt_le_trans with (S x0). -apply lt_O_Sn. -apply H6. +Proof. + intros; assert (H0 := E1_cvg x). + assert (H := E1_cvg y). + assert (H1 := E1_cvg (x + y)). + eapply UL_sequence. + apply H1. + assert (H2 := CV_mult _ _ _ _ H0 H). + assert (H3 := CV_minus _ _ _ _ H2 (Reste_E_cv x y)). + unfold Un_cv in |- *; unfold Un_cv in H3; intros. + elim (H3 _ H4); intros. + exists (S x0); intros. + rewrite <- (exp_form x y n). + rewrite Rminus_0_r in H5. + apply H5. + unfold ge in |- *; apply le_trans with (S x0). + apply le_n_Sn. + apply H6. + apply lt_le_trans with (S x0). + apply lt_O_Sn. + apply H6. Qed. (**********) Lemma exp_pos_pos : forall x:R, 0 < x -> 0 < exp x. -intros; set (An := fun N:nat => / INR (fact N) * x ^ N). -cut (Un_cv (fun n:nat => sum_f_R0 An n) (exp x)). -intro; apply Rlt_le_trans with (sum_f_R0 An 0). -unfold An in |- *; simpl in |- *; rewrite Rinv_1; rewrite Rmult_1_r; - apply Rlt_0_1. -apply sum_incr. -assumption. -intro; unfold An in |- *; left; apply Rmult_lt_0_compat. -apply Rinv_0_lt_compat; apply INR_fact_lt_0. -apply (pow_lt _ n H). -unfold exp in |- *; unfold projT1 in |- *; case (exist_exp x); intro. -unfold exp_in in |- *; unfold infinit_sum, Un_cv in |- *; trivial. +Proof. + intros; set (An := fun N:nat => / INR (fact N) * x ^ N). + cut (Un_cv (fun n:nat => sum_f_R0 An n) (exp x)). + intro; apply Rlt_le_trans with (sum_f_R0 An 0). + unfold An in |- *; simpl in |- *; rewrite Rinv_1; rewrite Rmult_1_r; + apply Rlt_0_1. + apply sum_incr. + assumption. + intro; unfold An in |- *; left; apply Rmult_lt_0_compat. + apply Rinv_0_lt_compat; apply INR_fact_lt_0. + apply (pow_lt _ n H). + unfold exp in |- *; unfold projT1 in |- *; case (exist_exp x); intro. + unfold exp_in in |- *; unfold infinit_sum, Un_cv in |- *; trivial. Qed. (**********) Lemma exp_pos : forall x:R, 0 < exp x. -intro; case (total_order_T 0 x); intro. -elim s; intro. -apply (exp_pos_pos _ a). -rewrite <- b; rewrite exp_0; apply Rlt_0_1. -replace (exp x) with (1 / exp (- x)). -unfold Rdiv in |- *; apply Rmult_lt_0_compat. -apply Rlt_0_1. -apply Rinv_0_lt_compat; apply exp_pos_pos. -apply (Ropp_0_gt_lt_contravar _ r). -cut (exp (- x) <> 0). -intro; unfold Rdiv in |- *; apply Rmult_eq_reg_l with (exp (- x)). -rewrite Rmult_1_l; rewrite <- Rinv_r_sym. -rewrite <- exp_plus. -rewrite Rplus_opp_l; rewrite exp_0; reflexivity. -apply H. -apply H. -assert (H := exp_plus x (- x)). -rewrite Rplus_opp_r in H; rewrite exp_0 in H. -red in |- *; intro; rewrite H0 in H. -rewrite Rmult_0_r in H. -elim R1_neq_R0; assumption. +Proof. + intro; case (total_order_T 0 x); intro. + elim s; intro. + apply (exp_pos_pos _ a). + rewrite <- b; rewrite exp_0; apply Rlt_0_1. + replace (exp x) with (1 / exp (- x)). + unfold Rdiv in |- *; apply Rmult_lt_0_compat. + apply Rlt_0_1. + apply Rinv_0_lt_compat; apply exp_pos_pos. + apply (Ropp_0_gt_lt_contravar _ r). + cut (exp (- x) <> 0). + intro; unfold Rdiv in |- *; apply Rmult_eq_reg_l with (exp (- x)). + rewrite Rmult_1_l; rewrite <- Rinv_r_sym. + rewrite <- exp_plus. + rewrite Rplus_opp_l; rewrite exp_0; reflexivity. + apply H. + apply H. + assert (H := exp_plus x (- x)). + rewrite Rplus_opp_r in H; rewrite exp_0 in H. + red in |- *; intro; rewrite H0 in H. + rewrite Rmult_0_r in H. + elim R1_neq_R0; assumption. Qed. (* ((exp h)-1)/h -> 0 quand h->0 *) Lemma derivable_pt_lim_exp_0 : derivable_pt_lim exp 0 1. -unfold derivable_pt_lim in |- *; intros. -set (fn := fun (N:nat) (x:R) => x ^ N / INR (fact (S N))). -cut (CVN_R fn). -intro; cut (forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)). -intro cv; cut (forall n:nat, continuity (fn n)). -intro; cut (continuity (SFL fn cv)). -intro; unfold continuity in H1. -assert (H2 := H1 0). -unfold continuity_pt in H2; unfold continue_in in H2; unfold limit1_in in H2; - unfold limit_in in H2; simpl in H2; unfold R_dist in H2. -elim (H2 _ H); intros alp H3. -elim H3; intros. -exists (mkposreal _ H4); intros. -rewrite Rplus_0_l; rewrite exp_0. -replace ((exp h - 1) / h) with (SFL fn cv h). -replace 1 with (SFL fn cv 0). -apply H5. -split. -unfold D_x, no_cond in |- *; split. -trivial. -apply (sym_not_eq H6). -rewrite Rminus_0_r; apply H7. -unfold SFL in |- *. -case (cv 0); intros. -eapply UL_sequence. -apply u. -unfold Un_cv, SP in |- *. -intros; exists 1%nat; intros. -unfold R_dist in |- *; rewrite decomp_sum. -rewrite (Rplus_comm (fn 0%nat 0)). -replace (fn 0%nat 0) with 1. -unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_r; - rewrite Rplus_0_r. -replace (sum_f_R0 (fun i:nat => fn (S i) 0) (pred n)) with 0. -rewrite Rabs_R0; apply H8. -symmetry in |- *; apply sum_eq_R0; intros. -unfold fn in |- *. -simpl in |- *. -unfold Rdiv in |- *; do 2 rewrite Rmult_0_l; reflexivity. -unfold fn in |- *; simpl in |- *. -unfold Rdiv in |- *; rewrite Rinv_1; rewrite Rmult_1_r; reflexivity. -apply lt_le_trans with 1%nat; [ apply lt_n_Sn | apply H9 ]. -unfold SFL, exp in |- *. -unfold projT1 in |- *. -case (cv h); case (exist_exp h); intros. -eapply UL_sequence. -apply u. -unfold Un_cv in |- *; intros. -unfold exp_in in e. -unfold infinit_sum in e. -cut (0 < eps0 * Rabs h). -intro; elim (e _ H9); intros N0 H10. -exists N0; intros. -unfold R_dist in |- *. -apply Rmult_lt_reg_l with (Rabs h). -apply Rabs_pos_lt; assumption. -rewrite <- Rabs_mult. -rewrite Rmult_minus_distr_l. -replace (h * ((x - 1) / h)) with (x - 1). -unfold R_dist in H10. -replace (h * SP fn n h - (x - 1)) with - (sum_f_R0 (fun i:nat => / INR (fact i) * h ^ i) (S n) - x). -rewrite (Rmult_comm (Rabs h)). -apply H10. -unfold ge in |- *. -apply le_trans with (S N0). -apply le_n_Sn. -apply le_n_S; apply H11. -rewrite decomp_sum. -replace (/ INR (fact 0) * h ^ 0) with 1. -unfold Rminus in |- *. -rewrite Ropp_plus_distr. -rewrite Ropp_involutive. -rewrite <- (Rplus_comm (- x)). -rewrite <- (Rplus_comm (- x + 1)). -rewrite Rplus_assoc; repeat apply Rplus_eq_compat_l. -replace (pred (S n)) with n; [ idtac | reflexivity ]. -unfold SP in |- *. -rewrite scal_sum. -apply sum_eq; intros. -unfold fn in |- *. -replace (h ^ S i) with (h * h ^ i). -unfold Rdiv in |- *; ring. -simpl in |- *; ring. -simpl in |- *; rewrite Rinv_1; rewrite Rmult_1_r; reflexivity. -apply lt_O_Sn. -unfold Rdiv in |- *. -rewrite <- Rmult_assoc. -symmetry in |- *; apply Rinv_r_simpl_m. -assumption. -apply Rmult_lt_0_compat. -apply H8. -apply Rabs_pos_lt; assumption. -apply SFL_continuity; assumption. -intro; unfold fn in |- *. -replace (fun x:R => x ^ n / INR (fact (S n))) with - (pow_fct n / fct_cte (INR (fact (S n))))%F; [ idtac | reflexivity ]. -apply continuity_div. -apply derivable_continuous; apply (derivable_pow n). -apply derivable_continuous; apply derivable_const. -intro; unfold fct_cte in |- *; apply INR_fact_neq_0. -apply (CVN_R_CVS _ X). -assert (H0 := Alembert_exp). -unfold CVN_R in |- *. -intro; unfold CVN_r in |- *. -apply existT with (fun N:nat => r ^ N / INR (fact (S N))). -cut - (sigT - (fun l:R => - Un_cv - (fun n:nat => - sum_f_R0 (fun k:nat => Rabs (r ^ k / INR (fact (S k)))) n) l)). -intro X. -elim X; intros. -exists x; intros. -split. -apply p. -unfold Boule in |- *; intros. -rewrite Rminus_0_r in H1. -unfold fn in |- *. -unfold Rdiv in |- *; rewrite Rabs_mult. -cut (0 < INR (fact (S n))). -intro. -rewrite (Rabs_right (/ INR (fact (S n)))). -do 2 rewrite <- (Rmult_comm (/ INR (fact (S n)))). -apply Rmult_le_compat_l. -left; apply Rinv_0_lt_compat; apply H2. -rewrite <- RPow_abs. -apply pow_maj_Rabs. -rewrite Rabs_Rabsolu; left; apply H1. -apply Rle_ge; left; apply Rinv_0_lt_compat; apply H2. -apply INR_fact_lt_0. -cut ((r:R) <> 0). -intro; apply Alembert_C2. -intro; apply Rabs_no_R0. -unfold Rdiv in |- *; apply prod_neq_R0. -apply pow_nonzero; assumption. -apply Rinv_neq_0_compat; apply INR_fact_neq_0. -unfold Un_cv in H0. -unfold Un_cv in |- *; intros. -cut (0 < eps0 / r); - [ intro - | unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; apply (cond_pos r) ] ]. -elim (H0 _ H3); intros N0 H4. -exists N0; intros. -cut (S n >= N0)%nat. -intro hyp_sn. -assert (H6 := H4 _ hyp_sn). -unfold R_dist in H6; rewrite Rminus_0_r in H6. -rewrite Rabs_Rabsolu in H6. -unfold R_dist in |- *; rewrite Rminus_0_r. -rewrite Rabs_Rabsolu. -replace - (Rabs (r ^ S n / INR (fact (S (S n)))) / Rabs (r ^ n / INR (fact (S n)))) - with (r * / INR (fact (S (S n))) * / / INR (fact (S n))). -rewrite Rmult_assoc; rewrite Rabs_mult. -rewrite (Rabs_right r). -apply Rmult_lt_reg_l with (/ r). -apply Rinv_0_lt_compat; apply (cond_pos r). -rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_l; rewrite <- (Rmult_comm eps0). -apply H6. -assumption. -apply Rle_ge; left; apply (cond_pos r). -unfold Rdiv in |- *. -repeat rewrite Rabs_mult. -repeat rewrite Rabs_Rinv. -rewrite Rinv_mult_distr. -repeat rewrite Rabs_right. -rewrite Rinv_involutive. -rewrite (Rmult_comm r). -rewrite (Rmult_comm (r ^ S n)). -repeat rewrite Rmult_assoc. -apply Rmult_eq_compat_l. -rewrite (Rmult_comm r). -rewrite <- Rmult_assoc; rewrite <- (Rmult_comm (INR (fact (S n)))). -apply Rmult_eq_compat_l. -simpl in |- *. -rewrite Rmult_assoc; rewrite <- Rinv_r_sym. -ring. -apply pow_nonzero; assumption. -apply INR_fact_neq_0. -apply Rle_ge; left; apply INR_fact_lt_0. -apply Rle_ge; left; apply pow_lt; apply (cond_pos r). -apply Rle_ge; left; apply INR_fact_lt_0. -apply Rle_ge; left; apply pow_lt; apply (cond_pos r). -apply Rabs_no_R0; apply pow_nonzero; assumption. -apply Rinv_neq_0_compat; apply Rabs_no_R0; apply INR_fact_neq_0. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -unfold ge in |- *; apply le_trans with n. -apply H5. -apply le_n_Sn. -assert (H1 := cond_pos r); red in |- *; intro; rewrite H2 in H1; - elim (Rlt_irrefl _ H1). +Proof. + unfold derivable_pt_lim in |- *; intros. + set (fn := fun (N:nat) (x:R) => x ^ N / INR (fact (S N))). + cut (CVN_R fn). + intro; cut (forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)). + intro cv; cut (forall n:nat, continuity (fn n)). + intro; cut (continuity (SFL fn cv)). + intro; unfold continuity in H1. + assert (H2 := H1 0). + unfold continuity_pt in H2; unfold continue_in in H2; unfold limit1_in in H2; + unfold limit_in in H2; simpl in H2; unfold R_dist in H2. + elim (H2 _ H); intros alp H3. + elim H3; intros. + exists (mkposreal _ H4); intros. + rewrite Rplus_0_l; rewrite exp_0. + replace ((exp h - 1) / h) with (SFL fn cv h). + replace 1 with (SFL fn cv 0). + apply H5. + split. + unfold D_x, no_cond in |- *; split. + trivial. + apply (sym_not_eq H6). + rewrite Rminus_0_r; apply H7. + unfold SFL in |- *. + case (cv 0); intros. + eapply UL_sequence. + apply u. + unfold Un_cv, SP in |- *. + intros; exists 1%nat; intros. + unfold R_dist in |- *; rewrite decomp_sum. + rewrite (Rplus_comm (fn 0%nat 0)). + replace (fn 0%nat 0) with 1. + unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_r; + rewrite Rplus_0_r. + replace (sum_f_R0 (fun i:nat => fn (S i) 0) (pred n)) with 0. + rewrite Rabs_R0; apply H8. + symmetry in |- *; apply sum_eq_R0; intros. + unfold fn in |- *. + simpl in |- *. + unfold Rdiv in |- *; do 2 rewrite Rmult_0_l; reflexivity. + unfold fn in |- *; simpl in |- *. + unfold Rdiv in |- *; rewrite Rinv_1; rewrite Rmult_1_r; reflexivity. + apply lt_le_trans with 1%nat; [ apply lt_n_Sn | apply H9 ]. + unfold SFL, exp in |- *. + unfold projT1 in |- *. + case (cv h); case (exist_exp h); intros. + eapply UL_sequence. + apply u. + unfold Un_cv in |- *; intros. + unfold exp_in in e. + unfold infinit_sum in e. + cut (0 < eps0 * Rabs h). + intro; elim (e _ H9); intros N0 H10. + exists N0; intros. + unfold R_dist in |- *. + apply Rmult_lt_reg_l with (Rabs h). + apply Rabs_pos_lt; assumption. + rewrite <- Rabs_mult. + rewrite Rmult_minus_distr_l. + replace (h * ((x - 1) / h)) with (x - 1). + unfold R_dist in H10. + replace (h * SP fn n h - (x - 1)) with + (sum_f_R0 (fun i:nat => / INR (fact i) * h ^ i) (S n) - x). + rewrite (Rmult_comm (Rabs h)). + apply H10. + unfold ge in |- *. + apply le_trans with (S N0). + apply le_n_Sn. + apply le_n_S; apply H11. + rewrite decomp_sum. + replace (/ INR (fact 0) * h ^ 0) with 1. + unfold Rminus in |- *. + rewrite Ropp_plus_distr. + rewrite Ropp_involutive. + rewrite <- (Rplus_comm (- x)). + rewrite <- (Rplus_comm (- x + 1)). + rewrite Rplus_assoc; repeat apply Rplus_eq_compat_l. + replace (pred (S n)) with n; [ idtac | reflexivity ]. + unfold SP in |- *. + rewrite scal_sum. + apply sum_eq; intros. + unfold fn in |- *. + replace (h ^ S i) with (h * h ^ i). + unfold Rdiv in |- *; ring. + simpl in |- *; ring. + simpl in |- *; rewrite Rinv_1; rewrite Rmult_1_r; reflexivity. + apply lt_O_Sn. + unfold Rdiv in |- *. + rewrite <- Rmult_assoc. + symmetry in |- *; apply Rinv_r_simpl_m. + assumption. + apply Rmult_lt_0_compat. + apply H8. + apply Rabs_pos_lt; assumption. + apply SFL_continuity; assumption. + intro; unfold fn in |- *. + replace (fun x:R => x ^ n / INR (fact (S n))) with + (pow_fct n / fct_cte (INR (fact (S n))))%F; [ idtac | reflexivity ]. + apply continuity_div. + apply derivable_continuous; apply (derivable_pow n). + apply derivable_continuous; apply derivable_const. + intro; unfold fct_cte in |- *; apply INR_fact_neq_0. + apply (CVN_R_CVS _ X). + assert (H0 := Alembert_exp). + unfold CVN_R in |- *. + intro; unfold CVN_r in |- *. + apply existT with (fun N:nat => r ^ N / INR (fact (S N))). + cut + (sigT + (fun l:R => + Un_cv + (fun n:nat => + sum_f_R0 (fun k:nat => Rabs (r ^ k / INR (fact (S k)))) n) l)). + intro X. + elim X; intros. + exists x; intros. + split. + apply p. + unfold Boule in |- *; intros. + rewrite Rminus_0_r in H1. + unfold fn in |- *. + unfold Rdiv in |- *; rewrite Rabs_mult. + cut (0 < INR (fact (S n))). + intro. + rewrite (Rabs_right (/ INR (fact (S n)))). + do 2 rewrite <- (Rmult_comm (/ INR (fact (S n)))). + apply Rmult_le_compat_l. + left; apply Rinv_0_lt_compat; apply H2. + rewrite <- RPow_abs. + apply pow_maj_Rabs. + rewrite Rabs_Rabsolu; left; apply H1. + apply Rle_ge; left; apply Rinv_0_lt_compat; apply H2. + apply INR_fact_lt_0. + cut ((r:R) <> 0). + intro; apply Alembert_C2. + intro; apply Rabs_no_R0. + unfold Rdiv in |- *; apply prod_neq_R0. + apply pow_nonzero; assumption. + apply Rinv_neq_0_compat; apply INR_fact_neq_0. + unfold Un_cv in H0. + unfold Un_cv in |- *; intros. + cut (0 < eps0 / r); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; apply (cond_pos r) ] ]. + elim (H0 _ H3); intros N0 H4. + exists N0; intros. + cut (S n >= N0)%nat. + intro hyp_sn. + assert (H6 := H4 _ hyp_sn). + unfold R_dist in H6; rewrite Rminus_0_r in H6. + rewrite Rabs_Rabsolu in H6. + unfold R_dist in |- *; rewrite Rminus_0_r. + rewrite Rabs_Rabsolu. + replace + (Rabs (r ^ S n / INR (fact (S (S n)))) / Rabs (r ^ n / INR (fact (S n)))) + with (r * / INR (fact (S (S n))) * / / INR (fact (S n))). + rewrite Rmult_assoc; rewrite Rabs_mult. + rewrite (Rabs_right r). + apply Rmult_lt_reg_l with (/ r). + apply Rinv_0_lt_compat; apply (cond_pos r). + rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_l; rewrite <- (Rmult_comm eps0). + apply H6. + assumption. + apply Rle_ge; left; apply (cond_pos r). + unfold Rdiv in |- *. + repeat rewrite Rabs_mult. + repeat rewrite Rabs_Rinv. + rewrite Rinv_mult_distr. + repeat rewrite Rabs_right. + rewrite Rinv_involutive. + rewrite (Rmult_comm r). + rewrite (Rmult_comm (r ^ S n)). + repeat rewrite Rmult_assoc. + apply Rmult_eq_compat_l. + rewrite (Rmult_comm r). + rewrite <- Rmult_assoc; rewrite <- (Rmult_comm (INR (fact (S n)))). + apply Rmult_eq_compat_l. + simpl in |- *. + rewrite Rmult_assoc; rewrite <- Rinv_r_sym. + ring. + apply pow_nonzero; assumption. + apply INR_fact_neq_0. + apply Rle_ge; left; apply INR_fact_lt_0. + apply Rle_ge; left; apply pow_lt; apply (cond_pos r). + apply Rle_ge; left; apply INR_fact_lt_0. + apply Rle_ge; left; apply pow_lt; apply (cond_pos r). + apply Rabs_no_R0; apply pow_nonzero; assumption. + apply Rinv_neq_0_compat; apply Rabs_no_R0; apply INR_fact_neq_0. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + unfold ge in |- *; apply le_trans with n. + apply H5. + apply le_n_Sn. + assert (H1 := cond_pos r); red in |- *; intro; rewrite H2 in H1; + elim (Rlt_irrefl _ H1). Qed. (**********) Lemma derivable_pt_lim_exp : forall x:R, derivable_pt_lim exp x (exp x). -intro; assert (H0 := derivable_pt_lim_exp_0). -unfold derivable_pt_lim in H0; unfold derivable_pt_lim in |- *; intros. -cut (0 < eps / exp x); - [ intro - | unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ apply H | apply Rinv_0_lt_compat; apply exp_pos ] ]. -elim (H0 _ H1); intros del H2. -exists del; intros. -assert (H5 := H2 _ H3 H4). -rewrite Rplus_0_l in H5; rewrite exp_0 in H5. -replace ((exp (x + h) - exp x) / h - exp x) with - (exp x * ((exp h - 1) / h - 1)). -rewrite Rabs_mult; rewrite (Rabs_right (exp x)). -apply Rmult_lt_reg_l with (/ exp x). -apply Rinv_0_lt_compat; apply exp_pos. -rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_l; rewrite <- (Rmult_comm eps). -apply H5. -assert (H6 := exp_pos x); red in |- *; intro; rewrite H7 in H6; - elim (Rlt_irrefl _ H6). -apply Rle_ge; left; apply exp_pos. -rewrite Rmult_minus_distr_l. -rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite <- Rmult_assoc; - rewrite Rmult_minus_distr_l. -rewrite Rmult_1_r; rewrite exp_plus; reflexivity. +Proof. + intro; assert (H0 := derivable_pt_lim_exp_0). + unfold derivable_pt_lim in H0; unfold derivable_pt_lim in |- *; intros. + cut (0 < eps / exp x); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply H | apply Rinv_0_lt_compat; apply exp_pos ] ]. + elim (H0 _ H1); intros del H2. + exists del; intros. + assert (H5 := H2 _ H3 H4). + rewrite Rplus_0_l in H5; rewrite exp_0 in H5. + replace ((exp (x + h) - exp x) / h - exp x) with + (exp x * ((exp h - 1) / h - 1)). + rewrite Rabs_mult; rewrite (Rabs_right (exp x)). + apply Rmult_lt_reg_l with (/ exp x). + apply Rinv_0_lt_compat; apply exp_pos. + rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_l; rewrite <- (Rmult_comm eps). + apply H5. + assert (H6 := exp_pos x); red in |- *; intro; rewrite H7 in H6; + elim (Rlt_irrefl _ H6). + apply Rle_ge; left; apply exp_pos. + rewrite Rmult_minus_distr_l. + rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite <- Rmult_assoc; + rewrite Rmult_minus_distr_l. + rewrite Rmult_1_r; rewrite exp_plus; reflexivity. Qed. diff --git a/theories/Reals/LegacyRfield.v b/theories/Reals/LegacyRfield.v new file mode 100644 index 00000000..b33274af --- /dev/null +++ b/theories/Reals/LegacyRfield.v @@ -0,0 +1,40 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(*i $Id$ i*) + +Require Export Raxioms. +Require Export LegacyField. +Import LegacyRing_theory. + +Section LegacyRfield. + +Open Scope R_scope. + +Lemma RLegacyTheory : Ring_Theory Rplus Rmult 1 0 Ropp (fun x y:R => false). + split. + exact Rplus_comm. + symmetry in |- *; apply Rplus_assoc. + exact Rmult_comm. + symmetry in |- *; apply Rmult_assoc. + intro; apply Rplus_0_l. + intro; apply Rmult_1_l. + exact Rplus_opp_r. + intros. + rewrite Rmult_comm. + rewrite (Rmult_comm n p). + rewrite (Rmult_comm m p). + apply Rmult_plus_distr_l. + intros; contradiction. +Defined. + +End LegacyRfield. + +Add Legacy Field +R Rplus Rmult 1%R 0%R Ropp (fun x y:R => false) Rinv RLegacyTheory Rinv_l + with minus := Rminus div := Rdiv. diff --git a/theories/Reals/MVT.v b/theories/Reals/MVT.v index 241313a0..8bb9298a 100644 --- a/theories/Reals/MVT.v +++ b/theories/Reals/MVT.v @@ -5,8 +5,8 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) - -(*i $Id: MVT.v 8670 2006-03-28 22:16:14Z herbelin $ i*) + +(*i $Id: MVT.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -15,685 +15,707 @@ Require Import Rtopology. Open Local Scope R_scope. (* The Mean Value Theorem *) Theorem MVT : - forall (f g:R -> R) (a b:R) (pr1:forall c:R, a < c < b -> derivable_pt f c) - (pr2:forall c:R, a < c < b -> derivable_pt g c), - a < b -> - (forall c:R, a <= c <= b -> continuity_pt f c) -> - (forall c:R, a <= c <= b -> continuity_pt g c) -> + forall (f g:R -> R) (a b:R) (pr1:forall c:R, a < c < b -> derivable_pt f c) + (pr2:forall c:R, a < c < b -> derivable_pt g c), + a < b -> + (forall c:R, a <= c <= b -> continuity_pt f c) -> + (forall c:R, a <= c <= b -> continuity_pt g c) -> exists c : R, - (exists P : a < c < b, + (exists P : a < c < b, (g b - g a) * derive_pt f c (pr1 c P) = (f b - f a) * derive_pt g c (pr2 c P)). -intros; assert (H2 := Rlt_le _ _ H). -set (h := fun y:R => (g b - g a) * f y - (f b - f a) * g y). -cut (forall c:R, a < c < b -> derivable_pt h c). -intro X; cut (forall c:R, a <= c <= b -> continuity_pt h c). -intro; assert (H4 := continuity_ab_maj h a b H2 H3). -assert (H5 := continuity_ab_min h a b H2 H3). -elim H4; intros Mx H6. -elim H5; intros mx H7. -cut (h a = h b). -intro; set (M := h Mx); set (m := h mx). -cut - (forall (c:R) (P:a < c < b), - derive_pt h c (X c P) = - (g b - g a) * derive_pt f c (pr1 c P) - - (f b - f a) * derive_pt g c (pr2 c P)). -intro; case (Req_dec (h a) M); intro. -case (Req_dec (h a) m); intro. -cut (forall c:R, a <= c <= b -> h c = M). -intro; cut (a < (a + b) / 2 < b). +Proof. + intros; assert (H2 := Rlt_le _ _ H). + set (h := fun y:R => (g b - g a) * f y - (f b - f a) * g y). + cut (forall c:R, a < c < b -> derivable_pt h c). + intro X; cut (forall c:R, a <= c <= b -> continuity_pt h c). + intro; assert (H4 := continuity_ab_maj h a b H2 H3). + assert (H5 := continuity_ab_min h a b H2 H3). + elim H4; intros Mx H6. + elim H5; intros mx H7. + cut (h a = h b). + intro; set (M := h Mx); set (m := h mx). + cut + (forall (c:R) (P:a < c < b), + derive_pt h c (X c P) = + (g b - g a) * derive_pt f c (pr1 c P) - + (f b - f a) * derive_pt g c (pr2 c P)). + intro; case (Req_dec (h a) M); intro. + case (Req_dec (h a) m); intro. + cut (forall c:R, a <= c <= b -> h c = M). + intro; cut (a < (a + b) / 2 < b). (*** h constant ***) -intro; exists ((a + b) / 2). -exists H13. -apply Rminus_diag_uniq; rewrite <- H9; apply deriv_constant2 with a b. -elim H13; intros; assumption. -elim H13; intros; assumption. -intros; rewrite (H12 ((a + b) / 2)). -apply H12; split; left; assumption. -elim H13; intros; split; left; assumption. -split. -apply Rmult_lt_reg_l with 2. -prove_sup0. -unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym. -rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; apply H. -discrR. -apply Rmult_lt_reg_l with 2. -prove_sup0. -unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym. -rewrite Rmult_1_l; rewrite Rplus_comm; rewrite double; - apply Rplus_lt_compat_l; apply H. -discrR. -intros; elim H6; intros H13 _. -elim H7; intros H14 _. -apply Rle_antisym. -apply H13; apply H12. -rewrite H10 in H11; rewrite H11; apply H14; apply H12. -cut (a < mx < b). + intro; exists ((a + b) / 2). + exists H13. + apply Rminus_diag_uniq; rewrite <- H9; apply deriv_constant2 with a b. + elim H13; intros; assumption. + elim H13; intros; assumption. + intros; rewrite (H12 ((a + b) / 2)). + apply H12; split; left; assumption. + elim H13; intros; split; left; assumption. + split. + apply Rmult_lt_reg_l with 2. + prove_sup0. + unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. + rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; apply H. + discrR. + apply Rmult_lt_reg_l with 2. + prove_sup0. + unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. + rewrite Rmult_1_l; rewrite Rplus_comm; rewrite double; + apply Rplus_lt_compat_l; apply H. + discrR. + intros; elim H6; intros H13 _. + elim H7; intros H14 _. + apply Rle_antisym. + apply H13; apply H12. + rewrite H10 in H11; rewrite H11; apply H14; apply H12. + cut (a < mx < b). (*** h admet un minimum global sur [a,b] ***) -intro; exists mx. -exists H12. -apply Rminus_diag_uniq; rewrite <- H9; apply deriv_minimum with a b. -elim H12; intros; assumption. -elim H12; intros; assumption. -intros; elim H7; intros. -apply H15; split; left; assumption. -elim H7; intros _ H12; elim H12; intros; split. -inversion H13. -apply H15. -rewrite H15 in H11; elim H11; reflexivity. -inversion H14. -apply H15. -rewrite H8 in H11; rewrite <- H15 in H11; elim H11; reflexivity. -cut (a < Mx < b). + intro; exists mx. + exists H12. + apply Rminus_diag_uniq; rewrite <- H9; apply deriv_minimum with a b. + elim H12; intros; assumption. + elim H12; intros; assumption. + intros; elim H7; intros. + apply H15; split; left; assumption. + elim H7; intros _ H12; elim H12; intros; split. + inversion H13. + apply H15. + rewrite H15 in H11; elim H11; reflexivity. + inversion H14. + apply H15. + rewrite H8 in H11; rewrite <- H15 in H11; elim H11; reflexivity. + cut (a < Mx < b). (*** h admet un maximum global sur [a,b] ***) -intro; exists Mx. -exists H11. -apply Rminus_diag_uniq; rewrite <- H9; apply deriv_maximum with a b. -elim H11; intros; assumption. -elim H11; intros; assumption. -intros; elim H6; intros; apply H14. -split; left; assumption. -elim H6; intros _ H11; elim H11; intros; split. -inversion H12. -apply H14. -rewrite H14 in H10; elim H10; reflexivity. -inversion H13. -apply H14. -rewrite H8 in H10; rewrite <- H14 in H10; elim H10; reflexivity. -intros; unfold h in |- *; - replace - (derive_pt (fun y:R => (g b - g a) * f y - (f b - f a) * g y) c (X c P)) - with - (derive_pt ((fct_cte (g b - g a) * f)%F - (fct_cte (f b - f a) * g)%F) c - (derivable_pt_minus _ _ _ - (derivable_pt_mult _ _ _ (derivable_pt_const (g b - g a) c) (pr1 c P)) - (derivable_pt_mult _ _ _ (derivable_pt_const (f b - f a) c) (pr2 c P)))); - [ idtac | apply pr_nu ]. -rewrite derive_pt_minus; do 2 rewrite derive_pt_mult; - do 2 rewrite derive_pt_const; do 2 rewrite Rmult_0_l; - do 2 rewrite Rplus_0_l; reflexivity. -unfold h in |- *; ring. -intros; unfold h in |- *; - change - (continuity_pt ((fct_cte (g b - g a) * f)%F - (fct_cte (f b - f a) * g)%F) - c) in |- *. -apply continuity_pt_minus; apply continuity_pt_mult. -apply derivable_continuous_pt; apply derivable_const. -apply H0; apply H3. -apply derivable_continuous_pt; apply derivable_const. -apply H1; apply H3. -intros; - change - (derivable_pt ((fct_cte (g b - g a) * f)%F - (fct_cte (f b - f a) * g)%F) - c) in |- *. -apply derivable_pt_minus; apply derivable_pt_mult. -apply derivable_pt_const. -apply (pr1 _ H3). -apply derivable_pt_const. -apply (pr2 _ H3). + intro; exists Mx. + exists H11. + apply Rminus_diag_uniq; rewrite <- H9; apply deriv_maximum with a b. + elim H11; intros; assumption. + elim H11; intros; assumption. + intros; elim H6; intros; apply H14. + split; left; assumption. + elim H6; intros _ H11; elim H11; intros; split. + inversion H12. + apply H14. + rewrite H14 in H10; elim H10; reflexivity. + inversion H13. + apply H14. + rewrite H8 in H10; rewrite <- H14 in H10; elim H10; reflexivity. + intros; unfold h in |- *; + replace + (derive_pt (fun y:R => (g b - g a) * f y - (f b - f a) * g y) c (X c P)) + with + (derive_pt ((fct_cte (g b - g a) * f)%F - (fct_cte (f b - f a) * g)%F) c + (derivable_pt_minus _ _ _ + (derivable_pt_mult _ _ _ (derivable_pt_const (g b - g a) c) (pr1 c P)) + (derivable_pt_mult _ _ _ (derivable_pt_const (f b - f a) c) (pr2 c P)))); + [ idtac | apply pr_nu ]. + rewrite derive_pt_minus; do 2 rewrite derive_pt_mult; + do 2 rewrite derive_pt_const; do 2 rewrite Rmult_0_l; + do 2 rewrite Rplus_0_l; reflexivity. + unfold h in |- *; ring. + intros; unfold h in |- *; + change + (continuity_pt ((fct_cte (g b - g a) * f)%F - (fct_cte (f b - f a) * g)%F) + c) in |- *. + apply continuity_pt_minus; apply continuity_pt_mult. + apply derivable_continuous_pt; apply derivable_const. + apply H0; apply H3. + apply derivable_continuous_pt; apply derivable_const. + apply H1; apply H3. + intros; + change + (derivable_pt ((fct_cte (g b - g a) * f)%F - (fct_cte (f b - f a) * g)%F) + c) in |- *. + apply derivable_pt_minus; apply derivable_pt_mult. + apply derivable_pt_const. + apply (pr1 _ H3). + apply derivable_pt_const. + apply (pr2 _ H3). Qed. (* Corollaries ... *) Lemma MVT_cor1 : - forall (f:R -> R) (a b:R) (pr:derivable f), - a < b -> + forall (f:R -> R) (a b:R) (pr:derivable f), + a < b -> exists c : R, f b - f a = derive_pt f c (pr c) * (b - a) /\ a < c < b. -intros f a b pr H; cut (forall c:R, a < c < b -> derivable_pt f c); - [ intro X | intros; apply pr ]. -cut (forall c:R, a < c < b -> derivable_pt id c); - [ intro X0 | intros; apply derivable_pt_id ]. -cut (forall c:R, a <= c <= b -> continuity_pt f c); - [ intro | intros; apply derivable_continuous_pt; apply pr ]. -cut (forall c:R, a <= c <= b -> continuity_pt id c); - [ intro | intros; apply derivable_continuous_pt; apply derivable_id ]. -assert (H2 := MVT f id a b X X0 H H0 H1). -elim H2; intros c H3; elim H3; intros. -exists c; split. -cut (derive_pt id c (X0 c x) = derive_pt id c (derivable_pt_id c)); - [ intro | apply pr_nu ]. -rewrite H5 in H4; rewrite (derive_pt_id c) in H4; rewrite Rmult_1_r in H4; - rewrite <- H4; replace (derive_pt f c (X c x)) with (derive_pt f c (pr c)); - [ idtac | apply pr_nu ]; apply Rmult_comm. -apply x. +Proof. + intros f a b pr H; cut (forall c:R, a < c < b -> derivable_pt f c); + [ intro X | intros; apply pr ]. + cut (forall c:R, a < c < b -> derivable_pt id c); + [ intro X0 | intros; apply derivable_pt_id ]. + cut (forall c:R, a <= c <= b -> continuity_pt f c); + [ intro | intros; apply derivable_continuous_pt; apply pr ]. + cut (forall c:R, a <= c <= b -> continuity_pt id c); + [ intro | intros; apply derivable_continuous_pt; apply derivable_id ]. + assert (H2 := MVT f id a b X X0 H H0 H1). + elim H2; intros c H3; elim H3; intros. + exists c; split. + cut (derive_pt id c (X0 c x) = derive_pt id c (derivable_pt_id c)); + [ intro | apply pr_nu ]. + rewrite H5 in H4; rewrite (derive_pt_id c) in H4; rewrite Rmult_1_r in H4; + rewrite <- H4; replace (derive_pt f c (X c x)) with (derive_pt f c (pr c)); + [ idtac | apply pr_nu ]; apply Rmult_comm. + apply x. Qed. Theorem MVT_cor2 : - forall (f f':R -> R) (a b:R), - a < b -> - (forall c:R, a <= c <= b -> derivable_pt_lim f c (f' c)) -> + forall (f f':R -> R) (a b:R), + a < b -> + (forall c:R, a <= c <= b -> derivable_pt_lim f c (f' c)) -> exists c : R, f b - f a = f' c * (b - a) /\ a < c < b. -intros f f' a b H H0; cut (forall c:R, a <= c <= b -> derivable_pt f c). -intro X; cut (forall c:R, a < c < b -> derivable_pt f c). -intro X0; cut (forall c:R, a <= c <= b -> continuity_pt f c). -intro; cut (forall c:R, a <= c <= b -> derivable_pt id c). -intro X1; cut (forall c:R, a < c < b -> derivable_pt id c). -intro X2; cut (forall c:R, a <= c <= b -> continuity_pt id c). -intro; elim (MVT f id a b X0 X2 H H1 H2); intros; elim H3; clear H3; intros; - exists x; split. -cut (derive_pt id x (X2 x x0) = 1). -cut (derive_pt f x (X0 x x0) = f' x). -intros; rewrite H4 in H3; rewrite H5 in H3; unfold id in H3; - rewrite Rmult_1_r in H3; rewrite Rmult_comm; symmetry in |- *; - assumption. -apply derive_pt_eq_0; apply H0; elim x0; intros; split; left; assumption. -apply derive_pt_eq_0; apply derivable_pt_lim_id. -assumption. -intros; apply derivable_continuous_pt; apply X1; assumption. -intros; apply derivable_pt_id. -intros; apply derivable_pt_id. -intros; apply derivable_continuous_pt; apply X; assumption. -intros; elim H1; intros; apply X; split; left; assumption. -intros; unfold derivable_pt in |- *; apply existT with (f' c); apply H0; - apply H1. +Proof. + intros f f' a b H H0; cut (forall c:R, a <= c <= b -> derivable_pt f c). + intro X; cut (forall c:R, a < c < b -> derivable_pt f c). + intro X0; cut (forall c:R, a <= c <= b -> continuity_pt f c). + intro; cut (forall c:R, a <= c <= b -> derivable_pt id c). + intro X1; cut (forall c:R, a < c < b -> derivable_pt id c). + intro X2; cut (forall c:R, a <= c <= b -> continuity_pt id c). + intro; elim (MVT f id a b X0 X2 H H1 H2); intros; elim H3; clear H3; intros; + exists x; split. + cut (derive_pt id x (X2 x x0) = 1). + cut (derive_pt f x (X0 x x0) = f' x). + intros; rewrite H4 in H3; rewrite H5 in H3; unfold id in H3; + rewrite Rmult_1_r in H3; rewrite Rmult_comm; symmetry in |- *; + assumption. + apply derive_pt_eq_0; apply H0; elim x0; intros; split; left; assumption. + apply derive_pt_eq_0; apply derivable_pt_lim_id. + assumption. + intros; apply derivable_continuous_pt; apply X1; assumption. + intros; apply derivable_pt_id. + intros; apply derivable_pt_id. + intros; apply derivable_continuous_pt; apply X; assumption. + intros; elim H1; intros; apply X; split; left; assumption. + intros; unfold derivable_pt in |- *; apply existT with (f' c); apply H0; + apply H1. Qed. Lemma MVT_cor3 : - forall (f f':R -> R) (a b:R), - a < b -> - (forall x:R, a <= x -> x <= b -> derivable_pt_lim f x (f' x)) -> + forall (f f':R -> R) (a b:R), + a < b -> + (forall x:R, a <= x -> x <= b -> derivable_pt_lim f x (f' x)) -> exists c : R, a <= c /\ c <= b /\ f b = f a + f' c * (b - a). -intros f f' a b H H0; - assert (H1 : exists c : R, f b - f a = f' c * (b - a) /\ a < c < b); - [ apply MVT_cor2; [ apply H | intros; elim H1; intros; apply (H0 _ H2 H3) ] - | elim H1; intros; exists x; elim H2; intros; elim H4; intros; split; - [ left; assumption | split; [ left; assumption | rewrite <- H3; ring ] ] ]. +Proof. + intros f f' a b H H0; + assert (H1 : exists c : R, f b - f a = f' c * (b - a) /\ a < c < b); + [ apply MVT_cor2; [ apply H | intros; elim H1; intros; apply (H0 _ H2 H3) ] + | elim H1; intros; exists x; elim H2; intros; elim H4; intros; split; + [ left; assumption | split; [ left; assumption | rewrite <- H3; ring ] ] ]. Qed. Lemma Rolle : - forall (f:R -> R) (a b:R) (pr:forall x:R, a < x < b -> derivable_pt f x), - (forall x:R, a <= x <= b -> continuity_pt f x) -> - a < b -> - f a = f b -> + forall (f:R -> R) (a b:R) (pr:forall x:R, a < x < b -> derivable_pt f x), + (forall x:R, a <= x <= b -> continuity_pt f x) -> + a < b -> + f a = f b -> exists c : R, (exists P : a < c < b, derive_pt f c (pr c P) = 0). -intros; assert (H2 : forall x:R, a < x < b -> derivable_pt id x). -intros; apply derivable_pt_id. -assert (H3 := MVT f id a b pr H2 H0 H); - assert (H4 : forall x:R, a <= x <= b -> continuity_pt id x). -intros; apply derivable_continuous; apply derivable_id. -elim (H3 H4); intros; elim H5; intros; exists x; exists x0; rewrite H1 in H6; - unfold id in H6; unfold Rminus in H6; rewrite Rplus_opp_r in H6; - rewrite Rmult_0_l in H6; apply Rmult_eq_reg_l with (b - a); - [ rewrite Rmult_0_r; apply H6 - | apply Rminus_eq_contra; red in |- *; intro; rewrite H7 in H0; - elim (Rlt_irrefl _ H0) ]. +Proof. + intros; assert (H2 : forall x:R, a < x < b -> derivable_pt id x). + intros; apply derivable_pt_id. + assert (H3 := MVT f id a b pr H2 H0 H); + assert (H4 : forall x:R, a <= x <= b -> continuity_pt id x). + intros; apply derivable_continuous; apply derivable_id. + elim (H3 H4); intros; elim H5; intros; exists x; exists x0; rewrite H1 in H6; + unfold id in H6; unfold Rminus in H6; rewrite Rplus_opp_r in H6; + rewrite Rmult_0_l in H6; apply Rmult_eq_reg_l with (b - a); + [ rewrite Rmult_0_r; apply H6 + | apply Rminus_eq_contra; red in |- *; intro; rewrite H7 in H0; + elim (Rlt_irrefl _ H0) ]. Qed. (**********) Lemma nonneg_derivative_1 : - forall (f:R -> R) (pr:derivable f), - (forall x:R, 0 <= derive_pt f x (pr x)) -> increasing f. -intros. -unfold increasing in |- *. -intros. -case (total_order_T x y); intro. -elim s; intro. -apply Rplus_le_reg_l with (- f x). -rewrite Rplus_opp_l; rewrite Rplus_comm. -assert (H1 := MVT_cor1 f _ _ pr a). -elim H1; intros. -elim H2; intros. -unfold Rminus in H3. -rewrite H3. -apply Rmult_le_pos. -apply H. -apply Rplus_le_reg_l with x. -rewrite Rplus_0_r; replace (x + (y + - x)) with y; [ assumption | ring ]. -rewrite b; right; reflexivity. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 r)). + forall (f:R -> R) (pr:derivable f), + (forall x:R, 0 <= derive_pt f x (pr x)) -> increasing f. +Proof. + intros. + unfold increasing in |- *. + intros. + case (total_order_T x y); intro. + elim s; intro. + apply Rplus_le_reg_l with (- f x). + rewrite Rplus_opp_l; rewrite Rplus_comm. + assert (H1 := MVT_cor1 f _ _ pr a). + elim H1; intros. + elim H2; intros. + unfold Rminus in H3. + rewrite H3. + apply Rmult_le_pos. + apply H. + apply Rplus_le_reg_l with x. + rewrite Rplus_0_r; replace (x + (y + - x)) with y; [ assumption | ring ]. + rewrite b; right; reflexivity. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 r)). Qed. - + (**********) Lemma nonpos_derivative_0 : - forall (f:R -> R) (pr:derivable f), - decreasing f -> forall x:R, derive_pt f x (pr x) <= 0. -intros f pr H x; assert (H0 := H); unfold decreasing in H0; - generalize (derivable_derive f x (pr x)); intro; elim H1; - intros l H2. -rewrite H2; case (Rtotal_order l 0); intro. -left; assumption. -elim H3; intro. -right; assumption. -generalize (derive_pt_eq_1 f x l (pr x) H2); intros; cut (0 < l / 2). -intro; elim (H5 (l / 2) H6); intros delta H7; - cut (delta / 2 <> 0 /\ 0 < delta / 2 /\ Rabs (delta / 2) < delta). -intro; decompose [and] H8; intros; generalize (H7 (delta / 2) H9 H12); - cut ((f (x + delta / 2) - f x) / (delta / 2) <= 0). -intro; cut (0 < - ((f (x + delta / 2) - f x) / (delta / 2) - l)). -intro; unfold Rabs in |- *; - case (Rcase_abs ((f (x + delta / 2) - f x) / (delta / 2) - l)). -intros; - generalize - (Rplus_lt_compat_r (- l) (- ((f (x + delta / 2) - f x) / (delta / 2) - l)) - (l / 2) H14); unfold Rminus in |- *. -replace (l / 2 + - l) with (- (l / 2)). -replace (- ((f (x + delta / 2) + - f x) / (delta / 2) + - l) + - l) with - (- ((f (x + delta / 2) + - f x) / (delta / 2))). -intro. -generalize - (Ropp_lt_gt_contravar (- ((f (x + delta / 2) + - f x) / (delta / 2))) - (- (l / 2)) H15). -repeat rewrite Ropp_involutive. -intro. -generalize - (Rlt_trans 0 (l / 2) ((f (x + delta / 2) - f x) / (delta / 2)) H6 H16); - intro. -elim - (Rlt_irrefl 0 - (Rlt_le_trans 0 ((f (x + delta / 2) - f x) / (delta / 2)) 0 H17 H10)). -ring. -pattern l at 3 in |- *; rewrite double_var. -ring. -intros. -generalize - (Ropp_ge_le_contravar ((f (x + delta / 2) - f x) / (delta / 2) - l) 0 r). -rewrite Ropp_0. -intro. -elim - (Rlt_irrefl 0 - (Rlt_le_trans 0 (- ((f (x + delta / 2) - f x) / (delta / 2) - l)) 0 H13 - H15)). -replace (- ((f (x + delta / 2) - f x) / (delta / 2) - l)) with - ((f x - f (x + delta / 2)) / (delta / 2) + l). -unfold Rminus in |- *. -apply Rplus_le_lt_0_compat. -unfold Rdiv in |- *; apply Rmult_le_pos. -cut (x <= x + delta * / 2). -intro; generalize (H0 x (x + delta * / 2) H13); intro; - generalize - (Rplus_le_compat_l (- f (x + delta / 2)) (f (x + delta / 2)) (f x) H14); - rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption. -pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; - left; assumption. -left; apply Rinv_0_lt_compat; assumption. -assumption. -rewrite Ropp_minus_distr. -unfold Rminus in |- *. -rewrite (Rplus_comm l). -unfold Rdiv in |- *. -rewrite <- Ropp_mult_distr_l_reverse. -rewrite Ropp_plus_distr. -rewrite Ropp_involutive. -rewrite (Rplus_comm (f x)). -reflexivity. -replace ((f (x + delta / 2) - f x) / (delta / 2)) with - (- ((f x - f (x + delta / 2)) / (delta / 2))). -rewrite <- Ropp_0. -apply Ropp_ge_le_contravar. -apply Rle_ge. -unfold Rdiv in |- *; apply Rmult_le_pos. -cut (x <= x + delta * / 2). -intro; generalize (H0 x (x + delta * / 2) H10); intro. -generalize - (Rplus_le_compat_l (- f (x + delta / 2)) (f (x + delta / 2)) (f x) H13); - rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption. -pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; - left; assumption. -left; apply Rinv_0_lt_compat; assumption. -unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse. -rewrite Ropp_minus_distr. -reflexivity. -split. -unfold Rdiv in |- *; apply prod_neq_R0. -generalize (cond_pos delta); intro; red in |- *; intro H9; rewrite H9 in H8; - elim (Rlt_irrefl 0 H8). -apply Rinv_neq_0_compat; discrR. -split. -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. -rewrite Rabs_right. -unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2. -prove_sup0. -rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. -rewrite Rmult_1_l; rewrite double; pattern (pos delta) at 1 in |- *; - rewrite <- Rplus_0_r. -apply Rplus_lt_compat_l; apply (cond_pos delta). -discrR. -apply Rle_ge; unfold Rdiv in |- *; left; apply Rmult_lt_0_compat. -apply (cond_pos delta). -apply Rinv_0_lt_compat; prove_sup0. -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ apply H4 | apply Rinv_0_lt_compat; prove_sup0 ]. + forall (f:R -> R) (pr:derivable f), + decreasing f -> forall x:R, derive_pt f x (pr x) <= 0. +Proof. + intros f pr H x; assert (H0 := H); unfold decreasing in H0; + generalize (derivable_derive f x (pr x)); intro; elim H1; + intros l H2. + rewrite H2; case (Rtotal_order l 0); intro. + left; assumption. + elim H3; intro. + right; assumption. + generalize (derive_pt_eq_1 f x l (pr x) H2); intros; cut (0 < l / 2). + intro; elim (H5 (l / 2) H6); intros delta H7; + cut (delta / 2 <> 0 /\ 0 < delta / 2 /\ Rabs (delta / 2) < delta). + intro; decompose [and] H8; intros; generalize (H7 (delta / 2) H9 H12); + cut ((f (x + delta / 2) - f x) / (delta / 2) <= 0). + intro; cut (0 < - ((f (x + delta / 2) - f x) / (delta / 2) - l)). + intro; unfold Rabs in |- *; + case (Rcase_abs ((f (x + delta / 2) - f x) / (delta / 2) - l)). + intros; + generalize + (Rplus_lt_compat_r (- l) (- ((f (x + delta / 2) - f x) / (delta / 2) - l)) + (l / 2) H14); unfold Rminus in |- *. + replace (l / 2 + - l) with (- (l / 2)). + replace (- ((f (x + delta / 2) + - f x) / (delta / 2) + - l) + - l) with + (- ((f (x + delta / 2) + - f x) / (delta / 2))). + intro. + generalize + (Ropp_lt_gt_contravar (- ((f (x + delta / 2) + - f x) / (delta / 2))) + (- (l / 2)) H15). + repeat rewrite Ropp_involutive. + intro. + generalize + (Rlt_trans 0 (l / 2) ((f (x + delta / 2) - f x) / (delta / 2)) H6 H16); + intro. + elim + (Rlt_irrefl 0 + (Rlt_le_trans 0 ((f (x + delta / 2) - f x) / (delta / 2)) 0 H17 H10)). + ring. + pattern l at 3 in |- *; rewrite double_var. + ring. + intros. + generalize + (Ropp_ge_le_contravar ((f (x + delta / 2) - f x) / (delta / 2) - l) 0 r). + rewrite Ropp_0. + intro. + elim + (Rlt_irrefl 0 + (Rlt_le_trans 0 (- ((f (x + delta / 2) - f x) / (delta / 2) - l)) 0 H13 + H15)). + replace (- ((f (x + delta / 2) - f x) / (delta / 2) - l)) with + ((f x - f (x + delta / 2)) / (delta / 2) + l). + unfold Rminus in |- *. + apply Rplus_le_lt_0_compat. + unfold Rdiv in |- *; apply Rmult_le_pos. + cut (x <= x + delta * / 2). + intro; generalize (H0 x (x + delta * / 2) H13); intro; + generalize + (Rplus_le_compat_l (- f (x + delta / 2)) (f (x + delta / 2)) (f x) H14); + rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption. + pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; + left; assumption. + left; apply Rinv_0_lt_compat; assumption. + assumption. + rewrite Ropp_minus_distr. + unfold Rminus in |- *. + rewrite (Rplus_comm l). + unfold Rdiv in |- *. + rewrite <- Ropp_mult_distr_l_reverse. + rewrite Ropp_plus_distr. + rewrite Ropp_involutive. + rewrite (Rplus_comm (f x)). + reflexivity. + replace ((f (x + delta / 2) - f x) / (delta / 2)) with + (- ((f x - f (x + delta / 2)) / (delta / 2))). + rewrite <- Ropp_0. + apply Ropp_ge_le_contravar. + apply Rle_ge. + unfold Rdiv in |- *; apply Rmult_le_pos. + cut (x <= x + delta * / 2). + intro; generalize (H0 x (x + delta * / 2) H10); intro. + generalize + (Rplus_le_compat_l (- f (x + delta / 2)) (f (x + delta / 2)) (f x) H13); + rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption. + pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; + left; assumption. + left; apply Rinv_0_lt_compat; assumption. + unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse. + rewrite Ropp_minus_distr. + reflexivity. + split. + unfold Rdiv in |- *; apply prod_neq_R0. + generalize (cond_pos delta); intro; red in |- *; intro H9; rewrite H9 in H8; + elim (Rlt_irrefl 0 H8). + apply Rinv_neq_0_compat; discrR. + split. + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. + rewrite Rabs_right. + unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2. + prove_sup0. + rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. + rewrite Rmult_1_l; rewrite double; pattern (pos delta) at 1 in |- *; + rewrite <- Rplus_0_r. + apply Rplus_lt_compat_l; apply (cond_pos delta). + discrR. + apply Rle_ge; unfold Rdiv in |- *; left; apply Rmult_lt_0_compat. + apply (cond_pos delta). + apply Rinv_0_lt_compat; prove_sup0. + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply H4 | apply Rinv_0_lt_compat; prove_sup0 ]. Qed. (**********) Lemma increasing_decreasing_opp : - forall f:R -> R, increasing f -> decreasing (- f)%F. -unfold increasing, decreasing, opp_fct in |- *; intros; generalize (H x y H0); - intro; apply Ropp_ge_le_contravar; apply Rle_ge; assumption. + forall f:R -> R, increasing f -> decreasing (- f)%F. +Proof. + unfold increasing, decreasing, opp_fct in |- *; intros; generalize (H x y H0); + intro; apply Ropp_ge_le_contravar; apply Rle_ge; assumption. Qed. (**********) Lemma nonpos_derivative_1 : - forall (f:R -> R) (pr:derivable f), - (forall x:R, derive_pt f x (pr x) <= 0) -> decreasing f. -intros. -cut (forall h:R, - - f h = f h). -intro. -generalize (increasing_decreasing_opp (- f)%F). -unfold decreasing in |- *. -unfold opp_fct in |- *. -intros. -rewrite <- (H0 x); rewrite <- (H0 y). -apply H1. -cut (forall x:R, 0 <= derive_pt (- f) x (derivable_opp f pr x)). -intros. -replace (fun x:R => - f x) with (- f)%F; [ idtac | reflexivity ]. -apply (nonneg_derivative_1 (- f)%F (derivable_opp f pr) H3). -intro. -assert (H3 := derive_pt_opp f x0 (pr x0)). -cut - (derive_pt (- f) x0 (derivable_pt_opp f x0 (pr x0)) = - derive_pt (- f) x0 (derivable_opp f pr x0)). -intro. -rewrite <- H4. -rewrite H3. -rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; apply (H x0). -apply pr_nu. -assumption. -intro; ring. + forall (f:R -> R) (pr:derivable f), + (forall x:R, derive_pt f x (pr x) <= 0) -> decreasing f. +Proof. + intros. + cut (forall h:R, - - f h = f h). + intro. + generalize (increasing_decreasing_opp (- f)%F). + unfold decreasing in |- *. + unfold opp_fct in |- *. + intros. + rewrite <- (H0 x); rewrite <- (H0 y). + apply H1. + cut (forall x:R, 0 <= derive_pt (- f) x (derivable_opp f pr x)). + intros. + replace (fun x:R => - f x) with (- f)%F; [ idtac | reflexivity ]. + apply (nonneg_derivative_1 (- f)%F (derivable_opp f pr) H3). + intro. + assert (H3 := derive_pt_opp f x0 (pr x0)). + cut + (derive_pt (- f) x0 (derivable_pt_opp f x0 (pr x0)) = + derive_pt (- f) x0 (derivable_opp f pr x0)). + intro. + rewrite <- H4. + rewrite H3. + rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; apply (H x0). + apply pr_nu. + assumption. + intro; ring. Qed. - + (**********) Lemma positive_derivative : - forall (f:R -> R) (pr:derivable f), - (forall x:R, 0 < derive_pt f x (pr x)) -> strict_increasing f. -intros. -unfold strict_increasing in |- *. -intros. -apply Rplus_lt_reg_r with (- f x). -rewrite Rplus_opp_l; rewrite Rplus_comm. -assert (H1 := MVT_cor1 f _ _ pr H0). -elim H1; intros. -elim H2; intros. -unfold Rminus in H3. -rewrite H3. -apply Rmult_lt_0_compat. -apply H. -apply Rplus_lt_reg_r with x. -rewrite Rplus_0_r; replace (x + (y + - x)) with y; [ assumption | ring ]. + forall (f:R -> R) (pr:derivable f), + (forall x:R, 0 < derive_pt f x (pr x)) -> strict_increasing f. +Proof. + intros. + unfold strict_increasing in |- *. + intros. + apply Rplus_lt_reg_r with (- f x). + rewrite Rplus_opp_l; rewrite Rplus_comm. + assert (H1 := MVT_cor1 f _ _ pr H0). + elim H1; intros. + elim H2; intros. + unfold Rminus in H3. + rewrite H3. + apply Rmult_lt_0_compat. + apply H. + apply Rplus_lt_reg_r with x. + rewrite Rplus_0_r; replace (x + (y + - x)) with y; [ assumption | ring ]. Qed. (**********) Lemma strictincreasing_strictdecreasing_opp : - forall f:R -> R, strict_increasing f -> strict_decreasing (- f)%F. -unfold strict_increasing, strict_decreasing, opp_fct in |- *; intros; - generalize (H x y H0); intro; apply Ropp_lt_gt_contravar; - assumption. + forall f:R -> R, strict_increasing f -> strict_decreasing (- f)%F. +Proof. + unfold strict_increasing, strict_decreasing, opp_fct in |- *; intros; + generalize (H x y H0); intro; apply Ropp_lt_gt_contravar; + assumption. Qed. - + (**********) Lemma negative_derivative : - forall (f:R -> R) (pr:derivable f), - (forall x:R, derive_pt f x (pr x) < 0) -> strict_decreasing f. -intros. -cut (forall h:R, - - f h = f h). -intros. -generalize (strictincreasing_strictdecreasing_opp (- f)%F). -unfold strict_decreasing, opp_fct in |- *. -intros. -rewrite <- (H0 x). -rewrite <- (H0 y). -apply H1; [ idtac | assumption ]. -cut (forall x:R, 0 < derive_pt (- f) x (derivable_opp f pr x)). -intros; eapply positive_derivative; apply H3. -intro. -assert (H3 := derive_pt_opp f x0 (pr x0)). -cut - (derive_pt (- f) x0 (derivable_pt_opp f x0 (pr x0)) = - derive_pt (- f) x0 (derivable_opp f pr x0)). -intro. -rewrite <- H4; rewrite H3. -rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; apply (H x0). -apply pr_nu. -intro; ring. + forall (f:R -> R) (pr:derivable f), + (forall x:R, derive_pt f x (pr x) < 0) -> strict_decreasing f. +Proof. + intros. + cut (forall h:R, - - f h = f h). + intros. + generalize (strictincreasing_strictdecreasing_opp (- f)%F). + unfold strict_decreasing, opp_fct in |- *. + intros. + rewrite <- (H0 x). + rewrite <- (H0 y). + apply H1; [ idtac | assumption ]. + cut (forall x:R, 0 < derive_pt (- f) x (derivable_opp f pr x)). + intros; eapply positive_derivative; apply H3. + intro. + assert (H3 := derive_pt_opp f x0 (pr x0)). + cut + (derive_pt (- f) x0 (derivable_pt_opp f x0 (pr x0)) = + derive_pt (- f) x0 (derivable_opp f pr x0)). + intro. + rewrite <- H4; rewrite H3. + rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; apply (H x0). + apply pr_nu. + intro; ring. Qed. - + (**********) Lemma null_derivative_0 : - forall (f:R -> R) (pr:derivable f), - constant f -> forall x:R, derive_pt f x (pr x) = 0. -intros. -unfold constant in H. -apply derive_pt_eq_0. -intros; exists (mkposreal 1 Rlt_0_1); simpl in |- *; intros. -rewrite (H x (x + h)); unfold Rminus in |- *; unfold Rdiv in |- *; - rewrite Rplus_opp_r; rewrite Rmult_0_l; rewrite Rplus_opp_r; - rewrite Rabs_R0; assumption. + forall (f:R -> R) (pr:derivable f), + constant f -> forall x:R, derive_pt f x (pr x) = 0. +Proof. + intros. + unfold constant in H. + apply derive_pt_eq_0. + intros; exists (mkposreal 1 Rlt_0_1); simpl in |- *; intros. + rewrite (H x (x + h)); unfold Rminus in |- *; unfold Rdiv in |- *; + rewrite Rplus_opp_r; rewrite Rmult_0_l; rewrite Rplus_opp_r; + rewrite Rabs_R0; assumption. Qed. (**********) Lemma increasing_decreasing : - forall f:R -> R, increasing f -> decreasing f -> constant f. -unfold increasing, decreasing, constant in |- *; intros; - case (Rtotal_order x y); intro. -generalize (Rlt_le x y H1); intro; - apply (Rle_antisym (f x) (f y) (H x y H2) (H0 x y H2)). -elim H1; intro. -rewrite H2; reflexivity. -generalize (Rlt_le y x H2); intro; symmetry in |- *; - apply (Rle_antisym (f y) (f x) (H y x H3) (H0 y x H3)). + forall f:R -> R, increasing f -> decreasing f -> constant f. +Proof. + unfold increasing, decreasing, constant in |- *; intros; + case (Rtotal_order x y); intro. + generalize (Rlt_le x y H1); intro; + apply (Rle_antisym (f x) (f y) (H x y H2) (H0 x y H2)). + elim H1; intro. + rewrite H2; reflexivity. + generalize (Rlt_le y x H2); intro; symmetry in |- *; + apply (Rle_antisym (f y) (f x) (H y x H3) (H0 y x H3)). Qed. (**********) Lemma null_derivative_1 : - forall (f:R -> R) (pr:derivable f), - (forall x:R, derive_pt f x (pr x) = 0) -> constant f. -intros. -cut (forall x:R, derive_pt f x (pr x) <= 0). -cut (forall x:R, 0 <= derive_pt f x (pr x)). -intros. -assert (H2 := nonneg_derivative_1 f pr H0). -assert (H3 := nonpos_derivative_1 f pr H1). -apply increasing_decreasing; assumption. -intro; right; symmetry in |- *; apply (H x). -intro; right; apply (H x). + forall (f:R -> R) (pr:derivable f), + (forall x:R, derive_pt f x (pr x) = 0) -> constant f. +Proof. + intros. + cut (forall x:R, derive_pt f x (pr x) <= 0). + cut (forall x:R, 0 <= derive_pt f x (pr x)). + intros. + assert (H2 := nonneg_derivative_1 f pr H0). + assert (H3 := nonpos_derivative_1 f pr H1). + apply increasing_decreasing; assumption. + intro; right; symmetry in |- *; apply (H x). + intro; right; apply (H x). Qed. (**********) Lemma derive_increasing_interv_ax : - forall (a b:R) (f:R -> R) (pr:derivable f), - a < b -> - ((forall t:R, a < t < b -> 0 < derive_pt f t (pr t)) -> - forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x < f y) /\ - ((forall t:R, a < t < b -> 0 <= derive_pt f t (pr t)) -> - forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x <= f y). -intros. -split; intros. -apply Rplus_lt_reg_r with (- f x). -rewrite Rplus_opp_l; rewrite Rplus_comm. -assert (H4 := MVT_cor1 f _ _ pr H3). -elim H4; intros. -elim H5; intros. -unfold Rminus in H6. -rewrite H6. -apply Rmult_lt_0_compat. -apply H0. -elim H7; intros. -split. -elim H1; intros. -apply Rle_lt_trans with x; assumption. -elim H2; intros. -apply Rlt_le_trans with y; assumption. -apply Rplus_lt_reg_r with x. -rewrite Rplus_0_r; replace (x + (y + - x)) with y; [ assumption | ring ]. -apply Rplus_le_reg_l with (- f x). -rewrite Rplus_opp_l; rewrite Rplus_comm. -assert (H4 := MVT_cor1 f _ _ pr H3). -elim H4; intros. -elim H5; intros. -unfold Rminus in H6. -rewrite H6. -apply Rmult_le_pos. -apply H0. -elim H7; intros. -split. -elim H1; intros. -apply Rle_lt_trans with x; assumption. -elim H2; intros. -apply Rlt_le_trans with y; assumption. -apply Rplus_le_reg_l with x. -rewrite Rplus_0_r; replace (x + (y + - x)) with y; - [ left; assumption | ring ]. + forall (a b:R) (f:R -> R) (pr:derivable f), + a < b -> + ((forall t:R, a < t < b -> 0 < derive_pt f t (pr t)) -> + forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x < f y) /\ + ((forall t:R, a < t < b -> 0 <= derive_pt f t (pr t)) -> + forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x <= f y). +Proof. + intros. + split; intros. + apply Rplus_lt_reg_r with (- f x). + rewrite Rplus_opp_l; rewrite Rplus_comm. + assert (H4 := MVT_cor1 f _ _ pr H3). + elim H4; intros. + elim H5; intros. + unfold Rminus in H6. + rewrite H6. + apply Rmult_lt_0_compat. + apply H0. + elim H7; intros. + split. + elim H1; intros. + apply Rle_lt_trans with x; assumption. + elim H2; intros. + apply Rlt_le_trans with y; assumption. + apply Rplus_lt_reg_r with x. + rewrite Rplus_0_r; replace (x + (y + - x)) with y; [ assumption | ring ]. + apply Rplus_le_reg_l with (- f x). + rewrite Rplus_opp_l; rewrite Rplus_comm. + assert (H4 := MVT_cor1 f _ _ pr H3). + elim H4; intros. + elim H5; intros. + unfold Rminus in H6. + rewrite H6. + apply Rmult_le_pos. + apply H0. + elim H7; intros. + split. + elim H1; intros. + apply Rle_lt_trans with x; assumption. + elim H2; intros. + apply Rlt_le_trans with y; assumption. + apply Rplus_le_reg_l with x. + rewrite Rplus_0_r; replace (x + (y + - x)) with y; + [ left; assumption | ring ]. Qed. (**********) Lemma derive_increasing_interv : - forall (a b:R) (f:R -> R) (pr:derivable f), - a < b -> - (forall t:R, a < t < b -> 0 < derive_pt f t (pr t)) -> - forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x < f y. -intros. -generalize (derive_increasing_interv_ax a b f pr H); intro. -elim H4; intros H5 _; apply (H5 H0 x y H1 H2 H3). + forall (a b:R) (f:R -> R) (pr:derivable f), + a < b -> + (forall t:R, a < t < b -> 0 < derive_pt f t (pr t)) -> + forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x < f y. +Proof. + intros. + generalize (derive_increasing_interv_ax a b f pr H); intro. + elim H4; intros H5 _; apply (H5 H0 x y H1 H2 H3). Qed. (**********) Lemma derive_increasing_interv_var : - forall (a b:R) (f:R -> R) (pr:derivable f), - a < b -> - (forall t:R, a < t < b -> 0 <= derive_pt f t (pr t)) -> - forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x <= f y. -intros a b f pr H H0 x y H1 H2 H3; - generalize (derive_increasing_interv_ax a b f pr H); - intro; elim H4; intros _ H5; apply (H5 H0 x y H1 H2 H3). + forall (a b:R) (f:R -> R) (pr:derivable f), + a < b -> + (forall t:R, a < t < b -> 0 <= derive_pt f t (pr t)) -> + forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x <= f y. +Proof. + intros a b f pr H H0 x y H1 H2 H3; + generalize (derive_increasing_interv_ax a b f pr H); + intro; elim H4; intros _ H5; apply (H5 H0 x y H1 H2 H3). Qed. (**********) (**********) Theorem IAF : - forall (f:R -> R) (a b k:R) (pr:derivable f), - a <= b -> - (forall c:R, a <= c <= b -> derive_pt f c (pr c) <= k) -> - f b - f a <= k * (b - a). -intros. -case (total_order_T a b); intro. -elim s; intro. -assert (H1 := MVT_cor1 f _ _ pr a0). -elim H1; intros. -elim H2; intros. -rewrite H3. -do 2 rewrite <- (Rmult_comm (b - a)). -apply Rmult_le_compat_l. -apply Rplus_le_reg_l with a; rewrite Rplus_0_r. -replace (a + (b - a)) with b; [ assumption | ring ]. -apply H0. -elim H4; intros. -split; left; assumption. -rewrite b0. -unfold Rminus in |- *; do 2 rewrite Rplus_opp_r. -rewrite Rmult_0_r; right; reflexivity. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). + forall (f:R -> R) (a b k:R) (pr:derivable f), + a <= b -> + (forall c:R, a <= c <= b -> derive_pt f c (pr c) <= k) -> + f b - f a <= k * (b - a). +Proof. + intros. + case (total_order_T a b); intro. + elim s; intro. + assert (H1 := MVT_cor1 f _ _ pr a0). + elim H1; intros. + elim H2; intros. + rewrite H3. + do 2 rewrite <- (Rmult_comm (b - a)). + apply Rmult_le_compat_l. + apply Rplus_le_reg_l with a; rewrite Rplus_0_r. + replace (a + (b - a)) with b; [ assumption | ring ]. + apply H0. + elim H4; intros. + split; left; assumption. + rewrite b0. + unfold Rminus in |- *; do 2 rewrite Rplus_opp_r. + rewrite Rmult_0_r; right; reflexivity. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). Qed. Lemma IAF_var : - forall (f g:R -> R) (a b:R) (pr1:derivable f) (pr2:derivable g), - a <= b -> - (forall c:R, a <= c <= b -> derive_pt g c (pr2 c) <= derive_pt f c (pr1 c)) -> - g b - g a <= f b - f a. -intros. -cut (derivable (g - f)). -intro X. -cut (forall c:R, a <= c <= b -> derive_pt (g - f) c (X c) <= 0). -intro. -assert (H2 := IAF (g - f)%F a b 0 X H H1). -rewrite Rmult_0_l in H2; unfold minus_fct in H2. -apply Rplus_le_reg_l with (- f b + f a). -replace (- f b + f a + (f b - f a)) with 0; [ idtac | ring ]. -replace (- f b + f a + (g b - g a)) with (g b - f b - (g a - f a)); - [ apply H2 | ring ]. -intros. -cut - (derive_pt (g - f) c (X c) = - derive_pt (g - f) c (derivable_pt_minus _ _ _ (pr2 c) (pr1 c))). -intro. -rewrite H2. -rewrite derive_pt_minus. -apply Rplus_le_reg_l with (derive_pt f c (pr1 c)). -rewrite Rplus_0_r. -replace - (derive_pt f c (pr1 c) + (derive_pt g c (pr2 c) - derive_pt f c (pr1 c))) - with (derive_pt g c (pr2 c)); [ idtac | ring ]. -apply H0; assumption. -apply pr_nu. -apply derivable_minus; assumption. + forall (f g:R -> R) (a b:R) (pr1:derivable f) (pr2:derivable g), + a <= b -> + (forall c:R, a <= c <= b -> derive_pt g c (pr2 c) <= derive_pt f c (pr1 c)) -> + g b - g a <= f b - f a. +Proof. + intros. + cut (derivable (g - f)). + intro X. + cut (forall c:R, a <= c <= b -> derive_pt (g - f) c (X c) <= 0). + intro. + assert (H2 := IAF (g - f)%F a b 0 X H H1). + rewrite Rmult_0_l in H2; unfold minus_fct in H2. + apply Rplus_le_reg_l with (- f b + f a). + replace (- f b + f a + (f b - f a)) with 0; [ idtac | ring ]. + replace (- f b + f a + (g b - g a)) with (g b - f b - (g a - f a)); + [ apply H2 | ring ]. + intros. + cut + (derive_pt (g - f) c (X c) = + derive_pt (g - f) c (derivable_pt_minus _ _ _ (pr2 c) (pr1 c))). + intro. + rewrite H2. + rewrite derive_pt_minus. + apply Rplus_le_reg_l with (derive_pt f c (pr1 c)). + rewrite Rplus_0_r. + replace + (derive_pt f c (pr1 c) + (derive_pt g c (pr2 c) - derive_pt f c (pr1 c))) + with (derive_pt g c (pr2 c)); [ idtac | ring ]. + apply H0; assumption. + apply pr_nu. + apply derivable_minus; assumption. Qed. (* If f has a null derivative in ]a,b[ and is continue in [a,b], *) (* then f is constant on [a,b] *) Lemma null_derivative_loc : - forall (f:R -> R) (a b:R) (pr:forall x:R, a < x < b -> derivable_pt f x), - (forall x:R, a <= x <= b -> continuity_pt f x) -> - (forall (x:R) (P:a < x < b), derive_pt f x (pr x P) = 0) -> - constant_D_eq f (fun x:R => a <= x <= b) (f a). -intros; unfold constant_D_eq in |- *; intros; case (total_order_T a b); intro. -elim s; intro. -assert (H2 : forall y:R, a < y < x -> derivable_pt id y). -intros; apply derivable_pt_id. -assert (H3 : forall y:R, a <= y <= x -> continuity_pt id y). -intros; apply derivable_continuous; apply derivable_id. -assert (H4 : forall y:R, a < y < x -> derivable_pt f y). -intros; apply pr; elim H4; intros; split. -assumption. -elim H1; intros; apply Rlt_le_trans with x; assumption. -assert (H5 : forall y:R, a <= y <= x -> continuity_pt f y). -intros; apply H; elim H5; intros; split. -assumption. -elim H1; intros; apply Rle_trans with x; assumption. -elim H1; clear H1; intros; elim H1; clear H1; intro. -assert (H7 := MVT f id a x H4 H2 H1 H5 H3). -elim H7; intros; elim H8; intros; assert (H10 : a < x0 < b). -elim x1; intros; split. -assumption. -apply Rlt_le_trans with x; assumption. -assert (H11 : derive_pt f x0 (H4 x0 x1) = 0). -replace (derive_pt f x0 (H4 x0 x1)) with (derive_pt f x0 (pr x0 H10)); - [ apply H0 | apply pr_nu ]. -assert (H12 : derive_pt id x0 (H2 x0 x1) = 1). -apply derive_pt_eq_0; apply derivable_pt_lim_id. -rewrite H11 in H9; rewrite H12 in H9; rewrite Rmult_0_r in H9; - rewrite Rmult_1_r in H9; apply Rminus_diag_uniq; symmetry in |- *; - assumption. -rewrite H1; reflexivity. -assert (H2 : x = a). -rewrite <- b0 in H1; elim H1; intros; apply Rle_antisym; assumption. -rewrite H2; reflexivity. -elim H1; intros; - elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H2 H3) r)). + forall (f:R -> R) (a b:R) (pr:forall x:R, a < x < b -> derivable_pt f x), + (forall x:R, a <= x <= b -> continuity_pt f x) -> + (forall (x:R) (P:a < x < b), derive_pt f x (pr x P) = 0) -> + constant_D_eq f (fun x:R => a <= x <= b) (f a). +Proof. + intros; unfold constant_D_eq in |- *; intros; case (total_order_T a b); intro. + elim s; intro. + assert (H2 : forall y:R, a < y < x -> derivable_pt id y). + intros; apply derivable_pt_id. + assert (H3 : forall y:R, a <= y <= x -> continuity_pt id y). + intros; apply derivable_continuous; apply derivable_id. + assert (H4 : forall y:R, a < y < x -> derivable_pt f y). + intros; apply pr; elim H4; intros; split. + assumption. + elim H1; intros; apply Rlt_le_trans with x; assumption. + assert (H5 : forall y:R, a <= y <= x -> continuity_pt f y). + intros; apply H; elim H5; intros; split. + assumption. + elim H1; intros; apply Rle_trans with x; assumption. + elim H1; clear H1; intros; elim H1; clear H1; intro. + assert (H7 := MVT f id a x H4 H2 H1 H5 H3). + elim H7; intros; elim H8; intros; assert (H10 : a < x0 < b). + elim x1; intros; split. + assumption. + apply Rlt_le_trans with x; assumption. + assert (H11 : derive_pt f x0 (H4 x0 x1) = 0). + replace (derive_pt f x0 (H4 x0 x1)) with (derive_pt f x0 (pr x0 H10)); + [ apply H0 | apply pr_nu ]. + assert (H12 : derive_pt id x0 (H2 x0 x1) = 1). + apply derive_pt_eq_0; apply derivable_pt_lim_id. + rewrite H11 in H9; rewrite H12 in H9; rewrite Rmult_0_r in H9; + rewrite Rmult_1_r in H9; apply Rminus_diag_uniq; symmetry in |- *; + assumption. + rewrite H1; reflexivity. + assert (H2 : x = a). + rewrite <- b0 in H1; elim H1; intros; apply Rle_antisym; assumption. + rewrite H2; reflexivity. + elim H1; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H2 H3) r)). Qed. (* Unicity of the antiderivative *) Lemma antiderivative_Ucte : - forall (f g1 g2:R -> R) (a b:R), - antiderivative f g1 a b -> - antiderivative f g2 a b -> + forall (f g1 g2:R -> R) (a b:R), + antiderivative f g1 a b -> + antiderivative f g2 a b -> exists c : R, (forall x:R, a <= x <= b -> g1 x = g2 x + c). -unfold antiderivative in |- *; intros; elim H; clear H; intros; elim H0; - clear H0; intros H0 _; exists (g1 a - g2 a); intros; - assert (H3 : forall x:R, a <= x <= b -> derivable_pt g1 x). -intros; unfold derivable_pt in |- *; apply existT with (f x0); elim (H x0 H3); - intros; eapply derive_pt_eq_1; symmetry in |- *; - apply H4. -assert (H4 : forall x:R, a <= x <= b -> derivable_pt g2 x). -intros; unfold derivable_pt in |- *; apply existT with (f x0); - elim (H0 x0 H4); intros; eapply derive_pt_eq_1; symmetry in |- *; - apply H5. -assert (H5 : forall x:R, a < x < b -> derivable_pt (g1 - g2) x). -intros; elim H5; intros; apply derivable_pt_minus; - [ apply H3; split; left; assumption | apply H4; split; left; assumption ]. -assert (H6 : forall x:R, a <= x <= b -> continuity_pt (g1 - g2) x). -intros; apply derivable_continuous_pt; apply derivable_pt_minus; - [ apply H3 | apply H4 ]; assumption. -assert (H7 : forall (x:R) (P:a < x < b), derive_pt (g1 - g2) x (H5 x P) = 0). -intros; elim P; intros; apply derive_pt_eq_0; replace 0 with (f x0 - f x0); - [ idtac | ring ]. -assert (H9 : a <= x0 <= b). -split; left; assumption. -apply derivable_pt_lim_minus; [ elim (H _ H9) | elim (H0 _ H9) ]; intros; - eapply derive_pt_eq_1; symmetry in |- *; apply H10. -assert (H8 := null_derivative_loc (g1 - g2)%F a b H5 H6 H7); - unfold constant_D_eq in H8; assert (H9 := H8 _ H2); - unfold minus_fct in H9; rewrite <- H9; ring. +Proof. + unfold antiderivative in |- *; intros; elim H; clear H; intros; elim H0; + clear H0; intros H0 _; exists (g1 a - g2 a); intros; + assert (H3 : forall x:R, a <= x <= b -> derivable_pt g1 x). + intros; unfold derivable_pt in |- *; apply existT with (f x0); elim (H x0 H3); + intros; eapply derive_pt_eq_1; symmetry in |- *; + apply H4. + assert (H4 : forall x:R, a <= x <= b -> derivable_pt g2 x). + intros; unfold derivable_pt in |- *; apply existT with (f x0); + elim (H0 x0 H4); intros; eapply derive_pt_eq_1; symmetry in |- *; + apply H5. + assert (H5 : forall x:R, a < x < b -> derivable_pt (g1 - g2) x). + intros; elim H5; intros; apply derivable_pt_minus; + [ apply H3; split; left; assumption | apply H4; split; left; assumption ]. + assert (H6 : forall x:R, a <= x <= b -> continuity_pt (g1 - g2) x). + intros; apply derivable_continuous_pt; apply derivable_pt_minus; + [ apply H3 | apply H4 ]; assumption. + assert (H7 : forall (x:R) (P:a < x < b), derive_pt (g1 - g2) x (H5 x P) = 0). + intros; elim P; intros; apply derive_pt_eq_0; replace 0 with (f x0 - f x0); + [ idtac | ring ]. + assert (H9 : a <= x0 <= b). + split; left; assumption. + apply derivable_pt_lim_minus; [ elim (H _ H9) | elim (H0 _ H9) ]; intros; + eapply derive_pt_eq_1; symmetry in |- *; apply H10. + assert (H8 := null_derivative_loc (g1 - g2)%F a b H5 H6 H7); + unfold constant_D_eq in H8; assert (H9 := H8 _ H2); + unfold minus_fct in H9; rewrite <- H9; ring. Qed. diff --git a/theories/Reals/NewtonInt.v b/theories/Reals/NewtonInt.v index 62c53e6d..306d5ac4 100644 --- a/theories/Reals/NewtonInt.v +++ b/theories/Reals/NewtonInt.v @@ -5,8 +5,8 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) - -(*i $Id: NewtonInt.v 8670 2006-03-28 22:16:14Z herbelin $ i*) + +(*i $Id: NewtonInt.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -23,767 +23,782 @@ Definition Newton_integrable (f:R -> R) (a b:R) : Type := Definition NewtonInt (f:R -> R) (a b:R) (pr:Newton_integrable f a b) : R := let g := match pr with - | existT a b => a + | existT a b => a end in g b - g a. (* If f is differentiable, then f' is Newton integrable (Tautology ?) *) Lemma FTCN_step1 : - forall (f:Differential) (a b:R), - Newton_integrable (fun x:R => derive_pt f x (cond_diff f x)) a b. -intros f a b; unfold Newton_integrable in |- *; apply existT with (d1 f); - unfold antiderivative in |- *; intros; case (Rle_dec a b); - intro; - [ left; split; [ intros; exists (cond_diff f x); reflexivity | assumption ] - | right; split; - [ intros; exists (cond_diff f x); reflexivity | auto with real ] ]. + forall (f:Differential) (a b:R), + Newton_integrable (fun x:R => derive_pt f x (cond_diff f x)) a b. +Proof. + intros f a b; unfold Newton_integrable in |- *; apply existT with (d1 f); + unfold antiderivative in |- *; intros; case (Rle_dec a b); + intro; + [ left; split; [ intros; exists (cond_diff f x); reflexivity | assumption ] + | right; split; + [ intros; exists (cond_diff f x); reflexivity | auto with real ] ]. Defined. (* By definition, we have the Fondamental Theorem of Calculus *) Lemma FTC_Newton : - forall (f:Differential) (a b:R), - NewtonInt (fun x:R => derive_pt f x (cond_diff f x)) a b - (FTCN_step1 f a b) = f b - f a. -intros; unfold NewtonInt in |- *; reflexivity. + forall (f:Differential) (a b:R), + NewtonInt (fun x:R => derive_pt f x (cond_diff f x)) a b + (FTCN_step1 f a b) = f b - f a. +Proof. + intros; unfold NewtonInt in |- *; reflexivity. Qed. (* $\int_a^a f$ exists forall a:R and f:R->R *) Lemma NewtonInt_P1 : forall (f:R -> R) (a:R), Newton_integrable f a a. -intros f a; unfold Newton_integrable in |- *; - apply existT with (fct_cte (f a) * id)%F; left; - unfold antiderivative in |- *; split. -intros; assert (H1 : derivable_pt (fct_cte (f a) * id) x). -apply derivable_pt_mult. -apply derivable_pt_const. -apply derivable_pt_id. -exists H1; assert (H2 : x = a). -elim H; intros; apply Rle_antisym; assumption. -symmetry in |- *; apply derive_pt_eq_0; - replace (f x) with (0 * id x + fct_cte (f a) x * 1); - [ apply (derivable_pt_lim_mult (fct_cte (f a)) id x); - [ apply derivable_pt_lim_const | apply derivable_pt_lim_id ] - | unfold id, fct_cte in |- *; rewrite H2; ring ]. -right; reflexivity. +Proof. + intros f a; unfold Newton_integrable in |- *; + apply existT with (fct_cte (f a) * id)%F; left; + unfold antiderivative in |- *; split. + intros; assert (H1 : derivable_pt (fct_cte (f a) * id) x). + apply derivable_pt_mult. + apply derivable_pt_const. + apply derivable_pt_id. + exists H1; assert (H2 : x = a). + elim H; intros; apply Rle_antisym; assumption. + symmetry in |- *; apply derive_pt_eq_0; + replace (f x) with (0 * id x + fct_cte (f a) x * 1); + [ apply (derivable_pt_lim_mult (fct_cte (f a)) id x); + [ apply derivable_pt_lim_const | apply derivable_pt_lim_id ] + | unfold id, fct_cte in |- *; rewrite H2; ring ]. + right; reflexivity. Defined. (* $\int_a^a f = 0$ *) Lemma NewtonInt_P2 : - forall (f:R -> R) (a:R), NewtonInt f a a (NewtonInt_P1 f a) = 0. -intros; unfold NewtonInt in |- *; simpl in |- *; - unfold mult_fct, fct_cte, id in |- *; ring. + forall (f:R -> R) (a:R), NewtonInt f a a (NewtonInt_P1 f a) = 0. +Proof. + intros; unfold NewtonInt in |- *; simpl in |- *; + unfold mult_fct, fct_cte, id in |- *; ring. Qed. (* If $\int_a^b f$ exists, then $\int_b^a f$ exists too *) Lemma NewtonInt_P3 : - forall (f:R -> R) (a b:R) (X:Newton_integrable f a b), - Newton_integrable f b a. -unfold Newton_integrable in |- *; intros; elim X; intros g H; - apply existT with g; tauto. + forall (f:R -> R) (a b:R) (X:Newton_integrable f a b), + Newton_integrable f b a. +Proof. + unfold Newton_integrable in |- *; intros; elim X; intros g H; + apply existT with g; tauto. Defined. (* $\int_a^b f = -\int_b^a f$ *) Lemma NewtonInt_P4 : - forall (f:R -> R) (a b:R) (pr:Newton_integrable f a b), - NewtonInt f a b pr = - NewtonInt f b a (NewtonInt_P3 f a b pr). -intros; unfold Newton_integrable in pr; elim pr; intros; elim p; intro. -unfold NewtonInt in |- *; - case - (NewtonInt_P3 f a b - (existT + forall (f:R -> R) (a b:R) (pr:Newton_integrable f a b), + NewtonInt f a b pr = - NewtonInt f b a (NewtonInt_P3 f a b pr). +Proof. + intros; unfold Newton_integrable in pr; elim pr; intros; elim p; intro. + unfold NewtonInt in |- *; + case + (NewtonInt_P3 f a b + (existT (fun g:R -> R => antiderivative f g a b \/ antiderivative f g b a) x p)). -intros; elim o; intro. -unfold antiderivative in H0; elim H0; intros; elim H2; intro. -unfold antiderivative in H; elim H; intros; - elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H3)). -rewrite H3; ring. -assert (H1 := antiderivative_Ucte f x x0 a b H H0); elim H1; intros; - unfold antiderivative in H0; elim H0; clear H0; intros _ H0. -assert (H3 : a <= a <= b). -split; [ right; reflexivity | assumption ]. -assert (H4 : a <= b <= b). -split; [ assumption | right; reflexivity ]. -assert (H5 := H2 _ H3); assert (H6 := H2 _ H4); rewrite H5; rewrite H6; ring. -unfold NewtonInt in |- *; - case - (NewtonInt_P3 f a b - (existT + intros; elim o; intro. + unfold antiderivative in H0; elim H0; intros; elim H2; intro. + unfold antiderivative in H; elim H; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H3)). + rewrite H3; ring. + assert (H1 := antiderivative_Ucte f x x0 a b H H0); elim H1; intros; + unfold antiderivative in H0; elim H0; clear H0; intros _ H0. + assert (H3 : a <= a <= b). + split; [ right; reflexivity | assumption ]. + assert (H4 : a <= b <= b). + split; [ assumption | right; reflexivity ]. + assert (H5 := H2 _ H3); assert (H6 := H2 _ H4); rewrite H5; rewrite H6; ring. + unfold NewtonInt in |- *; + case + (NewtonInt_P3 f a b + (existT (fun g:R -> R => antiderivative f g a b \/ antiderivative f g b a) x p)); intros; elim o; intro. -assert (H1 := antiderivative_Ucte f x x0 b a H H0); elim H1; intros; - unfold antiderivative in H0; elim H0; clear H0; intros _ H0. -assert (H3 : b <= a <= a). -split; [ assumption | right; reflexivity ]. -assert (H4 : b <= b <= a). -split; [ right; reflexivity | assumption ]. -assert (H5 := H2 _ H3); assert (H6 := H2 _ H4); rewrite H5; rewrite H6; ring. -unfold antiderivative in H0; elim H0; intros; elim H2; intro. -unfold antiderivative in H; elim H; intros; - elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H3)). -rewrite H3; ring. + assert (H1 := antiderivative_Ucte f x x0 b a H H0); elim H1; intros; + unfold antiderivative in H0; elim H0; clear H0; intros _ H0. + assert (H3 : b <= a <= a). + split; [ assumption | right; reflexivity ]. + assert (H4 : b <= b <= a). + split; [ right; reflexivity | assumption ]. + assert (H5 := H2 _ H3); assert (H6 := H2 _ H4); rewrite H5; rewrite H6; ring. + unfold antiderivative in H0; elim H0; intros; elim H2; intro. + unfold antiderivative in H; elim H; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H3)). + rewrite H3; ring. Qed. (* The set of Newton integrable functions is a vectorial space *) Lemma NewtonInt_P5 : - forall (f g:R -> R) (l a b:R), - Newton_integrable f a b -> - Newton_integrable g a b -> - Newton_integrable (fun x:R => l * f x + g x) a b. -unfold Newton_integrable in |- *; intros f g l a b X X0; - elim X; intros; elim X0; intros; - exists (fun y:R => l * x y + x0 y). -elim p; intro. -elim p0; intro. -left; unfold antiderivative in |- *; unfold antiderivative in H, H0; elim H; - clear H; intros; elim H0; clear H0; intros H0 _. -split. -intros; elim (H _ H2); elim (H0 _ H2); intros. -assert (H5 : derivable_pt (fun y:R => l * x y + x0 y) x1). -reg. -exists H5; symmetry in |- *; reg; rewrite <- H3; rewrite <- H4; reflexivity. -assumption. -unfold antiderivative in H, H0; elim H; elim H0; intros; elim H4; intro. -elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H5 H2)). -left; rewrite <- H5; unfold antiderivative in |- *; split. -intros; elim H6; intros; assert (H9 : x1 = a). -apply Rle_antisym; assumption. -assert (H10 : a <= x1 <= b). -split; right; [ symmetry in |- *; assumption | rewrite <- H5; assumption ]. -assert (H11 : b <= x1 <= a). -split; right; [ rewrite <- H5; symmetry in |- *; assumption | assumption ]. -assert (H12 : derivable_pt x x1). -unfold derivable_pt in |- *; exists (f x1); elim (H3 _ H10); intros; - eapply derive_pt_eq_1; symmetry in |- *; apply H12. -assert (H13 : derivable_pt x0 x1). -unfold derivable_pt in |- *; exists (g x1); elim (H1 _ H11); intros; - eapply derive_pt_eq_1; symmetry in |- *; apply H13. -assert (H14 : derivable_pt (fun y:R => l * x y + x0 y) x1). -reg. -exists H14; symmetry in |- *; reg. -assert (H15 : derive_pt x0 x1 H13 = g x1). -elim (H1 _ H11); intros; rewrite H15; apply pr_nu. -assert (H16 : derive_pt x x1 H12 = f x1). -elim (H3 _ H10); intros; rewrite H16; apply pr_nu. -rewrite H15; rewrite H16; ring. -right; reflexivity. -elim p0; intro. -unfold antiderivative in H, H0; elim H; elim H0; intros; elim H4; intro. -elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H5 H2)). -left; rewrite H5; unfold antiderivative in |- *; split. -intros; elim H6; intros; assert (H9 : x1 = a). -apply Rle_antisym; assumption. -assert (H10 : a <= x1 <= b). -split; right; [ symmetry in |- *; assumption | rewrite H5; assumption ]. -assert (H11 : b <= x1 <= a). -split; right; [ rewrite H5; symmetry in |- *; assumption | assumption ]. -assert (H12 : derivable_pt x x1). -unfold derivable_pt in |- *; exists (f x1); elim (H3 _ H11); intros; - eapply derive_pt_eq_1; symmetry in |- *; apply H12. -assert (H13 : derivable_pt x0 x1). -unfold derivable_pt in |- *; exists (g x1); elim (H1 _ H10); intros; - eapply derive_pt_eq_1; symmetry in |- *; apply H13. -assert (H14 : derivable_pt (fun y:R => l * x y + x0 y) x1). -reg. -exists H14; symmetry in |- *; reg. -assert (H15 : derive_pt x0 x1 H13 = g x1). -elim (H1 _ H10); intros; rewrite H15; apply pr_nu. -assert (H16 : derive_pt x x1 H12 = f x1). -elim (H3 _ H11); intros; rewrite H16; apply pr_nu. -rewrite H15; rewrite H16; ring. -right; reflexivity. -right; unfold antiderivative in |- *; unfold antiderivative in H, H0; elim H; - clear H; intros; elim H0; clear H0; intros H0 _; split. -intros; elim (H _ H2); elim (H0 _ H2); intros. -assert (H5 : derivable_pt (fun y:R => l * x y + x0 y) x1). -reg. -exists H5; symmetry in |- *; reg; rewrite <- H3; rewrite <- H4; reflexivity. -assumption. + forall (f g:R -> R) (l a b:R), + Newton_integrable f a b -> + Newton_integrable g a b -> + Newton_integrable (fun x:R => l * f x + g x) a b. +Proof. + unfold Newton_integrable in |- *; intros f g l a b X X0; + elim X; intros; elim X0; intros; + exists (fun y:R => l * x y + x0 y). + elim p; intro. + elim p0; intro. + left; unfold antiderivative in |- *; unfold antiderivative in H, H0; elim H; + clear H; intros; elim H0; clear H0; intros H0 _. + split. + intros; elim (H _ H2); elim (H0 _ H2); intros. + assert (H5 : derivable_pt (fun y:R => l * x y + x0 y) x1). + reg. + exists H5; symmetry in |- *; reg; rewrite <- H3; rewrite <- H4; reflexivity. + assumption. + unfold antiderivative in H, H0; elim H; elim H0; intros; elim H4; intro. + elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H5 H2)). + left; rewrite <- H5; unfold antiderivative in |- *; split. + intros; elim H6; intros; assert (H9 : x1 = a). + apply Rle_antisym; assumption. + assert (H10 : a <= x1 <= b). + split; right; [ symmetry in |- *; assumption | rewrite <- H5; assumption ]. + assert (H11 : b <= x1 <= a). + split; right; [ rewrite <- H5; symmetry in |- *; assumption | assumption ]. + assert (H12 : derivable_pt x x1). + unfold derivable_pt in |- *; exists (f x1); elim (H3 _ H10); intros; + eapply derive_pt_eq_1; symmetry in |- *; apply H12. + assert (H13 : derivable_pt x0 x1). + unfold derivable_pt in |- *; exists (g x1); elim (H1 _ H11); intros; + eapply derive_pt_eq_1; symmetry in |- *; apply H13. + assert (H14 : derivable_pt (fun y:R => l * x y + x0 y) x1). + reg. + exists H14; symmetry in |- *; reg. + assert (H15 : derive_pt x0 x1 H13 = g x1). + elim (H1 _ H11); intros; rewrite H15; apply pr_nu. + assert (H16 : derive_pt x x1 H12 = f x1). + elim (H3 _ H10); intros; rewrite H16; apply pr_nu. + rewrite H15; rewrite H16; ring. + right; reflexivity. + elim p0; intro. + unfold antiderivative in H, H0; elim H; elim H0; intros; elim H4; intro. + elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H5 H2)). + left; rewrite H5; unfold antiderivative in |- *; split. + intros; elim H6; intros; assert (H9 : x1 = a). + apply Rle_antisym; assumption. + assert (H10 : a <= x1 <= b). + split; right; [ symmetry in |- *; assumption | rewrite H5; assumption ]. + assert (H11 : b <= x1 <= a). + split; right; [ rewrite H5; symmetry in |- *; assumption | assumption ]. + assert (H12 : derivable_pt x x1). + unfold derivable_pt in |- *; exists (f x1); elim (H3 _ H11); intros; + eapply derive_pt_eq_1; symmetry in |- *; apply H12. + assert (H13 : derivable_pt x0 x1). + unfold derivable_pt in |- *; exists (g x1); elim (H1 _ H10); intros; + eapply derive_pt_eq_1; symmetry in |- *; apply H13. + assert (H14 : derivable_pt (fun y:R => l * x y + x0 y) x1). + reg. + exists H14; symmetry in |- *; reg. + assert (H15 : derive_pt x0 x1 H13 = g x1). + elim (H1 _ H10); intros; rewrite H15; apply pr_nu. + assert (H16 : derive_pt x x1 H12 = f x1). + elim (H3 _ H11); intros; rewrite H16; apply pr_nu. + rewrite H15; rewrite H16; ring. + right; reflexivity. + right; unfold antiderivative in |- *; unfold antiderivative in H, H0; elim H; + clear H; intros; elim H0; clear H0; intros H0 _; split. + intros; elim (H _ H2); elim (H0 _ H2); intros. + assert (H5 : derivable_pt (fun y:R => l * x y + x0 y) x1). + reg. + exists H5; symmetry in |- *; reg; rewrite <- H3; rewrite <- H4; reflexivity. + assumption. Defined. (**********) Lemma antiderivative_P1 : - forall (f g F G:R -> R) (l a b:R), - antiderivative f F a b -> - antiderivative g G a b -> - antiderivative (fun x:R => l * f x + g x) (fun x:R => l * F x + G x) a b. -unfold antiderivative in |- *; intros; elim H; elim H0; clear H H0; intros; - split. -intros; elim (H _ H3); elim (H1 _ H3); intros. -assert (H6 : derivable_pt (fun x:R => l * F x + G x) x). -reg. -exists H6; symmetry in |- *; reg; rewrite <- H4; rewrite <- H5; ring. -assumption. + forall (f g F G:R -> R) (l a b:R), + antiderivative f F a b -> + antiderivative g G a b -> + antiderivative (fun x:R => l * f x + g x) (fun x:R => l * F x + G x) a b. +Proof. + unfold antiderivative in |- *; intros; elim H; elim H0; clear H H0; intros; + split. + intros; elim (H _ H3); elim (H1 _ H3); intros. + assert (H6 : derivable_pt (fun x:R => l * F x + G x) x). + reg. + exists H6; symmetry in |- *; reg; rewrite <- H4; rewrite <- H5; ring. + assumption. Qed. (* $\int_a^b \lambda f + g = \lambda \int_a^b f + \int_a^b f *) Lemma NewtonInt_P6 : - forall (f g:R -> R) (l a b:R) (pr1:Newton_integrable f a b) - (pr2:Newton_integrable g a b), - NewtonInt (fun x:R => l * f x + g x) a b (NewtonInt_P5 f g l a b pr1 pr2) = - l * NewtonInt f a b pr1 + NewtonInt g a b pr2. -intros f g l a b pr1 pr2; unfold NewtonInt in |- *; - case (NewtonInt_P5 f g l a b pr1 pr2); intros; case pr1; - intros; case pr2; intros; case (total_order_T a b); - intro. -elim s; intro. -elim o; intro. -elim o0; intro. -elim o1; intro. -assert (H2 := antiderivative_P1 f g x0 x1 l a b H0 H1); - assert (H3 := antiderivative_Ucte _ _ _ _ _ H H2); - elim H3; intros; assert (H5 : a <= a <= b). -split; [ right; reflexivity | left; assumption ]. -assert (H6 : a <= b <= b). -split; [ left; assumption | right; reflexivity ]. -assert (H7 := H4 _ H5); assert (H8 := H4 _ H6); rewrite H7; rewrite H8; ring. -unfold antiderivative in H1; elim H1; intros; - elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H3 a0)). -unfold antiderivative in H0; elim H0; intros; - elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)). -unfold antiderivative in H; elim H; intros; - elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 a0)). -rewrite b0; ring. -elim o; intro. -unfold antiderivative in H; elim H; intros; - elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 r)). -elim o0; intro. -unfold antiderivative in H0; elim H0; intros; - elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 r)). -elim o1; intro. -unfold antiderivative in H1; elim H1; intros; - elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H3 r)). -assert (H2 := antiderivative_P1 f g x0 x1 l b a H0 H1); - assert (H3 := antiderivative_Ucte _ _ _ _ _ H H2); - elim H3; intros; assert (H5 : b <= a <= a). -split; [ left; assumption | right; reflexivity ]. -assert (H6 : b <= b <= a). -split; [ right; reflexivity | left; assumption ]. -assert (H7 := H4 _ H5); assert (H8 := H4 _ H6); rewrite H7; rewrite H8; ring. + forall (f g:R -> R) (l a b:R) (pr1:Newton_integrable f a b) + (pr2:Newton_integrable g a b), + NewtonInt (fun x:R => l * f x + g x) a b (NewtonInt_P5 f g l a b pr1 pr2) = + l * NewtonInt f a b pr1 + NewtonInt g a b pr2. +Proof. + intros f g l a b pr1 pr2; unfold NewtonInt in |- *; + case (NewtonInt_P5 f g l a b pr1 pr2); intros; case pr1; + intros; case pr2; intros; case (total_order_T a b); + intro. + elim s; intro. + elim o; intro. + elim o0; intro. + elim o1; intro. + assert (H2 := antiderivative_P1 f g x0 x1 l a b H0 H1); + assert (H3 := antiderivative_Ucte _ _ _ _ _ H H2); + elim H3; intros; assert (H5 : a <= a <= b). + split; [ right; reflexivity | left; assumption ]. + assert (H6 : a <= b <= b). + split; [ left; assumption | right; reflexivity ]. + assert (H7 := H4 _ H5); assert (H8 := H4 _ H6); rewrite H7; rewrite H8; ring. + unfold antiderivative in H1; elim H1; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H3 a0)). + unfold antiderivative in H0; elim H0; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)). + unfold antiderivative in H; elim H; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 a0)). + rewrite b0; ring. + elim o; intro. + unfold antiderivative in H; elim H; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 r)). + elim o0; intro. + unfold antiderivative in H0; elim H0; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 r)). + elim o1; intro. + unfold antiderivative in H1; elim H1; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H3 r)). + assert (H2 := antiderivative_P1 f g x0 x1 l b a H0 H1); + assert (H3 := antiderivative_Ucte _ _ _ _ _ H H2); + elim H3; intros; assert (H5 : b <= a <= a). + split; [ left; assumption | right; reflexivity ]. + assert (H6 : b <= b <= a). + split; [ right; reflexivity | left; assumption ]. + assert (H7 := H4 _ H5); assert (H8 := H4 _ H6); rewrite H7; rewrite H8; ring. Qed. Lemma antiderivative_P2 : - forall (f F0 F1:R -> R) (a b c:R), - antiderivative f F0 a b -> - antiderivative f F1 b c -> - antiderivative f - (fun x:R => - match Rle_dec x b with + forall (f F0 F1:R -> R) (a b c:R), + antiderivative f F0 a b -> + antiderivative f F1 b c -> + antiderivative f + (fun x:R => + match Rle_dec x b with | left _ => F0 x | right _ => F1 x + (F0 b - F1 b) - end) a c. -unfold antiderivative in |- *; intros; elim H; clear H; intros; elim H0; - clear H0; intros; split. -2: apply Rle_trans with b; assumption. -intros; elim H3; clear H3; intros; case (total_order_T x b); intro. -elim s; intro. -assert (H5 : a <= x <= b). -split; [ assumption | left; assumption ]. -assert (H6 := H _ H5); elim H6; clear H6; intros; - assert - (H7 : - derivable_pt_lim - (fun x:R => + end) a c. +Proof. + unfold antiderivative in |- *; intros; elim H; clear H; intros; elim H0; + clear H0; intros; split. + 2: apply Rle_trans with b; assumption. + intros; elim H3; clear H3; intros; case (total_order_T x b); intro. + elim s; intro. + assert (H5 : a <= x <= b). + split; [ assumption | left; assumption ]. + assert (H6 := H _ H5); elim H6; clear H6; intros; + assert + (H7 : + derivable_pt_lim + (fun x:R => + match Rle_dec x b with + | left _ => F0 x + | right _ => F1 x + (F0 b - F1 b) + end) x (f x)). + unfold derivable_pt_lim in |- *; assert (H7 : derive_pt F0 x x0 = f x). + symmetry in |- *; assumption. + assert (H8 := derive_pt_eq_1 F0 x (f x) x0 H7); unfold derivable_pt_lim in H8; + intros; elim (H8 _ H9); intros; set (D := Rmin x1 (b - x)). + assert (H11 : 0 < D). + unfold D in |- *; unfold Rmin in |- *; case (Rle_dec x1 (b - x)); intro. + apply (cond_pos x1). + apply Rlt_Rminus; assumption. + exists (mkposreal _ H11); intros; case (Rle_dec x b); intro. + case (Rle_dec (x + h) b); intro. + apply H10. + assumption. + apply Rlt_le_trans with D; [ assumption | unfold D in |- *; apply Rmin_l ]. + elim n; left; apply Rlt_le_trans with (x + D). + apply Rplus_lt_compat_l; apply Rle_lt_trans with (Rabs h). + apply RRle_abs. + apply H13. + apply Rplus_le_reg_l with (- x); rewrite <- Rplus_assoc; rewrite Rplus_opp_l; + rewrite Rplus_0_l; rewrite Rplus_comm; unfold D in |- *; + apply Rmin_r. + elim n; left; assumption. + assert + (H8 : + derivable_pt + (fun x:R => match Rle_dec x b with - | left _ => F0 x - | right _ => F1 x + (F0 b - F1 b) - end) x (f x)). -unfold derivable_pt_lim in |- *; assert (H7 : derive_pt F0 x x0 = f x). -symmetry in |- *; assumption. -assert (H8 := derive_pt_eq_1 F0 x (f x) x0 H7); unfold derivable_pt_lim in H8; - intros; elim (H8 _ H9); intros; set (D := Rmin x1 (b - x)). -assert (H11 : 0 < D). -unfold D in |- *; unfold Rmin in |- *; case (Rle_dec x1 (b - x)); intro. -apply (cond_pos x1). -apply Rlt_Rminus; assumption. -exists (mkposreal _ H11); intros; case (Rle_dec x b); intro. -case (Rle_dec (x + h) b); intro. -apply H10. -assumption. -apply Rlt_le_trans with D; [ assumption | unfold D in |- *; apply Rmin_l ]. -elim n; left; apply Rlt_le_trans with (x + D). -apply Rplus_lt_compat_l; apply Rle_lt_trans with (Rabs h). -apply RRle_abs. -apply H13. -apply Rplus_le_reg_l with (- x); rewrite <- Rplus_assoc; rewrite Rplus_opp_l; - rewrite Rplus_0_l; rewrite Rplus_comm; unfold D in |- *; - apply Rmin_r. -elim n; left; assumption. -assert - (H8 : - derivable_pt - (fun x:R => - match Rle_dec x b with - | left _ => F0 x - | right _ => F1 x + (F0 b - F1 b) - end) x). -unfold derivable_pt in |- *; apply existT with (f x); apply H7. -exists H8; symmetry in |- *; apply derive_pt_eq_0; apply H7. -assert (H5 : a <= x <= b). -split; [ assumption | right; assumption ]. -assert (H6 : b <= x <= c). -split; [ right; symmetry in |- *; assumption | assumption ]. -elim (H _ H5); elim (H0 _ H6); intros; assert (H9 : derive_pt F0 x x1 = f x). -symmetry in |- *; assumption. -assert (H10 : derive_pt F1 x x0 = f x). -symmetry in |- *; assumption. -assert (H11 := derive_pt_eq_1 F0 x (f x) x1 H9); - assert (H12 := derive_pt_eq_1 F1 x (f x) x0 H10); - assert - (H13 : - derivable_pt_lim - (fun x:R => + | left _ => F0 x + | right _ => F1 x + (F0 b - F1 b) + end) x). + unfold derivable_pt in |- *; apply existT with (f x); apply H7. + exists H8; symmetry in |- *; apply derive_pt_eq_0; apply H7. + assert (H5 : a <= x <= b). + split; [ assumption | right; assumption ]. + assert (H6 : b <= x <= c). + split; [ right; symmetry in |- *; assumption | assumption ]. + elim (H _ H5); elim (H0 _ H6); intros; assert (H9 : derive_pt F0 x x1 = f x). + symmetry in |- *; assumption. + assert (H10 : derive_pt F1 x x0 = f x). + symmetry in |- *; assumption. + assert (H11 := derive_pt_eq_1 F0 x (f x) x1 H9); + assert (H12 := derive_pt_eq_1 F1 x (f x) x0 H10); + assert + (H13 : + derivable_pt_lim + (fun x:R => + match Rle_dec x b with + | left _ => F0 x + | right _ => F1 x + (F0 b - F1 b) + end) x (f x)). + unfold derivable_pt_lim in |- *; unfold derivable_pt_lim in H11, H12; intros; + elim (H11 _ H13); elim (H12 _ H13); intros; set (D := Rmin x2 x3); + assert (H16 : 0 < D). + unfold D in |- *; unfold Rmin in |- *; case (Rle_dec x2 x3); intro. + apply (cond_pos x2). + apply (cond_pos x3). + exists (mkposreal _ H16); intros; case (Rle_dec x b); intro. + case (Rle_dec (x + h) b); intro. + apply H15. + assumption. + apply Rlt_le_trans with D; [ assumption | unfold D in |- *; apply Rmin_r ]. + replace (F1 (x + h) + (F0 b - F1 b) - F0 x) with (F1 (x + h) - F1 x). + apply H14. + assumption. + apply Rlt_le_trans with D; [ assumption | unfold D in |- *; apply Rmin_l ]. + rewrite b0; ring. + elim n; right; assumption. + assert + (H14 : + derivable_pt + (fun x:R => match Rle_dec x b with - | left _ => F0 x - | right _ => F1 x + (F0 b - F1 b) - end) x (f x)). -unfold derivable_pt_lim in |- *; unfold derivable_pt_lim in H11, H12; intros; - elim (H11 _ H13); elim (H12 _ H13); intros; set (D := Rmin x2 x3); - assert (H16 : 0 < D). -unfold D in |- *; unfold Rmin in |- *; case (Rle_dec x2 x3); intro. -apply (cond_pos x2). -apply (cond_pos x3). -exists (mkposreal _ H16); intros; case (Rle_dec x b); intro. -case (Rle_dec (x + h) b); intro. -apply H15. -assumption. -apply Rlt_le_trans with D; [ assumption | unfold D in |- *; apply Rmin_r ]. -replace (F1 (x + h) + (F0 b - F1 b) - F0 x) with (F1 (x + h) - F1 x). -apply H14. -assumption. -apply Rlt_le_trans with D; [ assumption | unfold D in |- *; apply Rmin_l ]. -rewrite b0; ring. -elim n; right; assumption. -assert - (H14 : - derivable_pt - (fun x:R => - match Rle_dec x b with - | left _ => F0 x - | right _ => F1 x + (F0 b - F1 b) - end) x). -unfold derivable_pt in |- *; apply existT with (f x); apply H13. -exists H14; symmetry in |- *; apply derive_pt_eq_0; apply H13. -assert (H5 : b <= x <= c). -split; [ left; assumption | assumption ]. -assert (H6 := H0 _ H5); elim H6; clear H6; intros; - assert - (H7 : - derivable_pt_lim - (fun x:R => + | left _ => F0 x + | right _ => F1 x + (F0 b - F1 b) + end) x). + unfold derivable_pt in |- *; apply existT with (f x); apply H13. + exists H14; symmetry in |- *; apply derive_pt_eq_0; apply H13. + assert (H5 : b <= x <= c). + split; [ left; assumption | assumption ]. + assert (H6 := H0 _ H5); elim H6; clear H6; intros; + assert + (H7 : + derivable_pt_lim + (fun x:R => + match Rle_dec x b with + | left _ => F0 x + | right _ => F1 x + (F0 b - F1 b) + end) x (f x)). + unfold derivable_pt_lim in |- *; assert (H7 : derive_pt F1 x x0 = f x). + symmetry in |- *; assumption. + assert (H8 := derive_pt_eq_1 F1 x (f x) x0 H7); unfold derivable_pt_lim in H8; + intros; elim (H8 _ H9); intros; set (D := Rmin x1 (x - b)); + assert (H11 : 0 < D). + unfold D in |- *; unfold Rmin in |- *; case (Rle_dec x1 (x - b)); intro. + apply (cond_pos x1). + apply Rlt_Rminus; assumption. + exists (mkposreal _ H11); intros; case (Rle_dec x b); intro. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 r)). + case (Rle_dec (x + h) b); intro. + cut (b < x + h). + intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 H14)). + apply Rplus_lt_reg_r with (- h - b); replace (- h - b + b) with (- h); + [ idtac | ring ]; replace (- h - b + (x + h)) with (x - b); + [ idtac | ring ]; apply Rle_lt_trans with (Rabs h). + rewrite <- Rabs_Ropp; apply RRle_abs. + apply Rlt_le_trans with D. + apply H13. + unfold D in |- *; apply Rmin_r. + replace (F1 (x + h) + (F0 b - F1 b) - (F1 x + (F0 b - F1 b))) with + (F1 (x + h) - F1 x); [ idtac | ring ]; apply H10. + assumption. + apply Rlt_le_trans with D. + assumption. + unfold D in |- *; apply Rmin_l. + assert + (H8 : + derivable_pt + (fun x:R => match Rle_dec x b with - | left _ => F0 x - | right _ => F1 x + (F0 b - F1 b) - end) x (f x)). -unfold derivable_pt_lim in |- *; assert (H7 : derive_pt F1 x x0 = f x). -symmetry in |- *; assumption. -assert (H8 := derive_pt_eq_1 F1 x (f x) x0 H7); unfold derivable_pt_lim in H8; - intros; elim (H8 _ H9); intros; set (D := Rmin x1 (x - b)); - assert (H11 : 0 < D). -unfold D in |- *; unfold Rmin in |- *; case (Rle_dec x1 (x - b)); intro. -apply (cond_pos x1). -apply Rlt_Rminus; assumption. -exists (mkposreal _ H11); intros; case (Rle_dec x b); intro. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 r)). -case (Rle_dec (x + h) b); intro. -cut (b < x + h). -intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 H14)). -apply Rplus_lt_reg_r with (- h - b); replace (- h - b + b) with (- h); - [ idtac | ring ]; replace (- h - b + (x + h)) with (x - b); - [ idtac | ring ]; apply Rle_lt_trans with (Rabs h). -rewrite <- Rabs_Ropp; apply RRle_abs. -apply Rlt_le_trans with D. -apply H13. -unfold D in |- *; apply Rmin_r. -replace (F1 (x + h) + (F0 b - F1 b) - (F1 x + (F0 b - F1 b))) with - (F1 (x + h) - F1 x); [ idtac | ring ]; apply H10. -assumption. -apply Rlt_le_trans with D. -assumption. -unfold D in |- *; apply Rmin_l. -assert - (H8 : - derivable_pt - (fun x:R => - match Rle_dec x b with - | left _ => F0 x - | right _ => F1 x + (F0 b - F1 b) - end) x). -unfold derivable_pt in |- *; apply existT with (f x); apply H7. -exists H8; symmetry in |- *; apply derive_pt_eq_0; apply H7. + | left _ => F0 x + | right _ => F1 x + (F0 b - F1 b) + end) x). + unfold derivable_pt in |- *; apply existT with (f x); apply H7. + exists H8; symmetry in |- *; apply derive_pt_eq_0; apply H7. Qed. Lemma antiderivative_P3 : - forall (f F0 F1:R -> R) (a b c:R), - antiderivative f F0 a b -> - antiderivative f F1 c b -> - antiderivative f F1 c a \/ antiderivative f F0 a c. -intros; unfold antiderivative in H, H0; elim H; clear H; elim H0; clear H0; - intros; case (total_order_T a c); intro. -elim s; intro. -right; unfold antiderivative in |- *; split. -intros; apply H1; elim H3; intros; split; - [ assumption | apply Rle_trans with c; assumption ]. -left; assumption. -right; unfold antiderivative in |- *; split. -intros; apply H1; elim H3; intros; split; - [ assumption | apply Rle_trans with c; assumption ]. -right; assumption. -left; unfold antiderivative in |- *; split. -intros; apply H; elim H3; intros; split; - [ assumption | apply Rle_trans with a; assumption ]. -left; assumption. + forall (f F0 F1:R -> R) (a b c:R), + antiderivative f F0 a b -> + antiderivative f F1 c b -> + antiderivative f F1 c a \/ antiderivative f F0 a c. +Proof. + intros; unfold antiderivative in H, H0; elim H; clear H; elim H0; clear H0; + intros; case (total_order_T a c); intro. + elim s; intro. + right; unfold antiderivative in |- *; split. + intros; apply H1; elim H3; intros; split; + [ assumption | apply Rle_trans with c; assumption ]. + left; assumption. + right; unfold antiderivative in |- *; split. + intros; apply H1; elim H3; intros; split; + [ assumption | apply Rle_trans with c; assumption ]. + right; assumption. + left; unfold antiderivative in |- *; split. + intros; apply H; elim H3; intros; split; + [ assumption | apply Rle_trans with a; assumption ]. + left; assumption. Qed. Lemma antiderivative_P4 : - forall (f F0 F1:R -> R) (a b c:R), - antiderivative f F0 a b -> - antiderivative f F1 a c -> - antiderivative f F1 b c \/ antiderivative f F0 c b. -intros; unfold antiderivative in H, H0; elim H; clear H; elim H0; clear H0; - intros; case (total_order_T c b); intro. -elim s; intro. -right; unfold antiderivative in |- *; split. -intros; apply H1; elim H3; intros; split; - [ apply Rle_trans with c; assumption | assumption ]. -left; assumption. -right; unfold antiderivative in |- *; split. -intros; apply H1; elim H3; intros; split; - [ apply Rle_trans with c; assumption | assumption ]. -right; assumption. -left; unfold antiderivative in |- *; split. -intros; apply H; elim H3; intros; split; - [ apply Rle_trans with b; assumption | assumption ]. -left; assumption. + forall (f F0 F1:R -> R) (a b c:R), + antiderivative f F0 a b -> + antiderivative f F1 a c -> + antiderivative f F1 b c \/ antiderivative f F0 c b. +Proof. + intros; unfold antiderivative in H, H0; elim H; clear H; elim H0; clear H0; + intros; case (total_order_T c b); intro. + elim s; intro. + right; unfold antiderivative in |- *; split. + intros; apply H1; elim H3; intros; split; + [ apply Rle_trans with c; assumption | assumption ]. + left; assumption. + right; unfold antiderivative in |- *; split. + intros; apply H1; elim H3; intros; split; + [ apply Rle_trans with c; assumption | assumption ]. + right; assumption. + left; unfold antiderivative in |- *; split. + intros; apply H; elim H3; intros; split; + [ apply Rle_trans with b; assumption | assumption ]. + left; assumption. Qed. Lemma NewtonInt_P7 : - forall (f:R -> R) (a b c:R), - a < b -> - b < c -> - Newton_integrable f a b -> - Newton_integrable f b c -> Newton_integrable f a c. -unfold Newton_integrable in |- *; intros f a b c Hab Hbc X X0; elim X; - clear X; intros F0 H0; elim X0; clear X0; intros F1 H1; - set - (g := - fun x:R => - match Rle_dec x b with - | left _ => F0 x - | right _ => F1 x + (F0 b - F1 b) - end); apply existT with g; left; unfold g in |- *; - apply antiderivative_P2. -elim H0; intro. -assumption. -unfold antiderivative in H; elim H; clear H; intros; - elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hab)). -elim H1; intro. -assumption. -unfold antiderivative in H; elim H; clear H; intros; - elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hbc)). + forall (f:R -> R) (a b c:R), + a < b -> + b < c -> + Newton_integrable f a b -> + Newton_integrable f b c -> Newton_integrable f a c. +Proof. + unfold Newton_integrable in |- *; intros f a b c Hab Hbc X X0; elim X; + clear X; intros F0 H0; elim X0; clear X0; intros F1 H1; + set + (g := + fun x:R => + match Rle_dec x b with + | left _ => F0 x + | right _ => F1 x + (F0 b - F1 b) + end); apply existT with g; left; unfold g in |- *; + apply antiderivative_P2. + elim H0; intro. + assumption. + unfold antiderivative in H; elim H; clear H; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hab)). + elim H1; intro. + assumption. + unfold antiderivative in H; elim H; clear H; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hbc)). Qed. Lemma NewtonInt_P8 : - forall (f:R -> R) (a b c:R), - Newton_integrable f a b -> - Newton_integrable f b c -> Newton_integrable f a c. -intros. -elim X; intros F0 H0. -elim X0; intros F1 H1. -case (total_order_T a b); intro. -elim s; intro. -case (total_order_T b c); intro. -elim s0; intro. + forall (f:R -> R) (a b c:R), + Newton_integrable f a b -> + Newton_integrable f b c -> Newton_integrable f a c. +Proof. + intros. + elim X; intros F0 H0. + elim X0; intros F1 H1. + case (total_order_T a b); intro. + elim s; intro. + case (total_order_T b c); intro. + elim s0; intro. (* a<b & b<c *) -unfold Newton_integrable in |- *; - apply existT with - (fun x:R => - match Rle_dec x b with - | left _ => F0 x - | right _ => F1 x + (F0 b - F1 b) - end). -elim H0; intro. -elim H1; intro. -left; apply antiderivative_P2; assumption. -unfold antiderivative in H2; elim H2; clear H2; intros _ H2. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a1)). -unfold antiderivative in H; elim H; clear H; intros _ H. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)). + unfold Newton_integrable in |- *; + apply existT with + (fun x:R => + match Rle_dec x b with + | left _ => F0 x + | right _ => F1 x + (F0 b - F1 b) + end). + elim H0; intro. + elim H1; intro. + left; apply antiderivative_P2; assumption. + unfold antiderivative in H2; elim H2; clear H2; intros _ H2. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a1)). + unfold antiderivative in H; elim H; clear H; intros _ H. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)). (* a<b & b=c *) -rewrite b0 in X; apply X. + rewrite b0 in X; apply X. (* a<b & b>c *) -case (total_order_T a c); intro. -elim s0; intro. -unfold Newton_integrable in |- *; apply existT with F0. -left. -elim H1; intro. -unfold antiderivative in H; elim H; clear H; intros _ H. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). -elim H0; intro. -assert (H3 := antiderivative_P3 f F0 F1 a b c H2 H). -elim H3; intro. -unfold antiderivative in H4; elim H4; clear H4; intros _ H4. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 a1)). -assumption. -unfold antiderivative in H2; elim H2; clear H2; intros _ H2. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)). -rewrite b0; apply NewtonInt_P1. -unfold Newton_integrable in |- *; apply existT with F1. -right. -elim H1; intro. -unfold antiderivative in H; elim H; clear H; intros _ H. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). -elim H0; intro. -assert (H3 := antiderivative_P3 f F0 F1 a b c H2 H). -elim H3; intro. -assumption. -unfold antiderivative in H4; elim H4; clear H4; intros _ H4. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 r0)). -unfold antiderivative in H2; elim H2; clear H2; intros _ H2. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)). + case (total_order_T a c); intro. + elim s0; intro. + unfold Newton_integrable in |- *; apply existT with F0. + left. + elim H1; intro. + unfold antiderivative in H; elim H; clear H; intros _ H. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). + elim H0; intro. + assert (H3 := antiderivative_P3 f F0 F1 a b c H2 H). + elim H3; intro. + unfold antiderivative in H4; elim H4; clear H4; intros _ H4. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 a1)). + assumption. + unfold antiderivative in H2; elim H2; clear H2; intros _ H2. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)). + rewrite b0; apply NewtonInt_P1. + unfold Newton_integrable in |- *; apply existT with F1. + right. + elim H1; intro. + unfold antiderivative in H; elim H; clear H; intros _ H. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). + elim H0; intro. + assert (H3 := antiderivative_P3 f F0 F1 a b c H2 H). + elim H3; intro. + assumption. + unfold antiderivative in H4; elim H4; clear H4; intros _ H4. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 r0)). + unfold antiderivative in H2; elim H2; clear H2; intros _ H2. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)). (* a=b *) -rewrite b0; apply X0. -case (total_order_T b c); intro. -elim s; intro. + rewrite b0; apply X0. + case (total_order_T b c); intro. + elim s; intro. (* a>b & b<c *) -case (total_order_T a c); intro. -elim s0; intro. -unfold Newton_integrable in |- *; apply existT with F1. -left. -elim H1; intro. + case (total_order_T a c); intro. + elim s0; intro. + unfold Newton_integrable in |- *; apply existT with F1. + left. + elim H1; intro. (*****************) -elim H0; intro. -unfold antiderivative in H2; elim H2; clear H2; intros _ H2. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 r)). -assert (H3 := antiderivative_P4 f F0 F1 b a c H2 H). -elim H3; intro. -assumption. -unfold antiderivative in H4; elim H4; clear H4; intros _ H4. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 a1)). -unfold antiderivative in H; elim H; clear H; intros _ H. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)). -rewrite b0; apply NewtonInt_P1. -unfold Newton_integrable in |- *; apply existT with F0. -right. -elim H0; intro. -unfold antiderivative in H; elim H; clear H; intros _ H. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). -elim H1; intro. -assert (H3 := antiderivative_P4 f F0 F1 b a c H H2). -elim H3; intro. -unfold antiderivative in H4; elim H4; clear H4; intros _ H4. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 r0)). -assumption. -unfold antiderivative in H2; elim H2; clear H2; intros _ H2. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)). + elim H0; intro. + unfold antiderivative in H2; elim H2; clear H2; intros _ H2. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 r)). + assert (H3 := antiderivative_P4 f F0 F1 b a c H2 H). + elim H3; intro. + assumption. + unfold antiderivative in H4; elim H4; clear H4; intros _ H4. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 a1)). + unfold antiderivative in H; elim H; clear H; intros _ H. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)). + rewrite b0; apply NewtonInt_P1. + unfold Newton_integrable in |- *; apply existT with F0. + right. + elim H0; intro. + unfold antiderivative in H; elim H; clear H; intros _ H. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). + elim H1; intro. + assert (H3 := antiderivative_P4 f F0 F1 b a c H H2). + elim H3; intro. + unfold antiderivative in H4; elim H4; clear H4; intros _ H4. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 r0)). + assumption. + unfold antiderivative in H2; elim H2; clear H2; intros _ H2. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)). (* a>b & b=c *) -rewrite b0 in X; apply X. + rewrite b0 in X; apply X. (* a>b & b>c *) -assert (X1 := NewtonInt_P3 f a b X). -assert (X2 := NewtonInt_P3 f b c X0). -apply NewtonInt_P3. -apply NewtonInt_P7 with b; assumption. + assert (X1 := NewtonInt_P3 f a b X). + assert (X2 := NewtonInt_P3 f b c X0). + apply NewtonInt_P3. + apply NewtonInt_P7 with b; assumption. Defined. (* Chasles' relation *) Lemma NewtonInt_P9 : - forall (f:R -> R) (a b c:R) (pr1:Newton_integrable f a b) - (pr2:Newton_integrable f b c), - NewtonInt f a c (NewtonInt_P8 f a b c pr1 pr2) = - NewtonInt f a b pr1 + NewtonInt f b c pr2. -intros; unfold NewtonInt in |- *. -case (NewtonInt_P8 f a b c pr1 pr2); intros. -case pr1; intros. -case pr2; intros. -case (total_order_T a b); intro. -elim s; intro. -case (total_order_T b c); intro. -elim s0; intro. + forall (f:R -> R) (a b c:R) (pr1:Newton_integrable f a b) + (pr2:Newton_integrable f b c), + NewtonInt f a c (NewtonInt_P8 f a b c pr1 pr2) = + NewtonInt f a b pr1 + NewtonInt f b c pr2. +Proof. + intros; unfold NewtonInt in |- *. + case (NewtonInt_P8 f a b c pr1 pr2); intros. + case pr1; intros. + case pr2; intros. + case (total_order_T a b); intro. + elim s; intro. + case (total_order_T b c); intro. + elim s0; intro. (* a<b & b<c *) -elim o0; intro. -elim o1; intro. -elim o; intro. -assert (H2 := antiderivative_P2 f x0 x1 a b c H H0). -assert - (H3 := - antiderivative_Ucte f x - (fun x:R => - match Rle_dec x b with - | left _ => x0 x - | right _ => x1 x + (x0 b - x1 b) - end) a c H1 H2). -elim H3; intros. -assert (H5 : a <= a <= c). -split; [ right; reflexivity | left; apply Rlt_trans with b; assumption ]. -assert (H6 : a <= c <= c). -split; [ left; apply Rlt_trans with b; assumption | right; reflexivity ]. -rewrite (H4 _ H5); rewrite (H4 _ H6). -case (Rle_dec a b); intro. -case (Rle_dec c b); intro. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 a1)). -ring. -elim n; left; assumption. -unfold antiderivative in H1; elim H1; clear H1; intros _ H1. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 (Rlt_trans _ _ _ a0 a1))). -unfold antiderivative in H0; elim H0; clear H0; intros _ H0. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a1)). -unfold antiderivative in H; elim H; clear H; intros _ H. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)). + elim o0; intro. + elim o1; intro. + elim o; intro. + assert (H2 := antiderivative_P2 f x0 x1 a b c H H0). + assert + (H3 := + antiderivative_Ucte f x + (fun x:R => + match Rle_dec x b with + | left _ => x0 x + | right _ => x1 x + (x0 b - x1 b) + end) a c H1 H2). + elim H3; intros. + assert (H5 : a <= a <= c). + split; [ right; reflexivity | left; apply Rlt_trans with b; assumption ]. + assert (H6 : a <= c <= c). + split; [ left; apply Rlt_trans with b; assumption | right; reflexivity ]. + rewrite (H4 _ H5); rewrite (H4 _ H6). + case (Rle_dec a b); intro. + case (Rle_dec c b); intro. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 a1)). + ring. + elim n; left; assumption. + unfold antiderivative in H1; elim H1; clear H1; intros _ H1. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 (Rlt_trans _ _ _ a0 a1))). + unfold antiderivative in H0; elim H0; clear H0; intros _ H0. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a1)). + unfold antiderivative in H; elim H; clear H; intros _ H. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)). (* a<b & b=c *) -rewrite <- b0. -unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rplus_0_r. -rewrite <- b0 in o. -elim o0; intro. -elim o; intro. -assert (H1 := antiderivative_Ucte f x x0 a b H0 H). -elim H1; intros. -rewrite (H2 b). -rewrite (H2 a). -ring. -split; [ right; reflexivity | left; assumption ]. -split; [ left; assumption | right; reflexivity ]. -unfold antiderivative in H0; elim H0; clear H0; intros _ H0. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a0)). -unfold antiderivative in H; elim H; clear H; intros _ H. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)). + rewrite <- b0. + unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rplus_0_r. + rewrite <- b0 in o. + elim o0; intro. + elim o; intro. + assert (H1 := antiderivative_Ucte f x x0 a b H0 H). + elim H1; intros. + rewrite (H2 b). + rewrite (H2 a). + ring. + split; [ right; reflexivity | left; assumption ]. + split; [ left; assumption | right; reflexivity ]. + unfold antiderivative in H0; elim H0; clear H0; intros _ H0. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a0)). + unfold antiderivative in H; elim H; clear H; intros _ H. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)). (* a<b & b>c *) -elim o1; intro. -unfold antiderivative in H; elim H; clear H; intros _ H. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). -elim o0; intro. -elim o; intro. -assert (H2 := antiderivative_P2 f x x1 a c b H1 H). -assert (H3 := antiderivative_Ucte _ _ _ a b H0 H2). -elim H3; intros. -rewrite (H4 a). -rewrite (H4 b). -case (Rle_dec b c); intro. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 r)). -case (Rle_dec a c); intro. -ring. -elim n0; unfold antiderivative in H1; elim H1; intros; assumption. -split; [ left; assumption | right; reflexivity ]. -split; [ right; reflexivity | left; assumption ]. -assert (H2 := antiderivative_P2 _ _ _ _ _ _ H1 H0). -assert (H3 := antiderivative_Ucte _ _ _ c b H H2). -elim H3; intros. -rewrite (H4 c). -rewrite (H4 b). -case (Rle_dec b a); intro. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 a0)). -case (Rle_dec c a); intro. -ring. -elim n0; unfold antiderivative in H1; elim H1; intros; assumption. -split; [ left; assumption | right; reflexivity ]. -split; [ right; reflexivity | left; assumption ]. -unfold antiderivative in H0; elim H0; clear H0; intros _ H0. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a0)). + elim o1; intro. + unfold antiderivative in H; elim H; clear H; intros _ H. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). + elim o0; intro. + elim o; intro. + assert (H2 := antiderivative_P2 f x x1 a c b H1 H). + assert (H3 := antiderivative_Ucte _ _ _ a b H0 H2). + elim H3; intros. + rewrite (H4 a). + rewrite (H4 b). + case (Rle_dec b c); intro. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 r)). + case (Rle_dec a c); intro. + ring. + elim n0; unfold antiderivative in H1; elim H1; intros; assumption. + split; [ left; assumption | right; reflexivity ]. + split; [ right; reflexivity | left; assumption ]. + assert (H2 := antiderivative_P2 _ _ _ _ _ _ H1 H0). + assert (H3 := antiderivative_Ucte _ _ _ c b H H2). + elim H3; intros. + rewrite (H4 c). + rewrite (H4 b). + case (Rle_dec b a); intro. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 a0)). + case (Rle_dec c a); intro. + ring. + elim n0; unfold antiderivative in H1; elim H1; intros; assumption. + split; [ left; assumption | right; reflexivity ]. + split; [ right; reflexivity | left; assumption ]. + unfold antiderivative in H0; elim H0; clear H0; intros _ H0. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a0)). (* a=b *) -rewrite b0 in o; rewrite b0. -elim o; intro. -elim o1; intro. -assert (H1 := antiderivative_Ucte _ _ _ b c H H0). -elim H1; intros. -assert (H3 : b <= c). -unfold antiderivative in H; elim H; intros; assumption. -rewrite (H2 b). -rewrite (H2 c). -ring. -split; [ assumption | right; reflexivity ]. -split; [ right; reflexivity | assumption ]. -assert (H1 : b = c). -unfold antiderivative in H, H0; elim H; elim H0; intros; apply Rle_antisym; - assumption. -rewrite H1; ring. -elim o1; intro. -assert (H1 : b = c). -unfold antiderivative in H, H0; elim H; elim H0; intros; apply Rle_antisym; - assumption. -rewrite H1; ring. -assert (H1 := antiderivative_Ucte _ _ _ c b H H0). -elim H1; intros. -assert (H3 : c <= b). -unfold antiderivative in H; elim H; intros; assumption. -rewrite (H2 c). -rewrite (H2 b). -ring. -split; [ assumption | right; reflexivity ]. -split; [ right; reflexivity | assumption ]. + rewrite b0 in o; rewrite b0. + elim o; intro. + elim o1; intro. + assert (H1 := antiderivative_Ucte _ _ _ b c H H0). + elim H1; intros. + assert (H3 : b <= c). + unfold antiderivative in H; elim H; intros; assumption. + rewrite (H2 b). + rewrite (H2 c). + ring. + split; [ assumption | right; reflexivity ]. + split; [ right; reflexivity | assumption ]. + assert (H1 : b = c). + unfold antiderivative in H, H0; elim H; elim H0; intros; apply Rle_antisym; + assumption. + rewrite H1; ring. + elim o1; intro. + assert (H1 : b = c). + unfold antiderivative in H, H0; elim H; elim H0; intros; apply Rle_antisym; + assumption. + rewrite H1; ring. + assert (H1 := antiderivative_Ucte _ _ _ c b H H0). + elim H1; intros. + assert (H3 : c <= b). + unfold antiderivative in H; elim H; intros; assumption. + rewrite (H2 c). + rewrite (H2 b). + ring. + split; [ assumption | right; reflexivity ]. + split; [ right; reflexivity | assumption ]. (* a>b & b<c *) -case (total_order_T b c); intro. -elim s; intro. -elim o0; intro. -unfold antiderivative in H; elim H; clear H; intros _ H. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). -elim o1; intro. -elim o; intro. -assert (H2 := antiderivative_P2 _ _ _ _ _ _ H H1). -assert (H3 := antiderivative_Ucte _ _ _ b c H0 H2). -elim H3; intros. -rewrite (H4 b). -rewrite (H4 c). -case (Rle_dec b a); intro. -case (Rle_dec c a); intro. -assert (H5 : a = c). -unfold antiderivative in H1; elim H1; intros; apply Rle_antisym; assumption. -rewrite H5; ring. -ring. -elim n; left; assumption. -split; [ left; assumption | right; reflexivity ]. -split; [ right; reflexivity | left; assumption ]. -assert (H2 := antiderivative_P2 _ _ _ _ _ _ H0 H1). -assert (H3 := antiderivative_Ucte _ _ _ b a H H2). -elim H3; intros. -rewrite (H4 a). -rewrite (H4 b). -case (Rle_dec b c); intro. -case (Rle_dec a c); intro. -assert (H5 : a = c). -unfold antiderivative in H1; elim H1; intros; apply Rle_antisym; assumption. -rewrite H5; ring. -ring. -elim n; left; assumption. -split; [ right; reflexivity | left; assumption ]. -split; [ left; assumption | right; reflexivity ]. -unfold antiderivative in H0; elim H0; clear H0; intros _ H0. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a0)). + case (total_order_T b c); intro. + elim s; intro. + elim o0; intro. + unfold antiderivative in H; elim H; clear H; intros _ H. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). + elim o1; intro. + elim o; intro. + assert (H2 := antiderivative_P2 _ _ _ _ _ _ H H1). + assert (H3 := antiderivative_Ucte _ _ _ b c H0 H2). + elim H3; intros. + rewrite (H4 b). + rewrite (H4 c). + case (Rle_dec b a); intro. + case (Rle_dec c a); intro. + assert (H5 : a = c). + unfold antiderivative in H1; elim H1; intros; apply Rle_antisym; assumption. + rewrite H5; ring. + ring. + elim n; left; assumption. + split; [ left; assumption | right; reflexivity ]. + split; [ right; reflexivity | left; assumption ]. + assert (H2 := antiderivative_P2 _ _ _ _ _ _ H0 H1). + assert (H3 := antiderivative_Ucte _ _ _ b a H H2). + elim H3; intros. + rewrite (H4 a). + rewrite (H4 b). + case (Rle_dec b c); intro. + case (Rle_dec a c); intro. + assert (H5 : a = c). + unfold antiderivative in H1; elim H1; intros; apply Rle_antisym; assumption. + rewrite H5; ring. + ring. + elim n; left; assumption. + split; [ right; reflexivity | left; assumption ]. + split; [ left; assumption | right; reflexivity ]. + unfold antiderivative in H0; elim H0; clear H0; intros _ H0. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a0)). (* a>b & b=c *) -rewrite <- b0. -unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rplus_0_r. -rewrite <- b0 in o. -elim o0; intro. -unfold antiderivative in H; elim H; clear H; intros _ H. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). -elim o; intro. -unfold antiderivative in H0; elim H0; clear H0; intros _ H0. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 r)). -assert (H1 := antiderivative_Ucte f x x0 b a H0 H). -elim H1; intros. -rewrite (H2 b). -rewrite (H2 a). -ring. -split; [ left; assumption | right; reflexivity ]. -split; [ right; reflexivity | left; assumption ]. + rewrite <- b0. + unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rplus_0_r. + rewrite <- b0 in o. + elim o0; intro. + unfold antiderivative in H; elim H; clear H; intros _ H. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). + elim o; intro. + unfold antiderivative in H0; elim H0; clear H0; intros _ H0. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 r)). + assert (H1 := antiderivative_Ucte f x x0 b a H0 H). + elim H1; intros. + rewrite (H2 b). + rewrite (H2 a). + ring. + split; [ left; assumption | right; reflexivity ]. + split; [ right; reflexivity | left; assumption ]. (* a>b & b>c *) -elim o0; intro. -unfold antiderivative in H; elim H; clear H; intros _ H. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). -elim o1; intro. -unfold antiderivative in H0; elim H0; clear H0; intros _ H0. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 r0)). -elim o; intro. -unfold antiderivative in H1; elim H1; clear H1; intros _ H1. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 (Rlt_trans _ _ _ r0 r))). -assert (H2 := antiderivative_P2 _ _ _ _ _ _ H0 H). -assert (H3 := antiderivative_Ucte _ _ _ c a H1 H2). -elim H3; intros. -assert (H5 : c <= a). -unfold antiderivative in H1; elim H1; intros; assumption. -rewrite (H4 c). -rewrite (H4 a). -case (Rle_dec a b); intro. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r1 r)). -case (Rle_dec c b); intro. -ring. -elim n0; left; assumption. -split; [ assumption | right; reflexivity ]. -split; [ right; reflexivity | assumption ]. + elim o0; intro. + unfold antiderivative in H; elim H; clear H; intros _ H. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). + elim o1; intro. + unfold antiderivative in H0; elim H0; clear H0; intros _ H0. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 r0)). + elim o; intro. + unfold antiderivative in H1; elim H1; clear H1; intros _ H1. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 (Rlt_trans _ _ _ r0 r))). + assert (H2 := antiderivative_P2 _ _ _ _ _ _ H0 H). + assert (H3 := antiderivative_Ucte _ _ _ c a H1 H2). + elim H3; intros. + assert (H5 : c <= a). + unfold antiderivative in H1; elim H1; intros; assumption. + rewrite (H4 c). + rewrite (H4 a). + case (Rle_dec a b); intro. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r1 r)). + case (Rle_dec c b); intro. + ring. + elim n0; left; assumption. + split; [ assumption | right; reflexivity ]. + split; [ right; reflexivity | assumption ]. Qed. diff --git a/theories/Reals/PSeries_reg.v b/theories/Reals/PSeries_reg.v index d6dc352c..64b8e0af 100644 --- a/theories/Reals/PSeries_reg.v +++ b/theories/Reals/PSeries_reg.v @@ -5,8 +5,8 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) - -(*i $Id: PSeries_reg.v 5920 2004-07-16 20:01:26Z herbelin $ i*) + +(*i $Id: PSeries_reg.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -17,243 +17,249 @@ Require Import Even. Open Local Scope R_scope. Definition Boule (x:R) (r:posreal) (y:R) : Prop := Rabs (y - x) < r. -(* Uniform convergence *) +(** Uniform convergence *) Definition CVU (fn:nat -> R -> R) (f:R -> R) (x:R) (r:posreal) : Prop := forall eps:R, 0 < eps -> - exists N : nat, + exists N : nat, (forall (n:nat) (y:R), - (N <= n)%nat -> Boule x r y -> Rabs (f y - fn n y) < eps). + (N <= n)%nat -> Boule x r y -> Rabs (f y - fn n y) < eps). -(* Normal convergence *) +(** Normal convergence *) Definition CVN_r (fn:nat -> R -> R) (r:posreal) : Type := sigT - (fun An:nat -> R => - sigT - (fun l:R => - Un_cv (fun n:nat => sum_f_R0 (fun k:nat => Rabs (An k)) n) l /\ - (forall (n:nat) (y:R), Boule 0 r y -> Rabs (fn n y) <= An n))). + (fun An:nat -> R => + sigT + (fun l:R => + Un_cv (fun n:nat => sum_f_R0 (fun k:nat => Rabs (An k)) n) l /\ + (forall (n:nat) (y:R), Boule 0 r y -> Rabs (fn n y) <= An n))). Definition CVN_R (fn:nat -> R -> R) : Type := forall r:posreal, CVN_r fn r. Definition SFL (fn:nat -> R -> R) (cv:forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)) (y:R) : R := match cv y with - | existT a b => a + | existT a b => a end. -(* In a complete space, normal convergence implies uniform convergence *) +(** In a complete space, normal convergence implies uniform convergence *) Lemma CVN_CVU : - forall (fn:nat -> R -> R) - (cv:forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)) - (r:posreal), CVN_r fn r -> CVU (fun n:nat => SP fn n) (SFL fn cv) 0 r. -intros; unfold CVU in |- *; intros. -unfold CVN_r in X. -elim X; intros An X0. -elim X0; intros s H0. -elim H0; intros. -cut (Un_cv (fun n:nat => sum_f_R0 (fun k:nat => Rabs (An k)) n - s) 0). -intro; unfold Un_cv in H3. -elim (H3 eps H); intros N0 H4. -exists N0; intros. -apply Rle_lt_trans with (Rabs (sum_f_R0 (fun k:nat => Rabs (An k)) n - s)). -rewrite <- (Rabs_Ropp (sum_f_R0 (fun k:nat => Rabs (An k)) n - s)); - rewrite Ropp_minus_distr'; - rewrite (Rabs_right (s - sum_f_R0 (fun k:nat => Rabs (An k)) n)). -eapply sum_maj1. -unfold SFL in |- *; case (cv y); intro. -trivial. -apply H1. -intro; elim H0; intros. -rewrite (Rabs_right (An n0)). -apply H8; apply H6. -apply Rle_ge; apply Rle_trans with (Rabs (fn n0 y)). -apply Rabs_pos. -apply H8; apply H6. -apply Rle_ge; - apply Rplus_le_reg_l with (sum_f_R0 (fun k:nat => Rabs (An k)) n). -rewrite Rplus_0_r; unfold Rminus in |- *; rewrite (Rplus_comm s); - rewrite <- Rplus_assoc; rewrite Rplus_opp_r; rewrite Rplus_0_l; - apply sum_incr. -apply H1. -intro; apply Rabs_pos. -unfold R_dist in H4; unfold Rminus in H4; rewrite Ropp_0 in H4. -assert (H7 := H4 n H5). -rewrite Rplus_0_r in H7; apply H7. -unfold Un_cv in H1; unfold Un_cv in |- *; intros. -elim (H1 _ H3); intros. -exists x; intros. -unfold R_dist in |- *; unfold R_dist in H4. -rewrite Rminus_0_r; apply H4; assumption. + forall (fn:nat -> R -> R) + (cv:forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)) + (r:posreal), CVN_r fn r -> CVU (fun n:nat => SP fn n) (SFL fn cv) 0 r. +Proof. + intros; unfold CVU in |- *; intros. + unfold CVN_r in X. + elim X; intros An X0. + elim X0; intros s H0. + elim H0; intros. + cut (Un_cv (fun n:nat => sum_f_R0 (fun k:nat => Rabs (An k)) n - s) 0). + intro; unfold Un_cv in H3. + elim (H3 eps H); intros N0 H4. + exists N0; intros. + apply Rle_lt_trans with (Rabs (sum_f_R0 (fun k:nat => Rabs (An k)) n - s)). + rewrite <- (Rabs_Ropp (sum_f_R0 (fun k:nat => Rabs (An k)) n - s)); + rewrite Ropp_minus_distr'; + rewrite (Rabs_right (s - sum_f_R0 (fun k:nat => Rabs (An k)) n)). + eapply sum_maj1. + unfold SFL in |- *; case (cv y); intro. + trivial. + apply H1. + intro; elim H0; intros. + rewrite (Rabs_right (An n0)). + apply H8; apply H6. + apply Rle_ge; apply Rle_trans with (Rabs (fn n0 y)). + apply Rabs_pos. + apply H8; apply H6. + apply Rle_ge; + apply Rplus_le_reg_l with (sum_f_R0 (fun k:nat => Rabs (An k)) n). + rewrite Rplus_0_r; unfold Rminus in |- *; rewrite (Rplus_comm s); + rewrite <- Rplus_assoc; rewrite Rplus_opp_r; rewrite Rplus_0_l; + apply sum_incr. + apply H1. + intro; apply Rabs_pos. + unfold R_dist in H4; unfold Rminus in H4; rewrite Ropp_0 in H4. + assert (H7 := H4 n H5). + rewrite Rplus_0_r in H7; apply H7. + unfold Un_cv in H1; unfold Un_cv in |- *; intros. + elim (H1 _ H3); intros. + exists x; intros. + unfold R_dist in |- *; unfold R_dist in H4. + rewrite Rminus_0_r; apply H4; assumption. Qed. -(* Each limit of a sequence of functions which converges uniformly is continue *) +(** Each limit of a sequence of functions which converges uniformly is continue *) Lemma CVU_continuity : - forall (fn:nat -> R -> R) (f:R -> R) (x:R) (r:posreal), - CVU fn f x r -> - (forall (n:nat) (y:R), Boule x r y -> continuity_pt (fn n) y) -> - forall y:R, Boule x r y -> continuity_pt f y. -intros; unfold continuity_pt in |- *; unfold continue_in in |- *; - unfold limit1_in in |- *; unfold limit_in in |- *; - simpl in |- *; unfold R_dist in |- *; intros. -unfold CVU in H. -cut (0 < eps / 3); - [ intro - | unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. -elim (H _ H3); intros N0 H4. -assert (H5 := H0 N0 y H1). -cut (exists del : posreal, (forall h:R, Rabs h < del -> Boule x r (y + h))). -intro. -elim H6; intros del1 H7. -unfold continuity_pt in H5; unfold continue_in in H5; unfold limit1_in in H5; - unfold limit_in in H5; simpl in H5; unfold R_dist in H5. -elim (H5 _ H3); intros del2 H8. -set (del := Rmin del1 del2). -exists del; intros. -split. -unfold del in |- *; unfold Rmin in |- *; case (Rle_dec del1 del2); intro. -apply (cond_pos del1). -elim H8; intros; assumption. -intros; - apply Rle_lt_trans with (Rabs (f x0 - fn N0 x0) + Rabs (fn N0 x0 - f y)). -replace (f x0 - f y) with (f x0 - fn N0 x0 + (fn N0 x0 - f y)); - [ apply Rabs_triang | ring ]. -apply Rle_lt_trans with - (Rabs (f x0 - fn N0 x0) + Rabs (fn N0 x0 - fn N0 y) + Rabs (fn N0 y - f y)). -rewrite Rplus_assoc; apply Rplus_le_compat_l. -replace (fn N0 x0 - f y) with (fn N0 x0 - fn N0 y + (fn N0 y - f y)); - [ apply Rabs_triang | ring ]. -replace eps with (eps / 3 + eps / 3 + eps / 3). -repeat apply Rplus_lt_compat. -apply H4. -apply le_n. -replace x0 with (y + (x0 - y)); [ idtac | ring ]; apply H7. -elim H9; intros. -apply Rlt_le_trans with del. -assumption. -unfold del in |- *; apply Rmin_l. -elim H8; intros. -apply H11. -split. -elim H9; intros; assumption. -elim H9; intros; apply Rlt_le_trans with del. -assumption. -unfold del in |- *; apply Rmin_r. -rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr'; apply H4. -apply le_n. -assumption. -apply Rmult_eq_reg_l with 3. -do 2 rewrite Rmult_plus_distr_l; unfold Rdiv in |- *; rewrite <- Rmult_assoc; - rewrite Rinv_r_simpl_m. -ring. -discrR. -discrR. -cut (0 < r - Rabs (x - y)). -intro; exists (mkposreal _ H6). -simpl in |- *; intros. -unfold Boule in |- *; replace (y + h - x) with (h + (y - x)); - [ idtac | ring ]; apply Rle_lt_trans with (Rabs h + Rabs (y - x)). -apply Rabs_triang. -apply Rplus_lt_reg_r with (- Rabs (x - y)). -rewrite <- (Rabs_Ropp (y - x)); rewrite Ropp_minus_distr'. -replace (- Rabs (x - y) + r) with (r - Rabs (x - y)). -replace (- Rabs (x - y) + (Rabs h + Rabs (x - y))) with (Rabs h). -apply H7. -ring. -ring. -unfold Boule in H1; rewrite <- (Rabs_Ropp (x - y)); rewrite Ropp_minus_distr'; - apply Rplus_lt_reg_r with (Rabs (y - x)). -rewrite Rplus_0_r; replace (Rabs (y - x) + (r - Rabs (y - x))) with (pos r); - [ apply H1 | ring ]. + forall (fn:nat -> R -> R) (f:R -> R) (x:R) (r:posreal), + CVU fn f x r -> + (forall (n:nat) (y:R), Boule x r y -> continuity_pt (fn n) y) -> + forall y:R, Boule x r y -> continuity_pt f y. +Proof. + intros; unfold continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros. + unfold CVU in H. + cut (0 < eps / 3); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. + elim (H _ H3); intros N0 H4. + assert (H5 := H0 N0 y H1). + cut (exists del : posreal, (forall h:R, Rabs h < del -> Boule x r (y + h))). + intro. + elim H6; intros del1 H7. + unfold continuity_pt in H5; unfold continue_in in H5; unfold limit1_in in H5; + unfold limit_in in H5; simpl in H5; unfold R_dist in H5. + elim (H5 _ H3); intros del2 H8. + set (del := Rmin del1 del2). + exists del; intros. + split. + unfold del in |- *; unfold Rmin in |- *; case (Rle_dec del1 del2); intro. + apply (cond_pos del1). + elim H8; intros; assumption. + intros; + apply Rle_lt_trans with (Rabs (f x0 - fn N0 x0) + Rabs (fn N0 x0 - f y)). + replace (f x0 - f y) with (f x0 - fn N0 x0 + (fn N0 x0 - f y)); + [ apply Rabs_triang | ring ]. + apply Rle_lt_trans with + (Rabs (f x0 - fn N0 x0) + Rabs (fn N0 x0 - fn N0 y) + Rabs (fn N0 y - f y)). + rewrite Rplus_assoc; apply Rplus_le_compat_l. + replace (fn N0 x0 - f y) with (fn N0 x0 - fn N0 y + (fn N0 y - f y)); + [ apply Rabs_triang | ring ]. + replace eps with (eps / 3 + eps / 3 + eps / 3). + repeat apply Rplus_lt_compat. + apply H4. + apply le_n. + replace x0 with (y + (x0 - y)); [ idtac | ring ]; apply H7. + elim H9; intros. + apply Rlt_le_trans with del. + assumption. + unfold del in |- *; apply Rmin_l. + elim H8; intros. + apply H11. + split. + elim H9; intros; assumption. + elim H9; intros; apply Rlt_le_trans with del. + assumption. + unfold del in |- *; apply Rmin_r. + rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr'; apply H4. + apply le_n. + assumption. + apply Rmult_eq_reg_l with 3. + do 2 rewrite Rmult_plus_distr_l; unfold Rdiv in |- *; rewrite <- Rmult_assoc; + rewrite Rinv_r_simpl_m. + ring. + discrR. + discrR. + cut (0 < r - Rabs (x - y)). + intro; exists (mkposreal _ H6). + simpl in |- *; intros. + unfold Boule in |- *; replace (y + h - x) with (h + (y - x)); + [ idtac | ring ]; apply Rle_lt_trans with (Rabs h + Rabs (y - x)). + apply Rabs_triang. + apply Rplus_lt_reg_r with (- Rabs (x - y)). + rewrite <- (Rabs_Ropp (y - x)); rewrite Ropp_minus_distr'. + replace (- Rabs (x - y) + r) with (r - Rabs (x - y)). + replace (- Rabs (x - y) + (Rabs h + Rabs (x - y))) with (Rabs h). + apply H7. + ring. + ring. + unfold Boule in H1; rewrite <- (Rabs_Ropp (x - y)); rewrite Ropp_minus_distr'; + apply Rplus_lt_reg_r with (Rabs (y - x)). + rewrite Rplus_0_r; replace (Rabs (y - x) + (r - Rabs (y - x))) with (pos r); + [ apply H1 | ring ]. Qed. (**********) Lemma continuity_pt_finite_SF : - forall (fn:nat -> R -> R) (N:nat) (x:R), - (forall n:nat, (n <= N)%nat -> continuity_pt (fn n) x) -> - continuity_pt (fun y:R => sum_f_R0 (fun k:nat => fn k y) N) x. -intros; induction N as [| N HrecN]. -simpl in |- *; apply (H 0%nat); apply le_n. -simpl in |- *; - replace (fun y:R => sum_f_R0 (fun k:nat => fn k y) N + fn (S N) y) with - ((fun y:R => sum_f_R0 (fun k:nat => fn k y) N) + (fun y:R => fn (S N) y))%F; - [ idtac | reflexivity ]. -apply continuity_pt_plus. -apply HrecN. -intros; apply H. -apply le_trans with N; [ assumption | apply le_n_Sn ]. -apply (H (S N)); apply le_n. + forall (fn:nat -> R -> R) (N:nat) (x:R), + (forall n:nat, (n <= N)%nat -> continuity_pt (fn n) x) -> + continuity_pt (fun y:R => sum_f_R0 (fun k:nat => fn k y) N) x. +Proof. + intros; induction N as [| N HrecN]. + simpl in |- *; apply (H 0%nat); apply le_n. + simpl in |- *; + replace (fun y:R => sum_f_R0 (fun k:nat => fn k y) N + fn (S N) y) with + ((fun y:R => sum_f_R0 (fun k:nat => fn k y) N) + (fun y:R => fn (S N) y))%F; + [ idtac | reflexivity ]. + apply continuity_pt_plus. + apply HrecN. + intros; apply H. + apply le_trans with N; [ assumption | apply le_n_Sn ]. + apply (H (S N)); apply le_n. Qed. -(* Continuity and normal convergence *) +(** Continuity and normal convergence *) Lemma SFL_continuity_pt : - forall (fn:nat -> R -> R) - (cv:forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)) - (r:posreal), - CVN_r fn r -> - (forall (n:nat) (y:R), Boule 0 r y -> continuity_pt (fn n) y) -> - forall y:R, Boule 0 r y -> continuity_pt (SFL fn cv) y. -intros; eapply CVU_continuity. -apply CVN_CVU. -apply X. -intros; unfold SP in |- *; apply continuity_pt_finite_SF. -intros; apply H. -apply H1. -apply H0. + forall (fn:nat -> R -> R) + (cv:forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)) + (r:posreal), + CVN_r fn r -> + (forall (n:nat) (y:R), Boule 0 r y -> continuity_pt (fn n) y) -> + forall y:R, Boule 0 r y -> continuity_pt (SFL fn cv) y. +Proof. + intros; eapply CVU_continuity. + apply CVN_CVU. + apply X. + intros; unfold SP in |- *; apply continuity_pt_finite_SF. + intros; apply H. + apply H1. + apply H0. Qed. Lemma SFL_continuity : - forall (fn:nat -> R -> R) - (cv:forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)), - CVN_R fn -> (forall n:nat, continuity (fn n)) -> continuity (SFL fn cv). -intros; unfold continuity in |- *; intro. -cut (0 < Rabs x + 1); - [ intro | apply Rplus_le_lt_0_compat; [ apply Rabs_pos | apply Rlt_0_1 ] ]. -cut (Boule 0 (mkposreal _ H0) x). -intro; eapply SFL_continuity_pt with (mkposreal _ H0). -apply X. -intros; apply (H n y). -apply H1. -unfold Boule in |- *; simpl in |- *; rewrite Rminus_0_r; - pattern (Rabs x) at 1 in |- *; rewrite <- Rplus_0_r; - apply Rplus_lt_compat_l; apply Rlt_0_1. + forall (fn:nat -> R -> R) + (cv:forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)), + CVN_R fn -> (forall n:nat, continuity (fn n)) -> continuity (SFL fn cv). +Proof. + intros; unfold continuity in |- *; intro. + cut (0 < Rabs x + 1); + [ intro | apply Rplus_le_lt_0_compat; [ apply Rabs_pos | apply Rlt_0_1 ] ]. + cut (Boule 0 (mkposreal _ H0) x). + intro; eapply SFL_continuity_pt with (mkposreal _ H0). + apply X. + intros; apply (H n y). + apply H1. + unfold Boule in |- *; simpl in |- *; rewrite Rminus_0_r; + pattern (Rabs x) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_lt_compat_l; apply Rlt_0_1. Qed. -(* As R is complete, normal convergence implies that (fn) is simply-uniformly convergent *) +(** As R is complete, normal convergence implies that (fn) is simply-uniformly convergent *) Lemma CVN_R_CVS : - forall fn:nat -> R -> R, - CVN_R fn -> forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l). -intros; apply R_complete. -unfold SP in |- *; set (An := fun N:nat => fn N x). -change (Cauchy_crit_series An) in |- *. -apply cauchy_abs. -unfold Cauchy_crit_series in |- *; apply CV_Cauchy. -unfold CVN_R in X; cut (0 < Rabs x + 1). -intro; assert (H0 := X (mkposreal _ H)). -unfold CVN_r in H0; elim H0; intros Bn H1. -elim H1; intros l H2. -elim H2; intros. -apply Rseries_CV_comp with Bn. -intro; split. -apply Rabs_pos. -unfold An in |- *; apply H4; unfold Boule in |- *; simpl in |- *; - rewrite Rminus_0_r. -pattern (Rabs x) at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; - apply Rlt_0_1. -apply existT with l. -cut (forall n:nat, 0 <= Bn n). -intro; unfold Un_cv in H3; unfold Un_cv in |- *; intros. -elim (H3 _ H6); intros. -exists x0; intros. -replace (sum_f_R0 Bn n) with (sum_f_R0 (fun k:nat => Rabs (Bn k)) n). -apply H7; assumption. -apply sum_eq; intros; apply Rabs_right; apply Rle_ge; apply H5. -intro; apply Rle_trans with (Rabs (An n)). -apply Rabs_pos. -unfold An in |- *; apply H4; unfold Boule in |- *; simpl in |- *; - rewrite Rminus_0_r; pattern (Rabs x) at 1 in |- *; - rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; apply Rlt_0_1. -apply Rplus_le_lt_0_compat; [ apply Rabs_pos | apply Rlt_0_1 ]. + forall fn:nat -> R -> R, + CVN_R fn -> forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l). +Proof. + intros; apply R_complete. + unfold SP in |- *; set (An := fun N:nat => fn N x). + change (Cauchy_crit_series An) in |- *. + apply cauchy_abs. + unfold Cauchy_crit_series in |- *; apply CV_Cauchy. + unfold CVN_R in X; cut (0 < Rabs x + 1). + intro; assert (H0 := X (mkposreal _ H)). + unfold CVN_r in H0; elim H0; intros Bn H1. + elim H1; intros l H2. + elim H2; intros. + apply Rseries_CV_comp with Bn. + intro; split. + apply Rabs_pos. + unfold An in |- *; apply H4; unfold Boule in |- *; simpl in |- *; + rewrite Rminus_0_r. + pattern (Rabs x) at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + apply Rlt_0_1. + apply existT with l. + cut (forall n:nat, 0 <= Bn n). + intro; unfold Un_cv in H3; unfold Un_cv in |- *; intros. + elim (H3 _ H6); intros. + exists x0; intros. + replace (sum_f_R0 Bn n) with (sum_f_R0 (fun k:nat => Rabs (Bn k)) n). + apply H7; assumption. + apply sum_eq; intros; apply Rabs_right; apply Rle_ge; apply H5. + intro; apply Rle_trans with (Rabs (An n)). + apply Rabs_pos. + unfold An in |- *; apply H4; unfold Boule in |- *; simpl in |- *; + rewrite Rminus_0_r; pattern (Rabs x) at 1 in |- *; + rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; apply Rlt_0_1. + apply Rplus_le_lt_0_compat; [ apply Rabs_pos | apply Rlt_0_1 ]. Qed. diff --git a/theories/Reals/PartSum.v b/theories/Reals/PartSum.v index bace7b9d..11c6378e 100644 --- a/theories/Reals/PartSum.v +++ b/theories/Reals/PartSum.v @@ -5,8 +5,8 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) - -(*i $Id: PartSum.v 8670 2006-03-28 22:16:14Z herbelin $ i*) + +(*i $Id: PartSum.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -16,340 +16,361 @@ Require Import Max. Open Local Scope R_scope. Lemma tech1 : - forall (An:nat -> R) (N:nat), - (forall n:nat, (n <= N)%nat -> 0 < An n) -> 0 < sum_f_R0 An N. -intros; induction N as [| N HrecN]. -simpl in |- *; apply H; apply le_n. -simpl in |- *; apply Rplus_lt_0_compat. -apply HrecN; intros; apply H; apply le_S; assumption. -apply H; apply le_n. + forall (An:nat -> R) (N:nat), + (forall n:nat, (n <= N)%nat -> 0 < An n) -> 0 < sum_f_R0 An N. +Proof. + intros; induction N as [| N HrecN]. + simpl in |- *; apply H; apply le_n. + simpl in |- *; apply Rplus_lt_0_compat. + apply HrecN; intros; apply H; apply le_S; assumption. + apply H; apply le_n. Qed. (* Chasles' relation *) Lemma tech2 : - forall (An:nat -> R) (m n:nat), - (m < n)%nat -> - sum_f_R0 An n = - sum_f_R0 An m + sum_f_R0 (fun i:nat => An (S m + i)%nat) (n - S m). -intros; induction n as [| n Hrecn]. -elim (lt_n_O _ H). -cut ((m < n)%nat \/ m = n). -intro; elim H0; intro. -replace (sum_f_R0 An (S n)) with (sum_f_R0 An n + An (S n)); - [ idtac | reflexivity ]. -replace (S n - S m)%nat with (S (n - S m)). -replace (sum_f_R0 (fun i:nat => An (S m + i)%nat) (S (n - S m))) with - (sum_f_R0 (fun i:nat => An (S m + i)%nat) (n - S m) + - An (S m + S (n - S m))%nat); [ idtac | reflexivity ]. -replace (S m + S (n - S m))%nat with (S n). -rewrite (Hrecn H1). -ring. -apply INR_eq; rewrite S_INR; rewrite plus_INR; do 2 rewrite S_INR; - rewrite minus_INR. -rewrite S_INR; ring. -apply lt_le_S; assumption. -apply INR_eq; rewrite S_INR; repeat rewrite minus_INR. -repeat rewrite S_INR; ring. -apply le_n_S; apply lt_le_weak; assumption. -apply lt_le_S; assumption. -rewrite H1; rewrite <- minus_n_n; simpl in |- *. -replace (n + 0)%nat with n; [ reflexivity | ring ]. -inversion H. -right; reflexivity. -left; apply lt_le_trans with (S m); [ apply lt_n_Sn | assumption ]. + forall (An:nat -> R) (m n:nat), + (m < n)%nat -> + sum_f_R0 An n = + sum_f_R0 An m + sum_f_R0 (fun i:nat => An (S m + i)%nat) (n - S m). +Proof. + intros; induction n as [| n Hrecn]. + elim (lt_n_O _ H). + cut ((m < n)%nat \/ m = n). + intro; elim H0; intro. + replace (sum_f_R0 An (S n)) with (sum_f_R0 An n + An (S n)); + [ idtac | reflexivity ]. + replace (S n - S m)%nat with (S (n - S m)). + replace (sum_f_R0 (fun i:nat => An (S m + i)%nat) (S (n - S m))) with + (sum_f_R0 (fun i:nat => An (S m + i)%nat) (n - S m) + + An (S m + S (n - S m))%nat); [ idtac | reflexivity ]. + replace (S m + S (n - S m))%nat with (S n). + rewrite (Hrecn H1). + ring. + apply INR_eq; rewrite S_INR; rewrite plus_INR; do 2 rewrite S_INR; + rewrite minus_INR. + rewrite S_INR; ring. + apply lt_le_S; assumption. + apply INR_eq; rewrite S_INR; repeat rewrite minus_INR. + repeat rewrite S_INR; ring. + apply le_n_S; apply lt_le_weak; assumption. + apply lt_le_S; assumption. + rewrite H1; rewrite <- minus_n_n; simpl in |- *. + replace (n + 0)%nat with n; [ reflexivity | ring ]. + inversion H. + right; reflexivity. + left; apply lt_le_trans with (S m); [ apply lt_n_Sn | assumption ]. Qed. (* Sum of geometric sequences *) Lemma tech3 : - forall (k:R) (N:nat), - k <> 1 -> sum_f_R0 (fun i:nat => k ^ i) N = (1 - k ^ S N) / (1 - k). -intros; cut (1 - k <> 0). -intro; induction N as [| N HrecN]. -simpl in |- *; rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite <- Rinv_r_sym. -reflexivity. -apply H0. -replace (sum_f_R0 (fun i:nat => k ^ i) (S N)) with - (sum_f_R0 (fun i:nat => k ^ i) N + k ^ S N); [ idtac | reflexivity ]; - rewrite HrecN; - replace ((1 - k ^ S N) / (1 - k) + k ^ S N) with - ((1 - k ^ S N + (1 - k) * k ^ S N) / (1 - k)). -apply Rmult_eq_reg_l with (1 - k). -unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ (1 - k))); - repeat rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; - [ do 2 rewrite Rmult_1_l; simpl in |- *; ring | apply H0 ]. -apply H0. -unfold Rdiv in |- *; rewrite Rmult_plus_distr_r; rewrite (Rmult_comm (1 - k)); - repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym. -rewrite Rmult_1_r; reflexivity. -apply H0. -apply Rminus_eq_contra; red in |- *; intro; elim H; symmetry in |- *; - assumption. + forall (k:R) (N:nat), + k <> 1 -> sum_f_R0 (fun i:nat => k ^ i) N = (1 - k ^ S N) / (1 - k). +Proof. + intros; cut (1 - k <> 0). + intro; induction N as [| N HrecN]. + simpl in |- *; rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite <- Rinv_r_sym. + reflexivity. + apply H0. + replace (sum_f_R0 (fun i:nat => k ^ i) (S N)) with + (sum_f_R0 (fun i:nat => k ^ i) N + k ^ S N); [ idtac | reflexivity ]; + rewrite HrecN; + replace ((1 - k ^ S N) / (1 - k) + k ^ S N) with + ((1 - k ^ S N + (1 - k) * k ^ S N) / (1 - k)). + apply Rmult_eq_reg_l with (1 - k). + unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ (1 - k))); + repeat rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; + [ do 2 rewrite Rmult_1_l; simpl in |- *; ring | apply H0 ]. + apply H0. + unfold Rdiv in |- *; rewrite Rmult_plus_distr_r; rewrite (Rmult_comm (1 - k)); + repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym. + rewrite Rmult_1_r; reflexivity. + apply H0. + apply Rminus_eq_contra; red in |- *; intro; elim H; symmetry in |- *; + assumption. Qed. Lemma tech4 : - forall (An:nat -> R) (k:R) (N:nat), - 0 <= k -> (forall i:nat, An (S i) < k * An i) -> An N <= An 0%nat * k ^ N. -intros; induction N as [| N HrecN]. -simpl in |- *; right; ring. -apply Rle_trans with (k * An N). -left; apply (H0 N). -replace (S N) with (N + 1)%nat; [ idtac | ring ]. -rewrite pow_add; simpl in |- *; rewrite Rmult_1_r; - replace (An 0%nat * (k ^ N * k)) with (k * (An 0%nat * k ^ N)); - [ idtac | ring ]; apply Rmult_le_compat_l. -assumption. -apply HrecN. + forall (An:nat -> R) (k:R) (N:nat), + 0 <= k -> (forall i:nat, An (S i) < k * An i) -> An N <= An 0%nat * k ^ N. +Proof. + intros; induction N as [| N HrecN]. + simpl in |- *; right; ring. + apply Rle_trans with (k * An N). + left; apply (H0 N). + replace (S N) with (N + 1)%nat; [ idtac | ring ]. + rewrite pow_add; simpl in |- *; rewrite Rmult_1_r; + replace (An 0%nat * (k ^ N * k)) with (k * (An 0%nat * k ^ N)); + [ idtac | ring ]; apply Rmult_le_compat_l. + assumption. + apply HrecN. Qed. Lemma tech5 : - forall (An:nat -> R) (N:nat), sum_f_R0 An (S N) = sum_f_R0 An N + An (S N). -intros; reflexivity. + forall (An:nat -> R) (N:nat), sum_f_R0 An (S N) = sum_f_R0 An N + An (S N). +Proof. + intros; reflexivity. Qed. Lemma tech6 : - forall (An:nat -> R) (k:R) (N:nat), - 0 <= k -> - (forall i:nat, An (S i) < k * An i) -> - sum_f_R0 An N <= An 0%nat * sum_f_R0 (fun i:nat => k ^ i) N. -intros; induction N as [| N HrecN]. -simpl in |- *; right; ring. -apply Rle_trans with (An 0%nat * sum_f_R0 (fun i:nat => k ^ i) N + An (S N)). -rewrite tech5; do 2 rewrite <- (Rplus_comm (An (S N))); - apply Rplus_le_compat_l. -apply HrecN. -rewrite tech5; rewrite Rmult_plus_distr_l; apply Rplus_le_compat_l. -apply tech4; assumption. + forall (An:nat -> R) (k:R) (N:nat), + 0 <= k -> + (forall i:nat, An (S i) < k * An i) -> + sum_f_R0 An N <= An 0%nat * sum_f_R0 (fun i:nat => k ^ i) N. +Proof. + intros; induction N as [| N HrecN]. + simpl in |- *; right; ring. + apply Rle_trans with (An 0%nat * sum_f_R0 (fun i:nat => k ^ i) N + An (S N)). + rewrite tech5; do 2 rewrite <- (Rplus_comm (An (S N))); + apply Rplus_le_compat_l. + apply HrecN. + rewrite tech5; rewrite Rmult_plus_distr_l; apply Rplus_le_compat_l. + apply tech4; assumption. Qed. Lemma tech7 : forall r1 r2:R, r1 <> 0 -> r2 <> 0 -> r1 <> r2 -> / r1 <> / r2. -intros; red in |- *; intro. -assert (H3 := Rmult_eq_compat_l r1 _ _ H2). -rewrite <- Rinv_r_sym in H3; [ idtac | assumption ]. -assert (H4 := Rmult_eq_compat_l r2 _ _ H3). -rewrite Rmult_1_r in H4; rewrite <- Rmult_assoc in H4. -rewrite Rinv_r_simpl_m in H4; [ idtac | assumption ]. -elim H1; symmetry in |- *; assumption. +Proof. + intros; red in |- *; intro. + assert (H3 := Rmult_eq_compat_l r1 _ _ H2). + rewrite <- Rinv_r_sym in H3; [ idtac | assumption ]. + assert (H4 := Rmult_eq_compat_l r2 _ _ H3). + rewrite Rmult_1_r in H4; rewrite <- Rmult_assoc in H4. + rewrite Rinv_r_simpl_m in H4; [ idtac | assumption ]. + elim H1; symmetry in |- *; assumption. Qed. Lemma tech11 : - forall (An Bn Cn:nat -> R) (N:nat), - (forall i:nat, An i = Bn i - Cn i) -> - sum_f_R0 An N = sum_f_R0 Bn N - sum_f_R0 Cn N. -intros; induction N as [| N HrecN]. -simpl in |- *; apply H. -do 3 rewrite tech5; rewrite HrecN; rewrite (H (S N)); ring. + forall (An Bn Cn:nat -> R) (N:nat), + (forall i:nat, An i = Bn i - Cn i) -> + sum_f_R0 An N = sum_f_R0 Bn N - sum_f_R0 Cn N. +Proof. + intros; induction N as [| N HrecN]. + simpl in |- *; apply H. + do 3 rewrite tech5; rewrite HrecN; rewrite (H (S N)); ring. Qed. Lemma tech12 : - forall (An:nat -> R) (x l:R), - Un_cv (fun N:nat => sum_f_R0 (fun i:nat => An i * x ^ i) N) l -> - Pser An x l. -intros; unfold Pser in |- *; unfold infinit_sum in |- *; unfold Un_cv in H; - assumption. + forall (An:nat -> R) (x l:R), + Un_cv (fun N:nat => sum_f_R0 (fun i:nat => An i * x ^ i) N) l -> + Pser An x l. +Proof. + intros; unfold Pser in |- *; unfold infinit_sum in |- *; unfold Un_cv in H; + assumption. Qed. Lemma scal_sum : - forall (An:nat -> R) (N:nat) (x:R), - x * sum_f_R0 An N = sum_f_R0 (fun i:nat => An i * x) N. -intros; induction N as [| N HrecN]. -simpl in |- *; ring. -do 2 rewrite tech5. -rewrite Rmult_plus_distr_l; rewrite <- HrecN; ring. + forall (An:nat -> R) (N:nat) (x:R), + x * sum_f_R0 An N = sum_f_R0 (fun i:nat => An i * x) N. +Proof. + intros; induction N as [| N HrecN]. + simpl in |- *; ring. + do 2 rewrite tech5. + rewrite Rmult_plus_distr_l; rewrite <- HrecN; ring. Qed. Lemma decomp_sum : - forall (An:nat -> R) (N:nat), - (0 < N)%nat -> - sum_f_R0 An N = An 0%nat + sum_f_R0 (fun i:nat => An (S i)) (pred N). -intros; induction N as [| N HrecN]. -elim (lt_irrefl _ H). -cut ((0 < N)%nat \/ N = 0%nat). -intro; elim H0; intro. -cut (S (pred N) = pred (S N)). -intro; rewrite <- H2. -do 2 rewrite tech5. -replace (S (S (pred N))) with (S N). -rewrite (HrecN H1); ring. -rewrite H2; simpl in |- *; reflexivity. -assert (H2 := O_or_S N). -elim H2; intros. -elim a; intros. -rewrite <- p. -simpl in |- *; reflexivity. -rewrite <- b in H1; elim (lt_irrefl _ H1). -rewrite H1; simpl in |- *; reflexivity. -inversion H. -right; reflexivity. -left; apply lt_le_trans with 1%nat; [ apply lt_O_Sn | assumption ]. + forall (An:nat -> R) (N:nat), + (0 < N)%nat -> + sum_f_R0 An N = An 0%nat + sum_f_R0 (fun i:nat => An (S i)) (pred N). +Proof. + intros; induction N as [| N HrecN]. + elim (lt_irrefl _ H). + cut ((0 < N)%nat \/ N = 0%nat). + intro; elim H0; intro. + cut (S (pred N) = pred (S N)). + intro; rewrite <- H2. + do 2 rewrite tech5. + replace (S (S (pred N))) with (S N). + rewrite (HrecN H1); ring. + rewrite H2; simpl in |- *; reflexivity. + assert (H2 := O_or_S N). + elim H2; intros. + elim a; intros. + rewrite <- p. + simpl in |- *; reflexivity. + rewrite <- b in H1; elim (lt_irrefl _ H1). + rewrite H1; simpl in |- *; reflexivity. + inversion H. + right; reflexivity. + left; apply lt_le_trans with 1%nat; [ apply lt_O_Sn | assumption ]. Qed. Lemma plus_sum : - forall (An Bn:nat -> R) (N:nat), - sum_f_R0 (fun i:nat => An i + Bn i) N = sum_f_R0 An N + sum_f_R0 Bn N. -intros; induction N as [| N HrecN]. -simpl in |- *; ring. -do 3 rewrite tech5; rewrite HrecN; ring. + forall (An Bn:nat -> R) (N:nat), + sum_f_R0 (fun i:nat => An i + Bn i) N = sum_f_R0 An N + sum_f_R0 Bn N. +Proof. + intros; induction N as [| N HrecN]. + simpl in |- *; ring. + do 3 rewrite tech5; rewrite HrecN; ring. Qed. Lemma sum_eq : - forall (An Bn:nat -> R) (N:nat), - (forall i:nat, (i <= N)%nat -> An i = Bn i) -> - sum_f_R0 An N = sum_f_R0 Bn N. -intros; induction N as [| N HrecN]. -simpl in |- *; apply H; apply le_n. -do 2 rewrite tech5; rewrite HrecN. -rewrite (H (S N)); [ reflexivity | apply le_n ]. -intros; apply H; apply le_trans with N; [ assumption | apply le_n_Sn ]. + forall (An Bn:nat -> R) (N:nat), + (forall i:nat, (i <= N)%nat -> An i = Bn i) -> + sum_f_R0 An N = sum_f_R0 Bn N. +Proof. + intros; induction N as [| N HrecN]. + simpl in |- *; apply H; apply le_n. + do 2 rewrite tech5; rewrite HrecN. + rewrite (H (S N)); [ reflexivity | apply le_n ]. + intros; apply H; apply le_trans with N; [ assumption | apply le_n_Sn ]. Qed. (* Unicity of the limit defined by convergent series *) Lemma uniqueness_sum : - forall (An:nat -> R) (l1 l2:R), - infinit_sum An l1 -> infinit_sum An l2 -> l1 = l2. -unfold infinit_sum in |- *; intros. -case (Req_dec l1 l2); intro. -assumption. -cut (0 < Rabs ((l1 - l2) / 2)); [ intro | apply Rabs_pos_lt ]. -elim (H (Rabs ((l1 - l2) / 2)) H2); intros. -elim (H0 (Rabs ((l1 - l2) / 2)) H2); intros. -set (N := max x0 x); cut (N >= x0)%nat. -cut (N >= x)%nat. -intros; assert (H7 := H3 N H5); assert (H8 := H4 N H6). -cut (Rabs (l1 - l2) <= R_dist (sum_f_R0 An N) l1 + R_dist (sum_f_R0 An N) l2). -intro; assert (H10 := Rplus_lt_compat _ _ _ _ H7 H8); - assert (H11 := Rle_lt_trans _ _ _ H9 H10); unfold Rdiv in H11; - rewrite Rabs_mult in H11. -cut (Rabs (/ 2) = / 2). -intro; rewrite H12 in H11; assert (H13 := double_var); unfold Rdiv in H13; - rewrite <- H13 in H11. -elim (Rlt_irrefl _ H11). -apply Rabs_right; left; change (0 < / 2) in |- *; apply Rinv_0_lt_compat; - cut (0%nat <> 2%nat); - [ intro H20; generalize (lt_INR_0 2 (neq_O_lt 2 H20)); unfold INR in |- *; - intro; assumption - | discriminate ]. -unfold R_dist in |- *; rewrite <- (Rabs_Ropp (sum_f_R0 An N - l1)); - rewrite Ropp_minus_distr'. -replace (l1 - l2) with (l1 - sum_f_R0 An N + (sum_f_R0 An N - l2)); - [ idtac | ring ]. -apply Rabs_triang. -unfold ge in |- *; unfold N in |- *; apply le_max_r. -unfold ge in |- *; unfold N in |- *; apply le_max_l. -unfold Rdiv in |- *; apply prod_neq_R0. -apply Rminus_eq_contra; assumption. -apply Rinv_neq_0_compat; discrR. + forall (An:nat -> R) (l1 l2:R), + infinit_sum An l1 -> infinit_sum An l2 -> l1 = l2. +Proof. + unfold infinit_sum in |- *; intros. + case (Req_dec l1 l2); intro. + assumption. + cut (0 < Rabs ((l1 - l2) / 2)); [ intro | apply Rabs_pos_lt ]. + elim (H (Rabs ((l1 - l2) / 2)) H2); intros. + elim (H0 (Rabs ((l1 - l2) / 2)) H2); intros. + set (N := max x0 x); cut (N >= x0)%nat. + cut (N >= x)%nat. + intros; assert (H7 := H3 N H5); assert (H8 := H4 N H6). + cut (Rabs (l1 - l2) <= R_dist (sum_f_R0 An N) l1 + R_dist (sum_f_R0 An N) l2). + intro; assert (H10 := Rplus_lt_compat _ _ _ _ H7 H8); + assert (H11 := Rle_lt_trans _ _ _ H9 H10); unfold Rdiv in H11; + rewrite Rabs_mult in H11. + cut (Rabs (/ 2) = / 2). + intro; rewrite H12 in H11; assert (H13 := double_var); unfold Rdiv in H13; + rewrite <- H13 in H11. + elim (Rlt_irrefl _ H11). + apply Rabs_right; left; change (0 < / 2) in |- *; apply Rinv_0_lt_compat; + cut (0%nat <> 2%nat); + [ intro H20; generalize (lt_INR_0 2 (neq_O_lt 2 H20)); unfold INR in |- *; + intro; assumption + | discriminate ]. + unfold R_dist in |- *; rewrite <- (Rabs_Ropp (sum_f_R0 An N - l1)); + rewrite Ropp_minus_distr'. + replace (l1 - l2) with (l1 - sum_f_R0 An N + (sum_f_R0 An N - l2)); + [ idtac | ring ]. + apply Rabs_triang. + unfold ge in |- *; unfold N in |- *; apply le_max_r. + unfold ge in |- *; unfold N in |- *; apply le_max_l. + unfold Rdiv in |- *; apply prod_neq_R0. + apply Rminus_eq_contra; assumption. + apply Rinv_neq_0_compat; discrR. Qed. Lemma minus_sum : - forall (An Bn:nat -> R) (N:nat), - sum_f_R0 (fun i:nat => An i - Bn i) N = sum_f_R0 An N - sum_f_R0 Bn N. -intros; induction N as [| N HrecN]. -simpl in |- *; ring. -do 3 rewrite tech5; rewrite HrecN; ring. + forall (An Bn:nat -> R) (N:nat), + sum_f_R0 (fun i:nat => An i - Bn i) N = sum_f_R0 An N - sum_f_R0 Bn N. +Proof. + intros; induction N as [| N HrecN]. + simpl in |- *; ring. + do 3 rewrite tech5; rewrite HrecN; ring. Qed. Lemma sum_decomposition : - forall (An:nat -> R) (N:nat), - sum_f_R0 (fun l:nat => An (2 * l)%nat) (S N) + - sum_f_R0 (fun l:nat => An (S (2 * l))) N = sum_f_R0 An (2 * S N). -intros. -induction N as [| N HrecN]. -simpl in |- *; ring. -rewrite tech5. -rewrite (tech5 (fun l:nat => An (S (2 * l))) N). -replace (2 * S (S N))%nat with (S (S (2 * S N))). -rewrite (tech5 An (S (2 * S N))). -rewrite (tech5 An (2 * S N)). -rewrite <- HrecN. -ring. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR. -ring. + forall (An:nat -> R) (N:nat), + sum_f_R0 (fun l:nat => An (2 * l)%nat) (S N) + + sum_f_R0 (fun l:nat => An (S (2 * l))) N = sum_f_R0 An (2 * S N). +Proof. + intros. + induction N as [| N HrecN]. + simpl in |- *; ring. + rewrite tech5. + rewrite (tech5 (fun l:nat => An (S (2 * l))) N). + replace (2 * S (S N))%nat with (S (S (2 * S N))). + rewrite (tech5 An (S (2 * S N))). + rewrite (tech5 An (2 * S N)). + rewrite <- HrecN. + ring. + ring_nat. Qed. Lemma sum_Rle : - forall (An Bn:nat -> R) (N:nat), - (forall n:nat, (n <= N)%nat -> An n <= Bn n) -> - sum_f_R0 An N <= sum_f_R0 Bn N. -intros. -induction N as [| N HrecN]. -simpl in |- *; apply H. -apply le_n. -do 2 rewrite tech5. -apply Rle_trans with (sum_f_R0 An N + Bn (S N)). -apply Rplus_le_compat_l. -apply H. -apply le_n. -do 2 rewrite <- (Rplus_comm (Bn (S N))). -apply Rplus_le_compat_l. -apply HrecN. -intros; apply H. -apply le_trans with N; [ assumption | apply le_n_Sn ]. + forall (An Bn:nat -> R) (N:nat), + (forall n:nat, (n <= N)%nat -> An n <= Bn n) -> + sum_f_R0 An N <= sum_f_R0 Bn N. +Proof. + intros. + induction N as [| N HrecN]. + simpl in |- *; apply H. + apply le_n. + do 2 rewrite tech5. + apply Rle_trans with (sum_f_R0 An N + Bn (S N)). + apply Rplus_le_compat_l. + apply H. + apply le_n. + do 2 rewrite <- (Rplus_comm (Bn (S N))). + apply Rplus_le_compat_l. + apply HrecN. + intros; apply H. + apply le_trans with N; [ assumption | apply le_n_Sn ]. Qed. Lemma Rsum_abs : - forall (An:nat -> R) (N:nat), - Rabs (sum_f_R0 An N) <= sum_f_R0 (fun l:nat => Rabs (An l)) N. -intros. -induction N as [| N HrecN]. -simpl in |- *. -right; reflexivity. -do 2 rewrite tech5. -apply Rle_trans with (Rabs (sum_f_R0 An N) + Rabs (An (S N))). -apply Rabs_triang. -do 2 rewrite <- (Rplus_comm (Rabs (An (S N)))). -apply Rplus_le_compat_l. -apply HrecN. + forall (An:nat -> R) (N:nat), + Rabs (sum_f_R0 An N) <= sum_f_R0 (fun l:nat => Rabs (An l)) N. +Proof. + intros. + induction N as [| N HrecN]. + simpl in |- *. + right; reflexivity. + do 2 rewrite tech5. + apply Rle_trans with (Rabs (sum_f_R0 An N) + Rabs (An (S N))). + apply Rabs_triang. + do 2 rewrite <- (Rplus_comm (Rabs (An (S N)))). + apply Rplus_le_compat_l. + apply HrecN. Qed. Lemma sum_cte : - forall (x:R) (N:nat), sum_f_R0 (fun _:nat => x) N = x * INR (S N). -intros. -induction N as [| N HrecN]. -simpl in |- *; ring. -rewrite tech5. -rewrite HrecN; repeat rewrite S_INR; ring. + forall (x:R) (N:nat), sum_f_R0 (fun _:nat => x) N = x * INR (S N). +Proof. + intros. + induction N as [| N HrecN]. + simpl in |- *; ring. + rewrite tech5. + rewrite HrecN; repeat rewrite S_INR; ring. Qed. (**********) Lemma sum_growing : - forall (An Bn:nat -> R) (N:nat), - (forall n:nat, An n <= Bn n) -> sum_f_R0 An N <= sum_f_R0 Bn N. -intros. -induction N as [| N HrecN]. -simpl in |- *; apply H. -do 2 rewrite tech5. -apply Rle_trans with (sum_f_R0 An N + Bn (S N)). -apply Rplus_le_compat_l; apply H. -do 2 rewrite <- (Rplus_comm (Bn (S N))). -apply Rplus_le_compat_l; apply HrecN. + forall (An Bn:nat -> R) (N:nat), + (forall n:nat, An n <= Bn n) -> sum_f_R0 An N <= sum_f_R0 Bn N. +Proof. + intros. + induction N as [| N HrecN]. + simpl in |- *; apply H. + do 2 rewrite tech5. + apply Rle_trans with (sum_f_R0 An N + Bn (S N)). + apply Rplus_le_compat_l; apply H. + do 2 rewrite <- (Rplus_comm (Bn (S N))). + apply Rplus_le_compat_l; apply HrecN. Qed. (**********) Lemma Rabs_triang_gen : - forall (An:nat -> R) (N:nat), - Rabs (sum_f_R0 An N) <= sum_f_R0 (fun i:nat => Rabs (An i)) N. -intros. -induction N as [| N HrecN]. -simpl in |- *. -right; reflexivity. -do 2 rewrite tech5. -apply Rle_trans with (Rabs (sum_f_R0 An N) + Rabs (An (S N))). -apply Rabs_triang. -do 2 rewrite <- (Rplus_comm (Rabs (An (S N)))). -apply Rplus_le_compat_l; apply HrecN. + forall (An:nat -> R) (N:nat), + Rabs (sum_f_R0 An N) <= sum_f_R0 (fun i:nat => Rabs (An i)) N. +Proof. + intros. + induction N as [| N HrecN]. + simpl in |- *. + right; reflexivity. + do 2 rewrite tech5. + apply Rle_trans with (Rabs (sum_f_R0 An N) + Rabs (An (S N))). + apply Rabs_triang. + do 2 rewrite <- (Rplus_comm (Rabs (An (S N)))). + apply Rplus_le_compat_l; apply HrecN. Qed. (**********) Lemma cond_pos_sum : - forall (An:nat -> R) (N:nat), - (forall n:nat, 0 <= An n) -> 0 <= sum_f_R0 An N. -intros. -induction N as [| N HrecN]. -simpl in |- *; apply H. -rewrite tech5. -apply Rplus_le_le_0_compat. -apply HrecN. -apply H. + forall (An:nat -> R) (N:nat), + (forall n:nat, 0 <= An n) -> 0 <= sum_f_R0 An N. +Proof. + intros. + induction N as [| N HrecN]. + simpl in |- *; apply H. + rewrite tech5. + apply Rplus_le_le_0_compat. + apply HrecN. + apply H. Qed. (* Cauchy's criterion for series *) @@ -358,122 +379,126 @@ Definition Cauchy_crit_series (An:nat -> R) : Prop := (* If (|An|) satisfies the Cauchy's criterion for series, then (An) too *) Lemma cauchy_abs : - forall An:nat -> R, - Cauchy_crit_series (fun i:nat => Rabs (An i)) -> Cauchy_crit_series An. -unfold Cauchy_crit_series in |- *; unfold Cauchy_crit in |- *. -intros. -elim (H eps H0); intros. -exists x. -intros. -cut - (R_dist (sum_f_R0 An n) (sum_f_R0 An m) <= - R_dist (sum_f_R0 (fun i:nat => Rabs (An i)) n) - (sum_f_R0 (fun i:nat => Rabs (An i)) m)). -intro. -apply Rle_lt_trans with - (R_dist (sum_f_R0 (fun i:nat => Rabs (An i)) n) - (sum_f_R0 (fun i:nat => Rabs (An i)) m)). -assumption. -apply H1; assumption. -assert (H4 := lt_eq_lt_dec n m). -elim H4; intro. -elim a; intro. -rewrite (tech2 An n m); [ idtac | assumption ]. -rewrite (tech2 (fun i:nat => Rabs (An i)) n m); [ idtac | assumption ]. -unfold R_dist in |- *. -unfold Rminus in |- *. -do 2 rewrite Ropp_plus_distr. -do 2 rewrite <- Rplus_assoc. -do 2 rewrite Rplus_opp_r. -do 2 rewrite Rplus_0_l. -do 2 rewrite Rabs_Ropp. -rewrite - (Rabs_right (sum_f_R0 (fun i:nat => Rabs (An (S n + i)%nat)) (m - S n))) - . -set (Bn := fun i:nat => An (S n + i)%nat). -replace (fun i:nat => Rabs (An (S n + i)%nat)) with - (fun i:nat => Rabs (Bn i)). -apply Rabs_triang_gen. -unfold Bn in |- *; reflexivity. -apply Rle_ge. -apply cond_pos_sum. -intro; apply Rabs_pos. -rewrite b. -unfold R_dist in |- *. -unfold Rminus in |- *; do 2 rewrite Rplus_opp_r. -rewrite Rabs_R0; right; reflexivity. -rewrite (tech2 An m n); [ idtac | assumption ]. -rewrite (tech2 (fun i:nat => Rabs (An i)) m n); [ idtac | assumption ]. -unfold R_dist in |- *. -unfold Rminus in |- *. -do 2 rewrite Rplus_assoc. -rewrite (Rplus_comm (sum_f_R0 An m)). -rewrite (Rplus_comm (sum_f_R0 (fun i:nat => Rabs (An i)) m)). -do 2 rewrite Rplus_assoc. -do 2 rewrite Rplus_opp_l. -do 2 rewrite Rplus_0_r. -rewrite - (Rabs_right (sum_f_R0 (fun i:nat => Rabs (An (S m + i)%nat)) (n - S m))) - . -set (Bn := fun i:nat => An (S m + i)%nat). -replace (fun i:nat => Rabs (An (S m + i)%nat)) with - (fun i:nat => Rabs (Bn i)). -apply Rabs_triang_gen. -unfold Bn in |- *; reflexivity. -apply Rle_ge. -apply cond_pos_sum. -intro; apply Rabs_pos. + forall An:nat -> R, + Cauchy_crit_series (fun i:nat => Rabs (An i)) -> Cauchy_crit_series An. +Proof. + unfold Cauchy_crit_series in |- *; unfold Cauchy_crit in |- *. + intros. + elim (H eps H0); intros. + exists x. + intros. + cut + (R_dist (sum_f_R0 An n) (sum_f_R0 An m) <= + R_dist (sum_f_R0 (fun i:nat => Rabs (An i)) n) + (sum_f_R0 (fun i:nat => Rabs (An i)) m)). + intro. + apply Rle_lt_trans with + (R_dist (sum_f_R0 (fun i:nat => Rabs (An i)) n) + (sum_f_R0 (fun i:nat => Rabs (An i)) m)). + assumption. + apply H1; assumption. + assert (H4 := lt_eq_lt_dec n m). + elim H4; intro. + elim a; intro. + rewrite (tech2 An n m); [ idtac | assumption ]. + rewrite (tech2 (fun i:nat => Rabs (An i)) n m); [ idtac | assumption ]. + unfold R_dist in |- *. + unfold Rminus in |- *. + do 2 rewrite Ropp_plus_distr. + do 2 rewrite <- Rplus_assoc. + do 2 rewrite Rplus_opp_r. + do 2 rewrite Rplus_0_l. + do 2 rewrite Rabs_Ropp. + rewrite + (Rabs_right (sum_f_R0 (fun i:nat => Rabs (An (S n + i)%nat)) (m - S n))) + . + set (Bn := fun i:nat => An (S n + i)%nat). + replace (fun i:nat => Rabs (An (S n + i)%nat)) with + (fun i:nat => Rabs (Bn i)). + apply Rabs_triang_gen. + unfold Bn in |- *; reflexivity. + apply Rle_ge. + apply cond_pos_sum. + intro; apply Rabs_pos. + rewrite b. + unfold R_dist in |- *. + unfold Rminus in |- *; do 2 rewrite Rplus_opp_r. + rewrite Rabs_R0; right; reflexivity. + rewrite (tech2 An m n); [ idtac | assumption ]. + rewrite (tech2 (fun i:nat => Rabs (An i)) m n); [ idtac | assumption ]. + unfold R_dist in |- *. + unfold Rminus in |- *. + do 2 rewrite Rplus_assoc. + rewrite (Rplus_comm (sum_f_R0 An m)). + rewrite (Rplus_comm (sum_f_R0 (fun i:nat => Rabs (An i)) m)). + do 2 rewrite Rplus_assoc. + do 2 rewrite Rplus_opp_l. + do 2 rewrite Rplus_0_r. + rewrite + (Rabs_right (sum_f_R0 (fun i:nat => Rabs (An (S m + i)%nat)) (n - S m))) + . + set (Bn := fun i:nat => An (S m + i)%nat). + replace (fun i:nat => Rabs (An (S m + i)%nat)) with + (fun i:nat => Rabs (Bn i)). + apply Rabs_triang_gen. + unfold Bn in |- *; reflexivity. + apply Rle_ge. + apply cond_pos_sum. + intro; apply Rabs_pos. Qed. (**********) Lemma cv_cauchy_1 : - forall An:nat -> R, - sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l) -> - Cauchy_crit_series An. -intros An X. -elim X; intros. -unfold Un_cv in p. -unfold Cauchy_crit_series in |- *; unfold Cauchy_crit in |- *. -intros. -cut (0 < eps / 2). -intro. -elim (p (eps / 2) H0); intros. -exists x0. -intros. -apply Rle_lt_trans with (R_dist (sum_f_R0 An n) x + R_dist (sum_f_R0 An m) x). -unfold R_dist in |- *. -replace (sum_f_R0 An n - sum_f_R0 An m) with - (sum_f_R0 An n - x + - (sum_f_R0 An m - x)); [ idtac | ring ]. -rewrite <- (Rabs_Ropp (sum_f_R0 An m - x)). -apply Rabs_triang. -apply Rlt_le_trans with (eps / 2 + eps / 2). -apply Rplus_lt_compat. -apply H1; assumption. -apply H1; assumption. -right; symmetry in |- *; apply double_var. -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. + forall An:nat -> R, + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l) -> + Cauchy_crit_series An. +Proof. + intros An X. + elim X; intros. + unfold Un_cv in p. + unfold Cauchy_crit_series in |- *; unfold Cauchy_crit in |- *. + intros. + cut (0 < eps / 2). + intro. + elim (p (eps / 2) H0); intros. + exists x0. + intros. + apply Rle_lt_trans with (R_dist (sum_f_R0 An n) x + R_dist (sum_f_R0 An m) x). + unfold R_dist in |- *. + replace (sum_f_R0 An n - sum_f_R0 An m) with + (sum_f_R0 An n - x + - (sum_f_R0 An m - x)); [ idtac | ring ]. + rewrite <- (Rabs_Ropp (sum_f_R0 An m - x)). + apply Rabs_triang. + apply Rlt_le_trans with (eps / 2 + eps / 2). + apply Rplus_lt_compat. + apply H1; assumption. + apply H1; assumption. + right; symmetry in |- *; apply double_var. + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. Qed. Lemma cv_cauchy_2 : - forall An:nat -> R, - Cauchy_crit_series An -> - sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l). -intros. -apply R_complete. -unfold Cauchy_crit_series in H. -exact H. + forall An:nat -> R, + Cauchy_crit_series An -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l). +Proof. + intros. + apply R_complete. + unfold Cauchy_crit_series in H. + exact H. Qed. (**********) Lemma sum_eq_R0 : - forall (An:nat -> R) (N:nat), - (forall n:nat, (n <= N)%nat -> An n = 0) -> sum_f_R0 An N = 0. -intros; induction N as [| N HrecN]. -simpl in |- *; apply H; apply le_n. -rewrite tech5; rewrite HrecN; - [ rewrite Rplus_0_l; apply H; apply le_n - | intros; apply H; apply le_trans with N; [ assumption | apply le_n_Sn ] ]. + forall (An:nat -> R) (N:nat), + (forall n:nat, (n <= N)%nat -> An n = 0) -> sum_f_R0 An N = 0. +Proof. + intros; induction N as [| N HrecN]. + simpl in |- *; apply H; apply le_n. + rewrite tech5; rewrite HrecN; + [ rewrite Rplus_0_l; apply H; apply le_n + | intros; apply H; apply le_trans with N; [ assumption | apply le_n_Sn ] ]. Qed. Definition SP (fn:nat -> R -> R) (N:nat) (x:R) : R := @@ -481,122 +506,124 @@ Definition SP (fn:nat -> R -> R) (N:nat) (x:R) : R := (**********) Lemma sum_incr : - forall (An:nat -> R) (N:nat) (l:R), - Un_cv (fun n:nat => sum_f_R0 An n) l -> - (forall n:nat, 0 <= An n) -> sum_f_R0 An N <= l. -intros; case (total_order_T (sum_f_R0 An N) l); intro. -elim s; intro. -left; apply a. -right; apply b. -cut (Un_growing (fun n:nat => sum_f_R0 An n)). -intro; set (l1 := sum_f_R0 An N) in r. -unfold Un_cv in H; cut (0 < l1 - l). -intro; elim (H _ H2); intros. -set (N0 := max x N); cut (N0 >= x)%nat. -intro; assert (H5 := H3 N0 H4). -cut (l1 <= sum_f_R0 An N0). -intro; unfold R_dist in H5; rewrite Rabs_right in H5. -cut (sum_f_R0 An N0 < l1). -intro; elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H7 H6)). -apply Rplus_lt_reg_r with (- l). -do 2 rewrite (Rplus_comm (- l)). -apply H5. -apply Rle_ge; apply Rplus_le_reg_l with l. -rewrite Rplus_0_r; replace (l + (sum_f_R0 An N0 - l)) with (sum_f_R0 An N0); - [ idtac | ring ]; apply Rle_trans with l1. -left; apply r. -apply H6. -unfold l1 in |- *; apply Rge_le; - apply (growing_prop (fun k:nat => sum_f_R0 An k)). -apply H1. -unfold ge, N0 in |- *; apply le_max_r. -unfold ge, N0 in |- *; apply le_max_l. -apply Rplus_lt_reg_r with l; rewrite Rplus_0_r; - replace (l + (l1 - l)) with l1; [ apply r | ring ]. -unfold Un_growing in |- *; intro; simpl in |- *; - pattern (sum_f_R0 An n) at 1 in |- *; rewrite <- Rplus_0_r; - apply Rplus_le_compat_l; apply H0. + forall (An:nat -> R) (N:nat) (l:R), + Un_cv (fun n:nat => sum_f_R0 An n) l -> + (forall n:nat, 0 <= An n) -> sum_f_R0 An N <= l. +Proof. + intros; case (total_order_T (sum_f_R0 An N) l); intro. + elim s; intro. + left; apply a. + right; apply b. + cut (Un_growing (fun n:nat => sum_f_R0 An n)). + intro; set (l1 := sum_f_R0 An N) in r. + unfold Un_cv in H; cut (0 < l1 - l). + intro; elim (H _ H2); intros. + set (N0 := max x N); cut (N0 >= x)%nat. + intro; assert (H5 := H3 N0 H4). + cut (l1 <= sum_f_R0 An N0). + intro; unfold R_dist in H5; rewrite Rabs_right in H5. + cut (sum_f_R0 An N0 < l1). + intro; elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H7 H6)). + apply Rplus_lt_reg_r with (- l). + do 2 rewrite (Rplus_comm (- l)). + apply H5. + apply Rle_ge; apply Rplus_le_reg_l with l. + rewrite Rplus_0_r; replace (l + (sum_f_R0 An N0 - l)) with (sum_f_R0 An N0); + [ idtac | ring ]; apply Rle_trans with l1. + left; apply r. + apply H6. + unfold l1 in |- *; apply Rge_le; + apply (growing_prop (fun k:nat => sum_f_R0 An k)). + apply H1. + unfold ge, N0 in |- *; apply le_max_r. + unfold ge, N0 in |- *; apply le_max_l. + apply Rplus_lt_reg_r with l; rewrite Rplus_0_r; + replace (l + (l1 - l)) with l1; [ apply r | ring ]. + unfold Un_growing in |- *; intro; simpl in |- *; + pattern (sum_f_R0 An n) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l; apply H0. Qed. (**********) Lemma sum_cv_maj : - forall (An:nat -> R) (fn:nat -> R -> R) (x l1 l2:R), - Un_cv (fun n:nat => SP fn n x) l1 -> - Un_cv (fun n:nat => sum_f_R0 An n) l2 -> - (forall n:nat, Rabs (fn n x) <= An n) -> Rabs l1 <= l2. -intros; case (total_order_T (Rabs l1) l2); intro. -elim s; intro. -left; apply a. -right; apply b. -cut (forall n0:nat, Rabs (SP fn n0 x) <= sum_f_R0 An n0). -intro; cut (0 < (Rabs l1 - l2) / 2). -intro; unfold Un_cv in H, H0. -elim (H _ H3); intros Na H4. -elim (H0 _ H3); intros Nb H5. -set (N := max Na Nb). -unfold R_dist in H4, H5. -cut (Rabs (sum_f_R0 An N - l2) < (Rabs l1 - l2) / 2). -intro; cut (Rabs (Rabs l1 - Rabs (SP fn N x)) < (Rabs l1 - l2) / 2). -intro; cut (sum_f_R0 An N < (Rabs l1 + l2) / 2). -intro; cut ((Rabs l1 + l2) / 2 < Rabs (SP fn N x)). -intro; cut (sum_f_R0 An N < Rabs (SP fn N x)). -intro; assert (H11 := H2 N). -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H10)). -apply Rlt_trans with ((Rabs l1 + l2) / 2); assumption. -case (Rcase_abs (Rabs l1 - Rabs (SP fn N x))); intro. -apply Rlt_trans with (Rabs l1). -apply Rmult_lt_reg_l with 2. -prove_sup0. -unfold Rdiv in |- *; rewrite (Rmult_comm 2); rewrite Rmult_assoc; - rewrite <- Rinv_l_sym. -rewrite Rmult_1_r; rewrite double; apply Rplus_lt_compat_l; apply r. -discrR. -apply (Rminus_lt _ _ r0). -rewrite (Rabs_right _ r0) in H7. -apply Rplus_lt_reg_r with ((Rabs l1 - l2) / 2 - Rabs (SP fn N x)). -replace ((Rabs l1 - l2) / 2 - Rabs (SP fn N x) + (Rabs l1 + l2) / 2) with - (Rabs l1 - Rabs (SP fn N x)). -unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l; - rewrite Rplus_0_r; apply H7. -unfold Rdiv in |- *; rewrite Rmult_plus_distr_r; - rewrite <- (Rmult_comm (/ 2)); rewrite Rmult_minus_distr_l; - repeat rewrite (Rmult_comm (/ 2)); pattern (Rabs l1) at 1 in |- *; - rewrite double_var; unfold Rdiv in |- *; ring. -case (Rcase_abs (sum_f_R0 An N - l2)); intro. -apply Rlt_trans with l2. -apply (Rminus_lt _ _ r0). -apply Rmult_lt_reg_l with 2. -prove_sup0. -rewrite (double l2); unfold Rdiv in |- *; rewrite (Rmult_comm 2); - rewrite Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_r; rewrite (Rplus_comm (Rabs l1)); apply Rplus_lt_compat_l; - apply r. -discrR. -rewrite (Rabs_right _ r0) in H6; apply Rplus_lt_reg_r with (- l2). -replace (- l2 + (Rabs l1 + l2) / 2) with ((Rabs l1 - l2) / 2). -rewrite Rplus_comm; apply H6. -unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); - rewrite Rmult_minus_distr_l; rewrite Rmult_plus_distr_r; - pattern l2 at 2 in |- *; rewrite double_var; - repeat rewrite (Rmult_comm (/ 2)); rewrite Ropp_plus_distr; - unfold Rdiv in |- *; ring. -apply Rle_lt_trans with (Rabs (SP fn N x - l1)). -rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr'; apply Rabs_triang_inv2. -apply H4; unfold ge, N in |- *; apply le_max_l. -apply H5; unfold ge, N in |- *; apply le_max_r. -unfold Rdiv in |- *; apply Rmult_lt_0_compat. -apply Rplus_lt_reg_r with l2. -rewrite Rplus_0_r; replace (l2 + (Rabs l1 - l2)) with (Rabs l1); - [ apply r | ring ]. -apply Rinv_0_lt_compat; prove_sup0. -intros; induction n0 as [| n0 Hrecn0]. -unfold SP in |- *; simpl in |- *; apply H1. -unfold SP in |- *; simpl in |- *. -apply Rle_trans with - (Rabs (sum_f_R0 (fun k:nat => fn k x) n0) + Rabs (fn (S n0) x)). -apply Rabs_triang. -apply Rle_trans with (sum_f_R0 An n0 + Rabs (fn (S n0) x)). -do 2 rewrite <- (Rplus_comm (Rabs (fn (S n0) x))). -apply Rplus_le_compat_l; apply Hrecn0. -apply Rplus_le_compat_l; apply H1. + forall (An:nat -> R) (fn:nat -> R -> R) (x l1 l2:R), + Un_cv (fun n:nat => SP fn n x) l1 -> + Un_cv (fun n:nat => sum_f_R0 An n) l2 -> + (forall n:nat, Rabs (fn n x) <= An n) -> Rabs l1 <= l2. +Proof. + intros; case (total_order_T (Rabs l1) l2); intro. + elim s; intro. + left; apply a. + right; apply b. + cut (forall n0:nat, Rabs (SP fn n0 x) <= sum_f_R0 An n0). + intro; cut (0 < (Rabs l1 - l2) / 2). + intro; unfold Un_cv in H, H0. + elim (H _ H3); intros Na H4. + elim (H0 _ H3); intros Nb H5. + set (N := max Na Nb). + unfold R_dist in H4, H5. + cut (Rabs (sum_f_R0 An N - l2) < (Rabs l1 - l2) / 2). + intro; cut (Rabs (Rabs l1 - Rabs (SP fn N x)) < (Rabs l1 - l2) / 2). + intro; cut (sum_f_R0 An N < (Rabs l1 + l2) / 2). + intro; cut ((Rabs l1 + l2) / 2 < Rabs (SP fn N x)). + intro; cut (sum_f_R0 An N < Rabs (SP fn N x)). + intro; assert (H11 := H2 N). + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H10)). + apply Rlt_trans with ((Rabs l1 + l2) / 2); assumption. + case (Rcase_abs (Rabs l1 - Rabs (SP fn N x))); intro. + apply Rlt_trans with (Rabs l1). + apply Rmult_lt_reg_l with 2. + prove_sup0. + unfold Rdiv in |- *; rewrite (Rmult_comm 2); rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. + rewrite Rmult_1_r; rewrite double; apply Rplus_lt_compat_l; apply r. + discrR. + apply (Rminus_lt _ _ r0). + rewrite (Rabs_right _ r0) in H7. + apply Rplus_lt_reg_r with ((Rabs l1 - l2) / 2 - Rabs (SP fn N x)). + replace ((Rabs l1 - l2) / 2 - Rabs (SP fn N x) + (Rabs l1 + l2) / 2) with + (Rabs l1 - Rabs (SP fn N x)). + unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l; + rewrite Rplus_0_r; apply H7. + unfold Rdiv in |- *; rewrite Rmult_plus_distr_r; + rewrite <- (Rmult_comm (/ 2)); rewrite Rmult_minus_distr_l; + repeat rewrite (Rmult_comm (/ 2)); pattern (Rabs l1) at 1 in |- *; + rewrite double_var; unfold Rdiv in |- *; ring. + case (Rcase_abs (sum_f_R0 An N - l2)); intro. + apply Rlt_trans with l2. + apply (Rminus_lt _ _ r0). + apply Rmult_lt_reg_l with 2. + prove_sup0. + rewrite (double l2); unfold Rdiv in |- *; rewrite (Rmult_comm 2); + rewrite Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_r; rewrite (Rplus_comm (Rabs l1)); apply Rplus_lt_compat_l; + apply r. + discrR. + rewrite (Rabs_right _ r0) in H6; apply Rplus_lt_reg_r with (- l2). + replace (- l2 + (Rabs l1 + l2) / 2) with ((Rabs l1 - l2) / 2). + rewrite Rplus_comm; apply H6. + unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); + rewrite Rmult_minus_distr_l; rewrite Rmult_plus_distr_r; + pattern l2 at 2 in |- *; rewrite double_var; + repeat rewrite (Rmult_comm (/ 2)); rewrite Ropp_plus_distr; + unfold Rdiv in |- *; ring. + apply Rle_lt_trans with (Rabs (SP fn N x - l1)). + rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr'; apply Rabs_triang_inv2. + apply H4; unfold ge, N in |- *; apply le_max_l. + apply H5; unfold ge, N in |- *; apply le_max_r. + unfold Rdiv in |- *; apply Rmult_lt_0_compat. + apply Rplus_lt_reg_r with l2. + rewrite Rplus_0_r; replace (l2 + (Rabs l1 - l2)) with (Rabs l1); + [ apply r | ring ]. + apply Rinv_0_lt_compat; prove_sup0. + intros; induction n0 as [| n0 Hrecn0]. + unfold SP in |- *; simpl in |- *; apply H1. + unfold SP in |- *; simpl in |- *. + apply Rle_trans with + (Rabs (sum_f_R0 (fun k:nat => fn k x) n0) + Rabs (fn (S n0) x)). + apply Rabs_triang. + apply Rle_trans with (sum_f_R0 An n0 + Rabs (fn (S n0) x)). + do 2 rewrite <- (Rplus_comm (Rabs (fn (S n0) x))). + apply Rplus_le_compat_l; apply Hrecn0. + apply Rplus_le_compat_l; apply H1. Qed. diff --git a/theories/Reals/RIneq.v b/theories/Reals/RIneq.v index 3e1dbccf..51c66afa 100644 --- a/theories/Reals/RIneq.v +++ b/theories/Reals/RIneq.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: RIneq.v 6897 2005-03-29 15:39:12Z herbelin $ i*) +(*i $Id: RIneq.v 9302 2006-10-27 21:21:17Z barras $ i*) (***************************************************************************) (** Basic lemmas for the classical reals numbers *) @@ -15,63 +15,44 @@ Require Export Raxioms. Require Export ZArithRing. Require Import Omega. -Require Export Field. +Require Export RealField. Open Local Scope Z_scope. Open Local Scope R_scope. Implicit Type r : R. -(***************************************************************************) -(** Instantiating Ring tactic on reals *) -(***************************************************************************) - -Lemma RTheory : Ring_Theory Rplus Rmult 1 0 Ropp (fun x y:R => false). - split. - exact Rplus_comm. - symmetry in |- *; apply Rplus_assoc. - exact Rmult_comm. - symmetry in |- *; apply Rmult_assoc. - intro; apply Rplus_0_l. - intro; apply Rmult_1_l. - exact Rplus_opp_r. - intros. - rewrite Rmult_comm. - rewrite (Rmult_comm n p). - rewrite (Rmult_comm m p). - apply Rmult_plus_distr_l. - intros; contradiction. -Defined. - -Add Field R Rplus Rmult 1 0 Ropp (fun x y:R => false) Rinv RTheory Rinv_l - with minus := Rminus div := Rdiv. - (**************************************************************************) -(** Relation between orders and equality *) +(** * Relation between orders and equality *) (**************************************************************************) (**********) Lemma Rlt_irrefl : forall r, ~ r < r. +Proof. generalize Rlt_asym. intuition eauto. Qed. Hint Resolve Rlt_irrefl: real. Lemma Rle_refl : forall r, r <= r. -intro; right; reflexivity. +Proof. + intro; right; reflexivity. Qed. Lemma Rlt_not_eq : forall r1 r2, r1 < r2 -> r1 <> r2. +Proof. red in |- *; intros r1 r2 H H0; apply (Rlt_irrefl r1). pattern r1 at 2 in |- *; rewrite H0; trivial. Qed. Lemma Rgt_not_eq : forall r1 r2, r1 > r2 -> r1 <> r2. -intros; apply sym_not_eq; apply Rlt_not_eq; auto with real. +Proof. + intros; apply sym_not_eq; apply Rlt_not_eq; auto with real. Qed. (**********) Lemma Rlt_dichotomy_converse : forall r1 r2, r1 < r2 \/ r1 > r2 -> r1 <> r2. -generalize Rlt_not_eq Rgt_not_eq. intuition eauto. +Proof. + generalize Rlt_not_eq Rgt_not_eq. intuition eauto. Qed. Hint Resolve Rlt_dichotomy_converse: real. @@ -79,61 +60,70 @@ Hint Resolve Rlt_dichotomy_converse: real. (**********) Lemma Req_dec : forall r1 r2, r1 = r2 \/ r1 <> r2. -intros; generalize (total_order_T r1 r2) Rlt_dichotomy_converse; - intuition eauto 3. +Proof. + intros; generalize (total_order_T r1 r2) Rlt_dichotomy_converse; + intuition eauto 3. Qed. Hint Resolve Req_dec: real. (**********) Lemma Rtotal_order : forall r1 r2, r1 < r2 \/ r1 = r2 \/ r1 > r2. -intros; generalize (total_order_T r1 r2); tauto. +Proof. + intros; generalize (total_order_T r1 r2); tauto. Qed. (**********) Lemma Rdichotomy : forall r1 r2, r1 <> r2 -> r1 < r2 \/ r1 > r2. -intros; generalize (total_order_T r1 r2); tauto. +Proof. + intros; generalize (total_order_T r1 r2); tauto. Qed. (*********************************************************************************) -(** Order Lemma : relating [<], [>], [<=] and [>=] *) +(** * Order Lemma : relating [<], [>], [<=] and [>=] *) (*********************************************************************************) (**********) Lemma Rlt_le : forall r1 r2, r1 < r2 -> r1 <= r2. -intros; red in |- *; tauto. +Proof. + intros; red in |- *; tauto. Qed. Hint Resolve Rlt_le: real. (**********) Lemma Rle_ge : forall r1 r2, r1 <= r2 -> r2 >= r1. -destruct 1; red in |- *; auto with real. +Proof. + destruct 1; red in |- *; auto with real. Qed. Hint Immediate Rle_ge: real. (**********) Lemma Rge_le : forall r1 r2, r1 >= r2 -> r2 <= r1. -destruct 1; red in |- *; auto with real. +Proof. + destruct 1; red in |- *; auto with real. Qed. Hint Resolve Rge_le: real. (**********) Lemma Rnot_le_lt : forall r1 r2, ~ r1 <= r2 -> r2 < r1. -intros r1 r2; generalize (Rtotal_order r1 r2); unfold Rle in |- *; tauto. +Proof. + intros r1 r2; generalize (Rtotal_order r1 r2); unfold Rle in |- *; tauto. Qed. Hint Immediate Rnot_le_lt: real. Lemma Rnot_ge_lt : forall r1 r2, ~ r1 >= r2 -> r1 < r2. -intros; apply Rnot_le_lt; auto with real. +Proof. + intros; apply Rnot_le_lt; auto with real. Qed. (**********) Lemma Rlt_not_le : forall r1 r2, r2 < r1 -> ~ r1 <= r2. -generalize Rlt_asym Rlt_dichotomy_converse; unfold Rle in |- *. -intuition eauto 3. +Proof. + generalize Rlt_asym Rlt_dichotomy_converse; unfold Rle in |- *. + intuition eauto 3. Qed. Lemma Rgt_not_le : forall r1 r2, r1 > r2 -> ~ r1 <= r2. @@ -142,134 +132,157 @@ Proof Rlt_not_le. Hint Immediate Rlt_not_le: real. Lemma Rle_not_lt : forall r1 r2, r2 <= r1 -> ~ r1 < r2. -intros r1 r2. generalize (Rlt_asym r1 r2) (Rlt_dichotomy_converse r1 r2). -unfold Rle in |- *; intuition. +Proof. + intros r1 r2. generalize (Rlt_asym r1 r2) (Rlt_dichotomy_converse r1 r2). + unfold Rle in |- *; intuition. Qed. (**********) Lemma Rlt_not_ge : forall r1 r2, r1 < r2 -> ~ r1 >= r2. -generalize Rlt_not_le. unfold Rle, Rge in |- *. intuition eauto 3. +Proof. + generalize Rlt_not_le. unfold Rle, Rge in |- *. intuition eauto 3. Qed. Hint Immediate Rlt_not_ge: real. (**********) Lemma Req_le : forall r1 r2, r1 = r2 -> r1 <= r2. -unfold Rle in |- *; tauto. +Proof. + unfold Rle in |- *; tauto. Qed. Hint Immediate Req_le: real. Lemma Req_ge : forall r1 r2, r1 = r2 -> r1 >= r2. -unfold Rge in |- *; tauto. +Proof. + unfold Rge in |- *; tauto. Qed. Hint Immediate Req_ge: real. Lemma Req_le_sym : forall r1 r2, r2 = r1 -> r1 <= r2. -unfold Rle in |- *; auto. +Proof. + unfold Rle in |- *; auto. Qed. Hint Immediate Req_le_sym: real. Lemma Req_ge_sym : forall r1 r2, r2 = r1 -> r1 >= r2. -unfold Rge in |- *; auto. +Proof. + unfold Rge in |- *; auto. Qed. Hint Immediate Req_ge_sym: real. Lemma Rle_antisym : forall r1 r2, r1 <= r2 -> r2 <= r1 -> r1 = r2. -intros r1 r2; generalize (Rlt_asym r1 r2); unfold Rle in |- *; intuition. +Proof. + intros r1 r2; generalize (Rlt_asym r1 r2); unfold Rle in |- *; intuition. Qed. Hint Resolve Rle_antisym: real. (**********) Lemma Rle_le_eq : forall r1 r2, r1 <= r2 /\ r2 <= r1 <-> r1 = r2. -intuition. +Proof. + intuition. Qed. Lemma Rlt_eq_compat : - forall r1 r2 r3 r4, r1 = r2 -> r2 < r4 -> r4 = r3 -> r1 < r3. -intros x x' y y'; intros; replace x with x'; replace y with y'; assumption. + forall r1 r2 r3 r4, r1 = r2 -> r2 < r4 -> r4 = r3 -> r1 < r3. +Proof. + intros x x' y y'; intros; replace x with x'; replace y with y'; assumption. Qed. (**********) Lemma Rle_trans : forall r1 r2 r3, r1 <= r2 -> r2 <= r3 -> r1 <= r3. -generalize trans_eq Rlt_trans Rlt_eq_compat. -unfold Rle in |- *. -intuition eauto 2. +Proof. + generalize trans_eq Rlt_trans Rlt_eq_compat. + unfold Rle in |- *. + intuition eauto 2. Qed. (**********) Lemma Rle_lt_trans : forall r1 r2 r3, r1 <= r2 -> r2 < r3 -> r1 < r3. -generalize Rlt_trans Rlt_eq_compat. -unfold Rle in |- *. -intuition eauto 2. +Proof. + generalize Rlt_trans Rlt_eq_compat. + unfold Rle in |- *. + intuition eauto 2. Qed. (**********) Lemma Rlt_le_trans : forall r1 r2 r3, r1 < r2 -> r2 <= r3 -> r1 < r3. -generalize Rlt_trans Rlt_eq_compat; unfold Rle in |- *; intuition eauto 2. +Proof. + generalize Rlt_trans Rlt_eq_compat; unfold Rle in |- *; intuition eauto 2. Qed. (** Decidability of the order *) Lemma Rlt_dec : forall r1 r2, {r1 < r2} + {~ r1 < r2}. -intros; generalize (total_order_T r1 r2) (Rlt_dichotomy_converse r1 r2); - intuition. +Proof. + intros; generalize (total_order_T r1 r2) (Rlt_dichotomy_converse r1 r2); + intuition. Qed. (**********) Lemma Rle_dec : forall r1 r2, {r1 <= r2} + {~ r1 <= r2}. -intros r1 r2. -generalize (total_order_T r1 r2) (Rlt_dichotomy_converse r1 r2). -intuition eauto 4 with real. +Proof. + intros r1 r2. + generalize (total_order_T r1 r2) (Rlt_dichotomy_converse r1 r2). + intuition eauto 4 with real. Qed. (**********) Lemma Rgt_dec : forall r1 r2, {r1 > r2} + {~ r1 > r2}. -intros; unfold Rgt in |- *; intros; apply Rlt_dec. +Proof. + intros; unfold Rgt in |- *; intros; apply Rlt_dec. Qed. (**********) Lemma Rge_dec : forall r1 r2, {r1 >= r2} + {~ r1 >= r2}. -intros; generalize (Rle_dec r2 r1); intuition. +Proof. + intros; generalize (Rle_dec r2 r1); intuition. Qed. Lemma Rlt_le_dec : forall r1 r2, {r1 < r2} + {r2 <= r1}. -intros; generalize (total_order_T r1 r2); intuition. +Proof. + intros; generalize (total_order_T r1 r2); intuition. Qed. Lemma Rle_or_lt : forall r1 r2, r1 <= r2 \/ r2 < r1. -intros n m; elim (Rlt_le_dec m n); auto with real. +Proof. + intros n m; elim (Rlt_le_dec m n); auto with real. Qed. Lemma Rle_lt_or_eq_dec : forall r1 r2, r1 <= r2 -> {r1 < r2} + {r1 = r2}. -intros r1 r2 H; generalize (total_order_T r1 r2); intuition. +Proof. + intros r1 r2 H; generalize (total_order_T r1 r2); intuition. Qed. (**********) Lemma inser_trans_R : - forall r1 r2 r3 r4, r1 <= r2 < r3 -> {r1 <= r2 < r4} + {r4 <= r2 < r3}. -intros n m p q; intros; generalize (Rlt_le_dec m q); intuition. + forall r1 r2 r3 r4, r1 <= r2 < r3 -> {r1 <= r2 < r4} + {r4 <= r2 < r3}. +Proof. + intros n m p q; intros; generalize (Rlt_le_dec m q); intuition. Qed. (****************************************************************) -(** Field Lemmas *) +(** * Field Lemmas *) (* This part contains lemma involving the Fields operations *) (****************************************************************) (*********************************************************) -(** Addition *) +(** ** Addition *) (*********************************************************) Lemma Rplus_ne : forall r, r + 0 = r /\ 0 + r = r. -intro; split; ring. +Proof. + split; ring. Qed. Hint Resolve Rplus_ne: real v62. Lemma Rplus_0_r : forall r, r + 0 = r. -intro; ring. +Proof. + intro; ring. Qed. Hint Resolve Rplus_0_r: real. (**********) Lemma Rplus_opp_l : forall r, - r + r = 0. +Proof. intro; ring. Qed. Hint Resolve Rplus_opp_l: real. @@ -277,14 +290,17 @@ Hint Resolve Rplus_opp_l: real. (**********) Lemma Rplus_opp_r_uniq : forall r1 r2, r1 + r2 = 0 -> r2 = - r1. - intros x y H; replace y with (- x + x + y); - [ rewrite Rplus_assoc; rewrite H; ring | ring ]. +Proof. + intros x y H; + replace y with (- x + x + y) by ring. + rewrite Rplus_assoc; rewrite H; ring. Qed. (*i New i*) Hint Resolve (f_equal (A:=R)): real. Lemma Rplus_eq_compat_l : forall r r1 r2, r1 = r2 -> r + r1 = r + r2. +Proof. auto with real. Qed. @@ -292,6 +308,7 @@ Qed. (**********) Lemma Rplus_eq_reg_l : forall r r1 r2, r + r1 = r + r2 -> r1 = r2. +Proof. intros; transitivity (- r + r + r1). ring. transitivity (- r + r + r2). @@ -302,55 +319,64 @@ Hint Resolve Rplus_eq_reg_l: real. (**********) Lemma Rplus_0_r_uniq : forall r r1, r + r1 = r -> r1 = 0. +Proof. intros r b; pattern r at 2 in |- *; replace r with (r + 0); eauto with real. Qed. (***********************************************************) -(** Multiplication *) +(** ** Multiplication *) (***********************************************************) (**********) Lemma Rinv_r : forall r, r <> 0 -> r * / r = 1. - intros; rewrite Rmult_comm; auto with real. +Proof. + intros; field; trivial. Qed. Hint Resolve Rinv_r: real. Lemma Rinv_l_sym : forall r, r <> 0 -> 1 = / r * r. - symmetry in |- *; auto with real. +Proof. + intros; field; trivial. Qed. Lemma Rinv_r_sym : forall r, r <> 0 -> 1 = r * / r. - symmetry in |- *; auto with real. +Proof. + intros; field; trivial. Qed. Hint Resolve Rinv_l_sym Rinv_r_sym: real. (**********) Lemma Rmult_0_r : forall r, r * 0 = 0. -intro; ring. +Proof. + intro; ring. Qed. Hint Resolve Rmult_0_r: real v62. (**********) Lemma Rmult_0_l : forall r, 0 * r = 0. -intro; ring. +Proof. + intro; ring. Qed. Hint Resolve Rmult_0_l: real v62. (**********) Lemma Rmult_ne : forall r, r * 1 = r /\ 1 * r = r. -intro; split; ring. +Proof. + intro; split; ring. Qed. Hint Resolve Rmult_ne: real v62. (**********) Lemma Rmult_1_r : forall r, r * 1 = r. -intro; ring. +Proof. + intro; ring. Qed. Hint Resolve Rmult_1_r: real. (**********) Lemma Rmult_eq_compat_l : forall r r1 r2, r1 = r2 -> r * r1 = r * r2. +Proof. auto with real. Qed. @@ -358,15 +384,17 @@ Qed. (**********) Lemma Rmult_eq_reg_l : forall r r1 r2, r * r1 = r * r2 -> r <> 0 -> r1 = r2. +Proof. intros; transitivity (/ r * r * r1). - rewrite Rinv_l; auto with real. + field; trivial. transitivity (/ r * r * r2). repeat rewrite Rmult_assoc; rewrite H; trivial. - rewrite Rinv_l; auto with real. + field; trivial. Qed. (**********) Lemma Rmult_integral : forall r1 r2, r1 * r2 = 0 -> r1 = 0 \/ r2 = 0. +Proof. intros; case (Req_dec r1 0); [ intro Hz | intro Hnotz ]. auto. right; apply Rmult_eq_reg_l with r1; trivial. @@ -375,6 +403,7 @@ Qed. (**********) Lemma Rmult_eq_0_compat : forall r1 r2, r1 = 0 \/ r2 = 0 -> r1 * r2 = 0. +Proof. intros r1 r2 [H| H]; rewrite H; auto with real. Qed. @@ -382,35 +411,40 @@ Hint Resolve Rmult_eq_0_compat: real. (**********) Lemma Rmult_eq_0_compat_r : forall r1 r2, r1 = 0 -> r1 * r2 = 0. +Proof. auto with real. Qed. (**********) Lemma Rmult_eq_0_compat_l : forall r1 r2, r2 = 0 -> r1 * r2 = 0. +Proof. auto with real. Qed. (**********) Lemma Rmult_neq_0_reg : forall r1 r2, r1 * r2 <> 0 -> r1 <> 0 /\ r2 <> 0. -intros r1 r2 H; split; red in |- *; intro; apply H; auto with real. +Proof. + intros r1 r2 H; split; red in |- *; intro; apply H; auto with real. Qed. (**********) Lemma Rmult_integral_contrapositive : - forall r1 r2, r1 <> 0 /\ r2 <> 0 -> r1 * r2 <> 0. -red in |- *; intros r1 r2 [H1 H2] H. -case (Rmult_integral r1 r2); auto with real. + forall r1 r2, r1 <> 0 /\ r2 <> 0 -> r1 * r2 <> 0. +Proof. + red in |- *; intros r1 r2 [H1 H2] H. + case (Rmult_integral r1 r2); auto with real. Qed. Hint Resolve Rmult_integral_contrapositive: real. (**********) Lemma Rmult_plus_distr_r : - forall r1 r2 r3, (r1 + r2) * r3 = r1 * r3 + r2 * r3. -intros; ring. + forall r1 r2 r3, (r1 + r2) * r3 = r1 * r3 + r2 * r3. +Proof. + intros; ring. Qed. -(** Square function *) +(** ** Square function *) (***********) Definition Rsqr r : R := r * r. @@ -422,695 +456,802 @@ Qed. (***********) Lemma Rsqr_0_uniq : forall r, Rsqr r = 0 -> r = 0. -unfold Rsqr in |- *; intros; elim (Rmult_integral r r H); trivial. + unfold Rsqr in |- *; intros; elim (Rmult_integral r r H); trivial. Qed. (*********************************************************) -(** Opposite *) +(** ** Opposite *) (*********************************************************) (**********) Lemma Ropp_eq_compat : forall r1 r2, r1 = r2 -> - r1 = - r2. +Proof. auto with real. Qed. Hint Resolve Ropp_eq_compat: real. (**********) Lemma Ropp_0 : -0 = 0. +Proof. ring. Qed. Hint Resolve Ropp_0: real v62. (**********) Lemma Ropp_eq_0_compat : forall r, r = 0 -> - r = 0. +Proof. intros; rewrite H; auto with real. Qed. Hint Resolve Ropp_eq_0_compat: real. (**********) Lemma Ropp_involutive : forall r, - - r = r. +Proof. intro; ring. Qed. Hint Resolve Ropp_involutive: real. (*********) Lemma Ropp_neq_0_compat : forall r, r <> 0 -> - r <> 0. -red in |- *; intros r H H0. -apply H. -transitivity (- - r); auto with real. +Proof. + red in |- *; intros r H H0. + apply H. + transitivity (- - r); auto with real. Qed. Hint Resolve Ropp_neq_0_compat: real. (**********) Lemma Ropp_plus_distr : forall r1 r2, - (r1 + r2) = - r1 + - r2. +Proof. intros; ring. Qed. Hint Resolve Ropp_plus_distr: real. -(** Opposite and multiplication *) + +(** ** Opposite and multiplication *) Lemma Ropp_mult_distr_l_reverse : forall r1 r2, - r1 * r2 = - (r1 * r2). +Proof. intros; ring. Qed. Hint Resolve Ropp_mult_distr_l_reverse: real. (**********) Lemma Rmult_opp_opp : forall r1 r2, - r1 * - r2 = r1 * r2. +Proof. intros; ring. Qed. Hint Resolve Rmult_opp_opp: real. Lemma Ropp_mult_distr_r_reverse : forall r1 r2, r1 * - r2 = - (r1 * r2). -intros; rewrite <- Ropp_mult_distr_l_reverse; ring. +Proof. + intros; ring. Qed. -(** Substraction *) +(** ** Substraction *) Lemma Rminus_0_r : forall r, r - 0 = r. -intro; ring. +Proof. + intro; ring. Qed. Hint Resolve Rminus_0_r: real. Lemma Rminus_0_l : forall r, 0 - r = - r. -intro; ring. +Proof. + intro; ring. Qed. Hint Resolve Rminus_0_l: real. (**********) Lemma Ropp_minus_distr : forall r1 r2, - (r1 - r2) = r2 - r1. +Proof. intros; ring. Qed. Hint Resolve Ropp_minus_distr: real. Lemma Ropp_minus_distr' : forall r1 r2, - (r2 - r1) = r1 - r2. -intros; ring. +Proof. + intros; ring. Qed. Hint Resolve Ropp_minus_distr': real. (**********) Lemma Rminus_diag_eq : forall r1 r2, r1 = r2 -> r1 - r2 = 0. +Proof. intros; rewrite H; ring. Qed. Hint Resolve Rminus_diag_eq: real. (**********) Lemma Rminus_diag_uniq : forall r1 r2, r1 - r2 = 0 -> r1 = r2. +Proof. intros r1 r2; unfold Rminus in |- *; rewrite Rplus_comm; intro. rewrite <- (Ropp_involutive r2); apply (Rplus_opp_r_uniq (- r2) r1 H). Qed. Hint Immediate Rminus_diag_uniq: real. Lemma Rminus_diag_uniq_sym : forall r1 r2, r2 - r1 = 0 -> r1 = r2. -intros; generalize (Rminus_diag_uniq r2 r1 H); clear H; intro H; rewrite H; - ring. +Proof. + intros; generalize (Rminus_diag_uniq r2 r1 H); clear H; intro H; rewrite H; + ring. Qed. Hint Immediate Rminus_diag_uniq_sym: real. Lemma Rplus_minus : forall r1 r2, r1 + (r2 - r1) = r2. -intros; ring. +Proof. + intros; ring. Qed. Hint Resolve Rplus_minus: real. (**********) Lemma Rminus_eq_contra : forall r1 r2, r1 <> r2 -> r1 - r2 <> 0. -red in |- *; intros r1 r2 H H0. -apply H; auto with real. +Proof. + red in |- *; intros r1 r2 H H0. + apply H; auto with real. Qed. Hint Resolve Rminus_eq_contra: real. Lemma Rminus_not_eq : forall r1 r2, r1 - r2 <> 0 -> r1 <> r2. -red in |- *; intros; elim H; apply Rminus_diag_eq; auto. +Proof. + red in |- *; intros; elim H; apply Rminus_diag_eq; auto. Qed. Hint Resolve Rminus_not_eq: real. Lemma Rminus_not_eq_right : forall r1 r2, r2 - r1 <> 0 -> r1 <> r2. -red in |- *; intros; elim H; rewrite H0; ring. +Proof. + red in |- *; intros; elim H; rewrite H0; ring. Qed. Hint Resolve Rminus_not_eq_right: real. (**********) Lemma Rmult_minus_distr_l : - forall r1 r2 r3, r1 * (r2 - r3) = r1 * r2 - r1 * r3. -intros; ring. + forall r1 r2 r3, r1 * (r2 - r3) = r1 * r2 - r1 * r3. +Proof. + intros; ring. Qed. -(** Inverse *) +(** ** Inverse *) Lemma Rinv_1 : / 1 = 1. -field; auto with real. +Proof. + field. Qed. Hint Resolve Rinv_1: real. (*********) Lemma Rinv_neq_0_compat : forall r, r <> 0 -> / r <> 0. -red in |- *; intros; apply R1_neq_R0. -replace 1 with (/ r * r); auto with real. +Proof. + red in |- *; intros; apply R1_neq_R0. + replace 1 with (/ r * r); auto with real. Qed. Hint Resolve Rinv_neq_0_compat: real. (*********) Lemma Rinv_involutive : forall r, r <> 0 -> / / r = r. -intros; field; auto with real. +Proof. + intros; field; trivial. Qed. Hint Resolve Rinv_involutive: real. (*********) Lemma Rinv_mult_distr : - forall r1 r2, r1 <> 0 -> r2 <> 0 -> / (r1 * r2) = / r1 * / r2. -intros; field; auto with real. + forall r1 r2, r1 <> 0 -> r2 <> 0 -> / (r1 * r2) = / r1 * / r2. +Proof. + intros; field; auto. Qed. (*********) Lemma Ropp_inv_permute : forall r, r <> 0 -> - / r = / - r. -intros; field; auto with real. +Proof. + intros; field; trivial. Qed. Lemma Rinv_r_simpl_r : forall r1 r2, r1 <> 0 -> r1 * / r1 * r2 = r2. -intros; transitivity (1 * r2); auto with real. -rewrite Rinv_r; auto with real. +Proof. + intros; transitivity (1 * r2); auto with real. + rewrite Rinv_r; auto with real. Qed. Lemma Rinv_r_simpl_l : forall r1 r2, r1 <> 0 -> r2 * r1 * / r1 = r2. -intros; transitivity (r2 * 1); auto with real. -transitivity (r2 * (r1 * / r1)); auto with real. +Proof. + intros; transitivity (r2 * 1); auto with real. + transitivity (r2 * (r1 * / r1)); auto with real. Qed. Lemma Rinv_r_simpl_m : forall r1 r2, r1 <> 0 -> r1 * r2 * / r1 = r2. -intros; transitivity (r2 * 1); auto with real. -transitivity (r2 * (r1 * / r1)); auto with real. -ring. +Proof. + intros; transitivity (r2 * 1); auto with real. + transitivity (r2 * (r1 * / r1)); auto with real. + ring. Qed. Hint Resolve Rinv_r_simpl_l Rinv_r_simpl_r Rinv_r_simpl_m: real. (*********) Lemma Rinv_mult_simpl : - forall r1 r2 r3, r1 <> 0 -> r1 * / r2 * (r3 * / r1) = r3 * / r2. -intros a b c; intros. -transitivity (a * / a * (c * / b)); auto with real. -ring. + forall r1 r2 r3, r1 <> 0 -> r1 * / r2 * (r3 * / r1) = r3 * / r2. +Proof. + intros a b c; intros. + transitivity (a * / a * (c * / b)); auto with real. + ring. Qed. -(** Order and addition *) +(** * Field operations and order *) + +(** ** Order and addition *) Lemma Rplus_lt_compat_r : forall r r1 r2, r1 < r2 -> r1 + r < r2 + r. -intros. -rewrite (Rplus_comm r1 r); rewrite (Rplus_comm r2 r); auto with real. +Proof. + intros. + rewrite (Rplus_comm r1 r); rewrite (Rplus_comm r2 r); auto with real. Qed. Hint Resolve Rplus_lt_compat_r: real. (**********) Lemma Rplus_lt_reg_r : forall r r1 r2, r + r1 < r + r2 -> r1 < r2. -intros; cut (- r + r + r1 < - r + r + r2). -rewrite Rplus_opp_l. -elim (Rplus_ne r1); elim (Rplus_ne r2); intros; rewrite <- H3; rewrite <- H1; - auto with zarith real. -rewrite Rplus_assoc; rewrite Rplus_assoc; - apply (Rplus_lt_compat_l (- r) (r + r1) (r + r2) H). +Proof. + intros; cut (- r + r + r1 < - r + r + r2). + rewrite Rplus_opp_l. + elim (Rplus_ne r1); elim (Rplus_ne r2); intros; rewrite <- H3; rewrite <- H1; + auto with zarith real. + rewrite Rplus_assoc; rewrite Rplus_assoc; + apply (Rplus_lt_compat_l (- r) (r + r1) (r + r2) H). Qed. (**********) Lemma Rplus_le_compat_l : forall r r1 r2, r1 <= r2 -> r + r1 <= r + r2. -unfold Rle in |- *; intros; elim H; intro. -left; apply (Rplus_lt_compat_l r r1 r2 H0). -right; rewrite <- H0; auto with zarith real. +Proof. + unfold Rle in |- *; intros; elim H; intro. + left; apply (Rplus_lt_compat_l r r1 r2 H0). + right; rewrite <- H0; auto with zarith real. Qed. (**********) Lemma Rplus_le_compat_r : forall r r1 r2, r1 <= r2 -> r1 + r <= r2 + r. -unfold Rle in |- *; intros; elim H; intro. -left; apply (Rplus_lt_compat_r r r1 r2 H0). -right; rewrite <- H0; auto with real. +Proof. + unfold Rle in |- *; intros; elim H; intro. + left; apply (Rplus_lt_compat_r r r1 r2 H0). + right; rewrite <- H0; auto with real. Qed. Hint Resolve Rplus_le_compat_l Rplus_le_compat_r: real. (**********) Lemma Rplus_le_reg_l : forall r r1 r2, r + r1 <= r + r2 -> r1 <= r2. -unfold Rle in |- *; intros; elim H; intro. -left; apply (Rplus_lt_reg_r r r1 r2 H0). -right; apply (Rplus_eq_reg_l r r1 r2 H0). +Proof. + unfold Rle in |- *; intros; elim H; intro. + left; apply (Rplus_lt_reg_r r r1 r2 H0). + right; apply (Rplus_eq_reg_l r r1 r2 H0). Qed. (**********) Lemma sum_inequa_Rle_lt : - forall a x b c y d:R, - a <= x -> x < b -> c < y -> y <= d -> a + c < x + y < b + d. -intros; split. -apply Rlt_le_trans with (a + y); auto with real. -apply Rlt_le_trans with (b + y); auto with real. + forall a x b c y d:R, + a <= x -> x < b -> c < y -> y <= d -> a + c < x + y < b + d. +Proof. + intros; split. + apply Rlt_le_trans with (a + y); auto with real. + apply Rlt_le_trans with (b + y); auto with real. Qed. (*********) Lemma Rplus_lt_compat : - forall r1 r2 r3 r4, r1 < r2 -> r3 < r4 -> r1 + r3 < r2 + r4. -intros; apply Rlt_trans with (r2 + r3); auto with real. + forall r1 r2 r3 r4, r1 < r2 -> r3 < r4 -> r1 + r3 < r2 + r4. +Proof. + intros; apply Rlt_trans with (r2 + r3); auto with real. Qed. Lemma Rplus_le_compat : - forall r1 r2 r3 r4, r1 <= r2 -> r3 <= r4 -> r1 + r3 <= r2 + r4. -intros; apply Rle_trans with (r2 + r3); auto with real. + forall r1 r2 r3 r4, r1 <= r2 -> r3 <= r4 -> r1 + r3 <= r2 + r4. +Proof. + intros; apply Rle_trans with (r2 + r3); auto with real. Qed. (*********) Lemma Rplus_lt_le_compat : - forall r1 r2 r3 r4, r1 < r2 -> r3 <= r4 -> r1 + r3 < r2 + r4. -intros; apply Rlt_le_trans with (r2 + r3); auto with real. + forall r1 r2 r3 r4, r1 < r2 -> r3 <= r4 -> r1 + r3 < r2 + r4. +Proof. + intros; apply Rlt_le_trans with (r2 + r3); auto with real. Qed. (*********) Lemma Rplus_le_lt_compat : - forall r1 r2 r3 r4, r1 <= r2 -> r3 < r4 -> r1 + r3 < r2 + r4. -intros; apply Rle_lt_trans with (r2 + r3); auto with real. + forall r1 r2 r3 r4, r1 <= r2 -> r3 < r4 -> r1 + r3 < r2 + r4. +Proof. + intros; apply Rle_lt_trans with (r2 + r3); auto with real. Qed. Hint Immediate Rplus_lt_compat Rplus_le_compat Rplus_lt_le_compat Rplus_le_lt_compat: real. -(** Order and Opposite *) +(** ** Order and Opposite *) (**********) Lemma Ropp_gt_lt_contravar : forall r1 r2, r1 > r2 -> - r1 < - r2. -unfold Rgt in |- *; intros. -apply (Rplus_lt_reg_r (r2 + r1)). -replace (r2 + r1 + - r1) with r2. -replace (r2 + r1 + - r2) with r1. -trivial. -ring. -ring. +Proof. + unfold Rgt in |- *; intros. + apply (Rplus_lt_reg_r (r2 + r1)). + replace (r2 + r1 + - r1) with r2. + replace (r2 + r1 + - r2) with r1. + trivial. + ring. + ring. Qed. Hint Resolve Ropp_gt_lt_contravar. (**********) Lemma Ropp_lt_gt_contravar : forall r1 r2, r1 < r2 -> - r1 > - r2. -unfold Rgt in |- *; auto with real. +Proof. + unfold Rgt in |- *; auto with real. Qed. Hint Resolve Ropp_lt_gt_contravar: real. Lemma Ropp_lt_cancel : forall r1 r2, - r2 < - r1 -> r1 < r2. -intros x y H'. -rewrite <- (Ropp_involutive x); rewrite <- (Ropp_involutive y); - auto with real. +Proof. + intros x y H'. + rewrite <- (Ropp_involutive x); rewrite <- (Ropp_involutive y); + auto with real. Qed. Hint Immediate Ropp_lt_cancel: real. Lemma Ropp_lt_contravar : forall r1 r2, r2 < r1 -> - r1 < - r2. -auto with real. +Proof. + auto with real. Qed. Hint Resolve Ropp_lt_contravar: real. (**********) Lemma Ropp_le_ge_contravar : forall r1 r2, r1 <= r2 -> - r1 >= - r2. -unfold Rge in |- *; intros r1 r2 [H| H]; auto with real. +Proof. + unfold Rge in |- *; intros r1 r2 [H| H]; auto with real. Qed. Hint Resolve Ropp_le_ge_contravar: real. Lemma Ropp_le_cancel : forall r1 r2, - r2 <= - r1 -> r1 <= r2. -intros x y H. -elim H; auto with real. -intro H1; rewrite <- (Ropp_involutive x); rewrite <- (Ropp_involutive y); - rewrite H1; auto with real. +Proof. + intros x y H. + elim H; auto with real. + intro H1; rewrite <- (Ropp_involutive x); rewrite <- (Ropp_involutive y); + rewrite H1; auto with real. Qed. Hint Immediate Ropp_le_cancel: real. Lemma Ropp_le_contravar : forall r1 r2, r2 <= r1 -> - r1 <= - r2. -intros r1 r2 H; elim H; auto with real. +Proof. + intros r1 r2 H; elim H; auto with real. Qed. Hint Resolve Ropp_le_contravar: real. (**********) Lemma Ropp_ge_le_contravar : forall r1 r2, r1 >= r2 -> - r1 <= - r2. -unfold Rge in |- *; intros r1 r2 [H| H]; auto with real. +Proof. + unfold Rge in |- *; intros r1 r2 [H| H]; auto with real. Qed. Hint Resolve Ropp_ge_le_contravar: real. (**********) Lemma Ropp_0_lt_gt_contravar : forall r, 0 < r -> 0 > - r. -intros; replace 0 with (-0); auto with real. +Proof. + intros; replace 0 with (-0); auto with real. Qed. Hint Resolve Ropp_0_lt_gt_contravar: real. (**********) Lemma Ropp_0_gt_lt_contravar : forall r, 0 > r -> 0 < - r. -intros; replace 0 with (-0); auto with real. +Proof. + intros; replace 0 with (-0); auto with real. Qed. Hint Resolve Ropp_0_gt_lt_contravar: real. (**********) Lemma Ropp_lt_gt_0_contravar : forall r, r > 0 -> - r < 0. -intros; rewrite <- Ropp_0; auto with real. +Proof. + intros; rewrite <- Ropp_0; auto with real. Qed. (**********) Lemma Ropp_gt_lt_0_contravar : forall r, r < 0 -> - r > 0. -intros; rewrite <- Ropp_0; auto with real. +Proof. + intros; rewrite <- Ropp_0; auto with real. Qed. Hint Resolve Ropp_lt_gt_0_contravar Ropp_gt_lt_0_contravar: real. (**********) Lemma Ropp_0_le_ge_contravar : forall r, 0 <= r -> 0 >= - r. -intros; replace 0 with (-0); auto with real. +Proof. + intros; replace 0 with (-0); auto with real. Qed. Hint Resolve Ropp_0_le_ge_contravar: real. (**********) Lemma Ropp_0_ge_le_contravar : forall r, 0 >= r -> 0 <= - r. -intros; replace 0 with (-0); auto with real. +Proof. + intros; replace 0 with (-0); auto with real. Qed. Hint Resolve Ropp_0_ge_le_contravar: real. -(** Order and multiplication *) +(** ** Order and multiplication *) Lemma Rmult_lt_compat_r : forall r r1 r2, 0 < r -> r1 < r2 -> r1 * r < r2 * r. -intros; rewrite (Rmult_comm r1 r); rewrite (Rmult_comm r2 r); auto with real. +Proof. + intros; rewrite (Rmult_comm r1 r); rewrite (Rmult_comm r2 r); auto with real. Qed. Hint Resolve Rmult_lt_compat_r. Lemma Rmult_lt_reg_l : forall r r1 r2, 0 < r -> r * r1 < r * r2 -> r1 < r2. -intros z x y H H0. -case (Rtotal_order x y); intros Eq0; auto; elim Eq0; clear Eq0; intros Eq0. - rewrite Eq0 in H0; elimtype False; apply (Rlt_irrefl (z * y)); auto. -generalize (Rmult_lt_compat_l z y x H Eq0); intro; elimtype False; - generalize (Rlt_trans (z * x) (z * y) (z * x) H0 H1); - intro; apply (Rlt_irrefl (z * x)); auto. +Proof. + intros z x y H H0. + case (Rtotal_order x y); intros Eq0; auto; elim Eq0; clear Eq0; intros Eq0. + rewrite Eq0 in H0; elimtype False; apply (Rlt_irrefl (z * y)); auto. + generalize (Rmult_lt_compat_l z y x H Eq0); intro; elimtype False; + generalize (Rlt_trans (z * x) (z * y) (z * x) H0 H1); + intro; apply (Rlt_irrefl (z * x)); auto. Qed. Lemma Rmult_lt_gt_compat_neg_l : - forall r r1 r2, r < 0 -> r1 < r2 -> r * r1 > r * r2. -intros; replace r with (- - r); auto with real. -rewrite (Ropp_mult_distr_l_reverse (- r)); - rewrite (Ropp_mult_distr_l_reverse (- r)). -apply Ropp_lt_gt_contravar; auto with real. + forall r r1 r2, r < 0 -> r1 < r2 -> r * r1 > r * r2. +Proof. + intros; replace r with (- - r); auto with real. + rewrite (Ropp_mult_distr_l_reverse (- r)); + rewrite (Ropp_mult_distr_l_reverse (- r)). + apply Ropp_lt_gt_contravar; auto with real. Qed. (**********) Lemma Rmult_le_compat_l : - forall r r1 r2, 0 <= r -> r1 <= r2 -> r * r1 <= r * r2. -intros r r1 r2 H H0; destruct H; destruct H0; unfold Rle in |- *; - auto with real. -right; rewrite <- H; do 2 rewrite Rmult_0_l; reflexivity. + forall r r1 r2, 0 <= r -> r1 <= r2 -> r * r1 <= r * r2. +Proof. + intros r r1 r2 H H0; destruct H; destruct H0; unfold Rle in |- *; + auto with real. + right; rewrite <- H; do 2 rewrite Rmult_0_l; reflexivity. Qed. Hint Resolve Rmult_le_compat_l: real. Lemma Rmult_le_compat_r : - forall r r1 r2, 0 <= r -> r1 <= r2 -> r1 * r <= r2 * r. -intros r r1 r2 H; rewrite (Rmult_comm r1 r); rewrite (Rmult_comm r2 r); - auto with real. + forall r r1 r2, 0 <= r -> r1 <= r2 -> r1 * r <= r2 * r. +Proof. + intros r r1 r2 H; rewrite (Rmult_comm r1 r); rewrite (Rmult_comm r2 r); + auto with real. Qed. Hint Resolve Rmult_le_compat_r: real. Lemma Rmult_le_reg_l : forall r r1 r2, 0 < r -> r * r1 <= r * r2 -> r1 <= r2. -intros z x y H H0; case H0; auto with real. -intros H1; apply Rlt_le. -apply Rmult_lt_reg_l with (r := z); auto. -intros H1; replace x with (/ z * (z * x)); auto with real. -replace y with (/ z * (z * y)). - rewrite H1; auto with real. -rewrite <- Rmult_assoc; rewrite Rinv_l; auto with real. -rewrite <- Rmult_assoc; rewrite Rinv_l; auto with real. +Proof. + intros z x y H H0; case H0; auto with real. + intros H1; apply Rlt_le. + apply Rmult_lt_reg_l with (r := z); auto. + intros H1; replace x with (/ z * (z * x)); auto with real. + replace y with (/ z * (z * y)). + rewrite H1; auto with real. + rewrite <- Rmult_assoc; rewrite Rinv_l; auto with real. + rewrite <- Rmult_assoc; rewrite Rinv_l; auto with real. Qed. Lemma Rmult_le_compat_neg_l : - forall r r1 r2, r <= 0 -> r1 <= r2 -> r * r2 <= r * r1. -intros; replace r with (- - r); auto with real. -do 2 rewrite (Ropp_mult_distr_l_reverse (- r)). -apply Ropp_le_contravar; auto with real. + forall r r1 r2, r <= 0 -> r1 <= r2 -> r * r2 <= r * r1. +Proof. + intros; replace r with (- - r); auto with real. + do 2 rewrite (Ropp_mult_distr_l_reverse (- r)). + apply Ropp_le_contravar; auto with real. Qed. Hint Resolve Rmult_le_compat_neg_l: real. Lemma Rmult_le_ge_compat_neg_l : - forall r r1 r2, r <= 0 -> r1 <= r2 -> r * r1 >= r * r2. -intros; apply Rle_ge; auto with real. + forall r r1 r2, r <= 0 -> r1 <= r2 -> r * r1 >= r * r2. +Proof. + intros; apply Rle_ge; auto with real. Qed. Hint Resolve Rmult_le_ge_compat_neg_l: real. Lemma Rmult_le_compat : - forall r1 r2 r3 r4, - 0 <= r1 -> 0 <= r3 -> r1 <= r2 -> r3 <= r4 -> r1 * r3 <= r2 * r4. -intros x y z t H' H'0 H'1 H'2. -apply Rle_trans with (r2 := x * t); auto with real. -repeat rewrite (fun x => Rmult_comm x t). -apply Rmult_le_compat_l; auto. -apply Rle_trans with z; auto. + forall r1 r2 r3 r4, + 0 <= r1 -> 0 <= r3 -> r1 <= r2 -> r3 <= r4 -> r1 * r3 <= r2 * r4. +Proof. + intros x y z t H' H'0 H'1 H'2. + apply Rle_trans with (r2 := x * t); auto with real. + repeat rewrite (fun x => Rmult_comm x t). + apply Rmult_le_compat_l; auto. + apply Rle_trans with z; auto. Qed. Hint Resolve Rmult_le_compat: real. Lemma Rmult_gt_0_lt_compat : - forall r1 r2 r3 r4, - r3 > 0 -> r2 > 0 -> r1 < r2 -> r3 < r4 -> r1 * r3 < r2 * r4. -intros; apply Rlt_trans with (r2 * r3); auto with real. + forall r1 r2 r3 r4, + r3 > 0 -> r2 > 0 -> r1 < r2 -> r3 < r4 -> r1 * r3 < r2 * r4. +Proof. + intros; apply Rlt_trans with (r2 * r3); auto with real. Qed. (*********) Lemma Rmult_ge_0_gt_0_lt_compat : - forall r1 r2 r3 r4, - r3 >= 0 -> r2 > 0 -> r1 < r2 -> r3 < r4 -> r1 * r3 < r2 * r4. -intros; apply Rle_lt_trans with (r2 * r3); auto with real. + forall r1 r2 r3 r4, + r3 >= 0 -> r2 > 0 -> r1 < r2 -> r3 < r4 -> r1 * r3 < r2 * r4. +Proof. + intros; apply Rle_lt_trans with (r2 * r3); auto with real. Qed. -(** Order and Substractions *) + +(** ** Order and Substractions *) + Lemma Rlt_minus : forall r1 r2, r1 < r2 -> r1 - r2 < 0. -intros; apply (Rplus_lt_reg_r r2). -replace (r2 + (r1 - r2)) with r1. -replace (r2 + 0) with r2; auto with real. -ring. +Proof. + intros; apply (Rplus_lt_reg_r r2). + replace (r2 + (r1 - r2)) with r1. + replace (r2 + 0) with r2; auto with real. + ring. Qed. Hint Resolve Rlt_minus: real. (**********) Lemma Rle_minus : forall r1 r2, r1 <= r2 -> r1 - r2 <= 0. -destruct 1; unfold Rle in |- *; auto with real. +Proof. + destruct 1; unfold Rle in |- *; auto with real. Qed. (**********) Lemma Rminus_lt : forall r1 r2, r1 - r2 < 0 -> r1 < r2. -intros; replace r1 with (r1 - r2 + r2). -pattern r2 at 3 in |- *; replace r2 with (0 + r2); auto with real. -ring. +Proof. + intros; replace r1 with (r1 - r2 + r2). + pattern r2 at 3 in |- *; replace r2 with (0 + r2); auto with real. + ring. Qed. (**********) Lemma Rminus_le : forall r1 r2, r1 - r2 <= 0 -> r1 <= r2. -intros; replace r1 with (r1 - r2 + r2). -pattern r2 at 3 in |- *; replace r2 with (0 + r2); auto with real. -ring. +Proof. + intros; replace r1 with (r1 - r2 + r2). + pattern r2 at 3 in |- *; replace r2 with (0 + r2); auto with real. + ring. Qed. (**********) Lemma tech_Rplus : forall r (s:R), 0 <= r -> 0 < s -> r + s <> 0. -intros; apply sym_not_eq; apply Rlt_not_eq. -rewrite Rplus_comm; replace 0 with (0 + 0); auto with real. +Proof. + intros; apply sym_not_eq; apply Rlt_not_eq. + rewrite Rplus_comm; replace 0 with (0 + 0); auto with real. Qed. Hint Immediate tech_Rplus: real. -(** Order and the square function *) + +(** ** Order and the square function *) + Lemma Rle_0_sqr : forall r, 0 <= Rsqr r. -intro; case (Rlt_le_dec r 0); unfold Rsqr in |- *; intro. -replace (r * r) with (- r * - r); auto with real. -replace 0 with (- r * 0); auto with real. -replace 0 with (0 * r); auto with real. +Proof. + intro; case (Rlt_le_dec r 0); unfold Rsqr in |- *; intro. + replace (r * r) with (- r * - r); auto with real. + replace 0 with (- r * 0); auto with real. + replace 0 with (0 * r); auto with real. Qed. (***********) Lemma Rlt_0_sqr : forall r, r <> 0 -> 0 < Rsqr r. -intros; case (Rdichotomy r 0); trivial; unfold Rsqr in |- *; intro. -replace (r * r) with (- r * - r); auto with real. -replace 0 with (- r * 0); auto with real. -replace 0 with (0 * r); auto with real. +Proof. + intros; case (Rdichotomy r 0); trivial; unfold Rsqr in |- *; intro. + replace (r * r) with (- r * - r); auto with real. + replace 0 with (- r * 0); auto with real. + replace 0 with (0 * r); auto with real. Qed. Hint Resolve Rle_0_sqr Rlt_0_sqr: real. -(** Zero is less than one *) +(** ** Zero is less than one *) Lemma Rlt_0_1 : 0 < 1. -replace 1 with (Rsqr 1); auto with real. -unfold Rsqr in |- *; auto with real. +Proof. + replace 1 with (Rsqr 1); auto with real. + unfold Rsqr in |- *; auto with real. Qed. Hint Resolve Rlt_0_1: real. Lemma Rle_0_1 : 0 <= 1. -left. -exact Rlt_0_1. +Proof. + left. + exact Rlt_0_1. Qed. -(** Order and inverse *) +(** ** Order and inverse *) Lemma Rinv_0_lt_compat : forall r, 0 < r -> 0 < / r. -intros; apply Rnot_le_lt; red in |- *; intros. -absurd (1 <= 0); auto with real. -replace 1 with (r * / r); auto with real. -replace 0 with (r * 0); auto with real. +Proof. + intros; apply Rnot_le_lt; red in |- *; intros. + absurd (1 <= 0); auto with real. + replace 1 with (r * / r); auto with real. + replace 0 with (r * 0); auto with real. Qed. Hint Resolve Rinv_0_lt_compat: real. (*********) Lemma Rinv_lt_0_compat : forall r, r < 0 -> / r < 0. -intros; apply Rnot_le_lt; red in |- *; intros. -absurd (1 <= 0); auto with real. -replace 1 with (r * / r); auto with real. -replace 0 with (r * 0); auto with real. +Proof. + intros; apply Rnot_le_lt; red in |- *; intros. + absurd (1 <= 0); auto with real. + replace 1 with (r * / r); auto with real. + replace 0 with (r * 0); auto with real. Qed. Hint Resolve Rinv_lt_0_compat: real. (*********) Lemma Rinv_lt_contravar : forall r1 r2, 0 < r1 * r2 -> r1 < r2 -> / r2 < / r1. -intros; apply Rmult_lt_reg_l with (r1 * r2); auto with real. -case (Rmult_neq_0_reg r1 r2); intros; auto with real. -replace (r1 * r2 * / r2) with r1. -replace (r1 * r2 * / r1) with r2; trivial. -symmetry in |- *; auto with real. -symmetry in |- *; auto with real. +Proof. + intros; apply Rmult_lt_reg_l with (r1 * r2); auto with real. + case (Rmult_neq_0_reg r1 r2); intros; auto with real. + replace (r1 * r2 * / r2) with r1. + replace (r1 * r2 * / r1) with r2; trivial. + symmetry in |- *; auto with real. + symmetry in |- *; auto with real. Qed. Lemma Rinv_1_lt_contravar : forall r1 r2, 1 <= r1 -> r1 < r2 -> / r2 < / r1. -intros x y H' H'0. -cut (0 < x); [ intros Lt0 | apply Rlt_le_trans with (r2 := 1) ]; - auto with real. -apply Rmult_lt_reg_l with (r := x); auto with real. -rewrite (Rmult_comm x (/ x)); rewrite Rinv_l; auto with real. -apply Rmult_lt_reg_l with (r := y); auto with real. -apply Rlt_trans with (r2 := x); auto. -cut (y * (x * / y) = x). -intro H1; rewrite H1; rewrite (Rmult_1_r y); auto. -rewrite (Rmult_comm x); rewrite <- Rmult_assoc; rewrite (Rmult_comm y (/ y)); - rewrite Rinv_l; auto with real. -apply Rlt_dichotomy_converse; right. -red in |- *; apply Rlt_trans with (r2 := x); auto with real. +Proof. + intros x y H' H'0. + cut (0 < x); [ intros Lt0 | apply Rlt_le_trans with (r2 := 1) ]; + auto with real. + apply Rmult_lt_reg_l with (r := x); auto with real. + rewrite (Rmult_comm x (/ x)); rewrite Rinv_l; auto with real. + apply Rmult_lt_reg_l with (r := y); auto with real. + apply Rlt_trans with (r2 := x); auto. + cut (y * (x * / y) = x). + intro H1; rewrite H1; rewrite (Rmult_1_r y); auto. + rewrite (Rmult_comm x); rewrite <- Rmult_assoc; rewrite (Rmult_comm y (/ y)); + rewrite Rinv_l; auto with real. + apply Rlt_dichotomy_converse; right. + red in |- *; apply Rlt_trans with (r2 := x); auto with real. Qed. Hint Resolve Rinv_1_lt_contravar: real. -(*********************************************************) -(** Greater *) -(*********************************************************) +(********************************************************) +(** * Greater *) +(********************************************************) (**********) Lemma Rge_antisym : forall r1 r2, r1 >= r2 -> r2 >= r1 -> r1 = r2. -intros; apply Rle_antisym; auto with real. +Proof. + intros; apply Rle_antisym; auto with real. Qed. (**********) Lemma Rnot_lt_ge : forall r1 r2, ~ r1 < r2 -> r1 >= r2. -intros; unfold Rge in |- *; elim (Rtotal_order r1 r2); intro. -absurd (r1 < r2); trivial. -case H0; auto. +Proof. + intros; unfold Rge in |- *; elim (Rtotal_order r1 r2); intro. + absurd (r1 < r2); trivial. + case H0; auto. Qed. (**********) Lemma Rnot_lt_le : forall r1 r2, ~ r1 < r2 -> r2 <= r1. -intros; apply Rge_le; apply Rnot_lt_ge; assumption. +Proof. + intros; apply Rge_le; apply Rnot_lt_ge; assumption. Qed. (**********) Lemma Rnot_gt_le : forall r1 r2, ~ r1 > r2 -> r1 <= r2. -intros r1 r2 H; apply Rge_le. -exact (Rnot_lt_ge r2 r1 H). +Proof. + intros r1 r2 H; apply Rge_le. + exact (Rnot_lt_ge r2 r1 H). Qed. (**********) Lemma Rgt_ge : forall r1 r2, r1 > r2 -> r1 >= r2. -red in |- *; auto with real. +Proof. + red in |- *; auto with real. Qed. (**********) Lemma Rge_gt_trans : forall r1 r2 r3, r1 >= r2 -> r2 > r3 -> r1 > r3. -unfold Rgt in |- *; intros; apply Rlt_le_trans with r2; auto with real. +Proof. + unfold Rgt in |- *; intros; apply Rlt_le_trans with r2; auto with real. Qed. (**********) Lemma Rgt_ge_trans : forall r1 r2 r3, r1 > r2 -> r2 >= r3 -> r1 > r3. -unfold Rgt in |- *; intros; apply Rle_lt_trans with r2; auto with real. +Proof. + unfold Rgt in |- *; intros; apply Rle_lt_trans with r2; auto with real. Qed. (**********) Lemma Rgt_trans : forall r1 r2 r3, r1 > r2 -> r2 > r3 -> r1 > r3. -unfold Rgt in |- *; intros; apply Rlt_trans with r2; auto with real. +Proof. + unfold Rgt in |- *; intros; apply Rlt_trans with r2; auto with real. Qed. (**********) Lemma Rge_trans : forall r1 r2 r3, r1 >= r2 -> r2 >= r3 -> r1 >= r3. -intros; apply Rle_ge. -apply Rle_trans with r2; auto with real. +Proof. + intros; apply Rle_ge. + apply Rle_trans with r2; auto with real. Qed. (**********) Lemma Rle_lt_0_plus_1 : forall r, 0 <= r -> 0 < r + 1. -intros. -apply Rlt_le_trans with 1; auto with real. -pattern 1 at 1 in |- *; replace 1 with (0 + 1); auto with real. +Proof. + intros. + apply Rlt_le_trans with 1; auto with real. + pattern 1 at 1 in |- *; replace 1 with (0 + 1); auto with real. Qed. Hint Resolve Rle_lt_0_plus_1: real. (**********) Lemma Rlt_plus_1 : forall r, r < r + 1. -intros. -pattern r at 1 in |- *; replace r with (r + 0); auto with real. +Proof. + intros. + pattern r at 1 in |- *; replace r with (r + 0); auto with real. Qed. Hint Resolve Rlt_plus_1: real. (**********) Lemma tech_Rgt_minus : forall r1 r2, 0 < r2 -> r1 > r1 - r2. -red in |- *; unfold Rminus in |- *; intros. -pattern r1 at 2 in |- *; replace r1 with (r1 + 0); auto with real. +Proof. + red in |- *; unfold Rminus in |- *; intros. + pattern r1 at 2 in |- *; replace r1 with (r1 + 0); auto with real. Qed. (***********) Lemma Rplus_gt_compat_l : forall r r1 r2, r1 > r2 -> r + r1 > r + r2. -unfold Rgt in |- *; auto with real. +Proof. + unfold Rgt in |- *; auto with real. Qed. Hint Resolve Rplus_gt_compat_l: real. (***********) Lemma Rplus_gt_reg_l : forall r r1 r2, r + r1 > r + r2 -> r1 > r2. -unfold Rgt in |- *; intros; apply (Rplus_lt_reg_r r r2 r1 H). +Proof. + unfold Rgt in |- *; intros; apply (Rplus_lt_reg_r r r2 r1 H). Qed. (***********) Lemma Rplus_ge_compat_l : forall r r1 r2, r1 >= r2 -> r + r1 >= r + r2. -intros; apply Rle_ge; auto with real. +Proof. + intros; apply Rle_ge; auto with real. Qed. Hint Resolve Rplus_ge_compat_l: real. (***********) Lemma Rplus_ge_reg_l : forall r r1 r2, r + r1 >= r + r2 -> r1 >= r2. -intros; apply Rle_ge; apply Rplus_le_reg_l with r; auto with real. +Proof. + intros; apply Rle_ge; apply Rplus_le_reg_l with r; auto with real. Qed. (***********) Lemma Rmult_ge_compat_r : - forall r r1 r2, r >= 0 -> r1 >= r2 -> r1 * r >= r2 * r. -intros; apply Rle_ge; apply Rmult_le_compat_r; apply Rge_le; assumption. + forall r r1 r2, r >= 0 -> r1 >= r2 -> r1 * r >= r2 * r. +Proof. + intros; apply Rle_ge; apply Rmult_le_compat_r; apply Rge_le; assumption. Qed. (***********) Lemma Rgt_minus : forall r1 r2, r1 > r2 -> r1 - r2 > 0. -intros; replace 0 with (r2 - r2); auto with real. -unfold Rgt, Rminus in |- *; auto with real. +Proof. + intros; replace 0 with (r2 - r2); auto with real. + unfold Rgt, Rminus in |- *; auto with real. Qed. (*********) Lemma minus_Rgt : forall r1 r2, r1 - r2 > 0 -> r1 > r2. -intros; replace r2 with (r2 + 0); auto with real. -intros; replace r1 with (r2 + (r1 - r2)); auto with real. +Proof. + intros; replace r2 with (r2 + 0); auto with real. + intros; replace r1 with (r2 + (r1 - r2)); auto with real. Qed. (**********) Lemma Rge_minus : forall r1 r2, r1 >= r2 -> r1 - r2 >= 0. -unfold Rge in |- *; intros; elim H; intro. -left; apply (Rgt_minus r1 r2 H0). -right; apply (Rminus_diag_eq r1 r2 H0). +Proof. + unfold Rge in |- *; intros; elim H; intro. + left; apply (Rgt_minus r1 r2 H0). + right; apply (Rminus_diag_eq r1 r2 H0). Qed. (*********) Lemma minus_Rge : forall r1 r2, r1 - r2 >= 0 -> r1 >= r2. -intros; replace r2 with (r2 + 0); auto with real. -intros; replace r1 with (r2 + (r1 - r2)); auto with real. +Proof. + intros; replace r2 with (r2 + 0); auto with real. + intros; replace r1 with (r2 + (r1 - r2)); auto with real. Qed. (*********) Lemma Rmult_gt_0_compat : forall r1 r2, r1 > 0 -> r2 > 0 -> r1 * r2 > 0. -unfold Rgt in |- *; intros. -replace 0 with (0 * r2); auto with real. +Proof. + unfold Rgt in |- *; intros. + replace 0 with (0 * r2); auto with real. Qed. (*********) @@ -1119,377 +1260,421 @@ Proof Rmult_gt_0_compat. (***********) Lemma Rplus_eq_0_l : - forall r1 r2, 0 <= r1 -> 0 <= r2 -> r1 + r2 = 0 -> r1 = 0. -intros a b [H| H] H0 H1; auto with real. -absurd (0 < a + b). -rewrite H1; auto with real. -replace 0 with (0 + 0); auto with real. + forall r1 r2, 0 <= r1 -> 0 <= r2 -> r1 + r2 = 0 -> r1 = 0. +Proof. + intros a b [H| H] H0 H1; auto with real. + absurd (0 < a + b). + rewrite H1; auto with real. + replace 0 with (0 + 0); auto with real. Qed. Lemma Rplus_eq_R0 : - forall r1 r2, 0 <= r1 -> 0 <= r2 -> r1 + r2 = 0 -> r1 = 0 /\ r2 = 0. -intros a b; split. -apply Rplus_eq_0_l with b; auto with real. -apply Rplus_eq_0_l with a; auto with real. -rewrite Rplus_comm; auto with real. + forall r1 r2, 0 <= r1 -> 0 <= r2 -> r1 + r2 = 0 -> r1 = 0 /\ r2 = 0. +Proof. + intros a b; split. + apply Rplus_eq_0_l with b; auto with real. + apply Rplus_eq_0_l with a; auto with real. + rewrite Rplus_comm; auto with real. Qed. (***********) Lemma Rplus_sqr_eq_0_l : forall r1 r2, Rsqr r1 + Rsqr r2 = 0 -> r1 = 0. -intros a b; intros; apply Rsqr_0_uniq; apply Rplus_eq_0_l with (Rsqr b); - auto with real. +Proof. + intros a b; intros; apply Rsqr_0_uniq; apply Rplus_eq_0_l with (Rsqr b); + auto with real. Qed. Lemma Rplus_sqr_eq_0 : - forall r1 r2, Rsqr r1 + Rsqr r2 = 0 -> r1 = 0 /\ r2 = 0. -intros a b; split. -apply Rplus_sqr_eq_0_l with b; auto with real. -apply Rplus_sqr_eq_0_l with a; auto with real. -rewrite Rplus_comm; auto with real. + forall r1 r2, Rsqr r1 + Rsqr r2 = 0 -> r1 = 0 /\ r2 = 0. +Proof. + intros a b; split. + apply Rplus_sqr_eq_0_l with b; auto with real. + apply Rplus_sqr_eq_0_l with a; auto with real. + rewrite Rplus_comm; auto with real. Qed. (**********************************************************) -(** Injection from [N] to [R] *) +(** * Injection from [N] to [R] *) (**********************************************************) (**********) Lemma S_INR : forall n:nat, INR (S n) = INR n + 1. -intro; case n; auto with real. +Proof. + intro; case n; auto with real. Qed. (**********) Lemma S_O_plus_INR : forall n:nat, INR (1 + n) = INR 1 + INR n. -intro; simpl in |- *; case n; intros; auto with real. +Proof. + intro; simpl in |- *; case n; intros; auto with real. Qed. (**********) Lemma plus_INR : forall n m:nat, INR (n + m) = INR n + INR m. -intros n m; induction n as [| n Hrecn]. -simpl in |- *; auto with real. -replace (S n + m)%nat with (S (n + m)); auto with arith. -repeat rewrite S_INR. -rewrite Hrecn; ring. +Proof. + intros n m; induction n as [| n Hrecn]. + simpl in |- *; auto with real. + replace (S n + m)%nat with (S (n + m)); auto with arith. + repeat rewrite S_INR. + rewrite Hrecn; ring. Qed. (**********) Lemma minus_INR : forall n m:nat, (m <= n)%nat -> INR (n - m) = INR n - INR m. -intros n m le; pattern m, n in |- *; apply le_elim_rel; auto with real. -intros; rewrite <- minus_n_O; auto with real. -intros; repeat rewrite S_INR; simpl in |- *. -rewrite H0; ring. +Proof. + intros n m le; pattern m, n in |- *; apply le_elim_rel; auto with real. + intros; rewrite <- minus_n_O; auto with real. + intros; repeat rewrite S_INR; simpl in |- *. + rewrite H0; ring. Qed. (*********) Lemma mult_INR : forall n m:nat, INR (n * m) = INR n * INR m. -intros n m; induction n as [| n Hrecn]. -simpl in |- *; auto with real. -intros; repeat rewrite S_INR; simpl in |- *. -rewrite plus_INR; rewrite Hrecn; ring. +Proof. + intros n m; induction n as [| n Hrecn]. + simpl in |- *; auto with real. + intros; repeat rewrite S_INR; simpl in |- *. + rewrite plus_INR; rewrite Hrecn; ring. Qed. Hint Resolve plus_INR minus_INR mult_INR: real. (*********) Lemma lt_INR_0 : forall n:nat, (0 < n)%nat -> 0 < INR n. -simple induction 1; intros; auto with real. -rewrite S_INR; auto with real. +Proof. + simple induction 1; intros; auto with real. + rewrite S_INR; auto with real. Qed. Hint Resolve lt_INR_0: real. Lemma lt_INR : forall n m:nat, (n < m)%nat -> INR n < INR m. -simple induction 1; intros; auto with real. -rewrite S_INR; auto with real. -rewrite S_INR; apply Rlt_trans with (INR m0); auto with real. +Proof. + simple induction 1; intros; auto with real. + rewrite S_INR; auto with real. + rewrite S_INR; apply Rlt_trans with (INR m0); auto with real. Qed. Hint Resolve lt_INR: real. Lemma INR_lt_1 : forall n:nat, (1 < n)%nat -> 1 < INR n. -intros; replace 1 with (INR 1); auto with real. +Proof. + intros; replace 1 with (INR 1); auto with real. Qed. Hint Resolve INR_lt_1: real. (**********) Lemma INR_pos : forall p:positive, 0 < INR (nat_of_P p). -intro; apply lt_INR_0. -simpl in |- *; auto with real. -apply lt_O_nat_of_P. +Proof. + intro; apply lt_INR_0. + simpl in |- *; auto with real. + apply lt_O_nat_of_P. Qed. Hint Resolve INR_pos: real. (**********) Lemma pos_INR : forall n:nat, 0 <= INR n. -intro n; case n. -simpl in |- *; auto with real. -auto with arith real. +Proof. + intro n; case n. + simpl in |- *; auto with real. + auto with arith real. Qed. Hint Resolve pos_INR: real. Lemma INR_lt : forall n m:nat, INR n < INR m -> (n < m)%nat. -double induction n m; intros. -simpl in |- *; elimtype False; apply (Rlt_irrefl 0); auto. -auto with arith. -generalize (pos_INR (S n0)); intro; cut (INR 0 = 0); - [ intro H2; rewrite H2 in H0; idtac | simpl in |- *; trivial ]. -generalize (Rle_lt_trans 0 (INR (S n0)) 0 H1 H0); intro; elimtype False; - apply (Rlt_irrefl 0); auto. -do 2 rewrite S_INR in H1; cut (INR n1 < INR n0). -intro H2; generalize (H0 n0 H2); intro; auto with arith. -apply (Rplus_lt_reg_r 1 (INR n1) (INR n0)). -rewrite Rplus_comm; rewrite (Rplus_comm 1 (INR n0)); trivial. +Proof. + double induction n m; intros. + simpl in |- *; elimtype False; apply (Rlt_irrefl 0); auto. + auto with arith. + generalize (pos_INR (S n0)); intro; cut (INR 0 = 0); + [ intro H2; rewrite H2 in H0; idtac | simpl in |- *; trivial ]. + generalize (Rle_lt_trans 0 (INR (S n0)) 0 H1 H0); intro; elimtype False; + apply (Rlt_irrefl 0); auto. + do 2 rewrite S_INR in H1; cut (INR n1 < INR n0). + intro H2; generalize (H0 n0 H2); intro; auto with arith. + apply (Rplus_lt_reg_r 1 (INR n1) (INR n0)). + rewrite Rplus_comm; rewrite (Rplus_comm 1 (INR n0)); trivial. Qed. Hint Resolve INR_lt: real. (*********) Lemma le_INR : forall n m:nat, (n <= m)%nat -> INR n <= INR m. -simple induction 1; intros; auto with real. -rewrite S_INR. -apply Rle_trans with (INR m0); auto with real. +Proof. + simple induction 1; intros; auto with real. + rewrite S_INR. + apply Rle_trans with (INR m0); auto with real. Qed. Hint Resolve le_INR: real. (**********) Lemma not_INR_O : forall n:nat, INR n <> 0 -> n <> 0%nat. -red in |- *; intros n H H1. -apply H. -rewrite H1; trivial. +Proof. + red in |- *; intros n H H1. + apply H. + rewrite H1; trivial. Qed. Hint Immediate not_INR_O: real. (**********) Lemma not_O_INR : forall n:nat, n <> 0%nat -> INR n <> 0. -intro n; case n. -intro; absurd (0%nat = 0%nat); trivial. -intros; rewrite S_INR. -apply Rgt_not_eq; red in |- *; auto with real. +Proof. + intro n; case n. + intro; absurd (0%nat = 0%nat); trivial. + intros; rewrite S_INR. + apply Rgt_not_eq; red in |- *; auto with real. Qed. Hint Resolve not_O_INR: real. Lemma not_nm_INR : forall n m:nat, n <> m -> INR n <> INR m. -intros n m H; case (le_or_lt n m); intros H1. -case (le_lt_or_eq _ _ H1); intros H2. -apply Rlt_dichotomy_converse; auto with real. -elimtype False; auto. -apply sym_not_eq; apply Rlt_dichotomy_converse; auto with real. +Proof. + intros n m H; case (le_or_lt n m); intros H1. + case (le_lt_or_eq _ _ H1); intros H2. + apply Rlt_dichotomy_converse; auto with real. + elimtype False; auto. + apply sym_not_eq; apply Rlt_dichotomy_converse; auto with real. Qed. Hint Resolve not_nm_INR: real. Lemma INR_eq : forall n m:nat, INR n = INR m -> n = m. -intros; case (le_or_lt n m); intros H1. -case (le_lt_or_eq _ _ H1); intros H2; auto. -cut (n <> m). -intro H3; generalize (not_nm_INR n m H3); intro H4; elimtype False; auto. -omega. -symmetry in |- *; cut (m <> n). -intro H3; generalize (not_nm_INR m n H3); intro H4; elimtype False; auto. -omega. +Proof. + intros; case (le_or_lt n m); intros H1. + case (le_lt_or_eq _ _ H1); intros H2; auto. + cut (n <> m). + intro H3; generalize (not_nm_INR n m H3); intro H4; elimtype False; auto. + omega. + symmetry in |- *; cut (m <> n). + intro H3; generalize (not_nm_INR m n H3); intro H4; elimtype False; auto. + omega. Qed. Hint Resolve INR_eq: real. Lemma INR_le : forall n m:nat, INR n <= INR m -> (n <= m)%nat. -intros; elim H; intro. -generalize (INR_lt n m H0); intro; auto with arith. -generalize (INR_eq n m H0); intro; rewrite H1; auto. +Proof. + intros; elim H; intro. + generalize (INR_lt n m H0); intro; auto with arith. + generalize (INR_eq n m H0); intro; rewrite H1; auto. Qed. Hint Resolve INR_le: real. Lemma not_1_INR : forall n:nat, n <> 1%nat -> INR n <> 1. -replace 1 with (INR 1); auto with real. +Proof. + replace 1 with (INR 1); auto with real. Qed. Hint Resolve not_1_INR: real. (**********************************************************) -(** Injection from [Z] to [R] *) +(** * Injection from [Z] to [R] *) (**********************************************************) (**********) Lemma IZN : forall n:Z, (0 <= n)%Z -> exists m : nat, n = Z_of_nat m. -intros z; idtac; apply Z_of_nat_complete; assumption. +Proof. + intros z; idtac; apply Z_of_nat_complete; assumption. Qed. (**********) Lemma INR_IZR_INZ : forall n:nat, INR n = IZR (Z_of_nat n). -simple induction n; auto with real. -intros; simpl in |- *; rewrite nat_of_P_o_P_of_succ_nat_eq_succ; - auto with real. +Proof. + simple induction n; auto with real. + intros; simpl in |- *; rewrite nat_of_P_o_P_of_succ_nat_eq_succ; + auto with real. Qed. Lemma plus_IZR_NEG_POS : - forall p q:positive, IZR (Zpos p + Zneg q) = IZR (Zpos p) + IZR (Zneg q). -intros. -case (lt_eq_lt_dec (nat_of_P p) (nat_of_P q)). -intros [H| H]; simpl in |- *. -rewrite nat_of_P_lt_Lt_compare_complement_morphism; simpl in |- *; trivial. -rewrite (nat_of_P_minus_morphism q p). -rewrite minus_INR; auto with arith; ring. -apply ZC2; apply nat_of_P_lt_Lt_compare_complement_morphism; trivial. -rewrite (nat_of_P_inj p q); trivial. -rewrite Pcompare_refl; simpl in |- *; auto with real. -intro H; simpl in |- *. -rewrite nat_of_P_gt_Gt_compare_complement_morphism; simpl in |- *; - auto with arith. -rewrite (nat_of_P_minus_morphism p q). -rewrite minus_INR; auto with arith; ring. -apply ZC2; apply nat_of_P_lt_Lt_compare_complement_morphism; trivial. + forall p q:positive, IZR (Zpos p + Zneg q) = IZR (Zpos p) + IZR (Zneg q). +Proof. + intros. + case (lt_eq_lt_dec (nat_of_P p) (nat_of_P q)). + intros [H| H]; simpl in |- *. + rewrite nat_of_P_lt_Lt_compare_complement_morphism; simpl in |- *; trivial. + rewrite (nat_of_P_minus_morphism q p). + rewrite minus_INR; auto with arith; ring. + apply ZC2; apply nat_of_P_lt_Lt_compare_complement_morphism; trivial. + rewrite (nat_of_P_inj p q); trivial. + rewrite Pcompare_refl; simpl in |- *; auto with real. + intro H; simpl in |- *. + rewrite nat_of_P_gt_Gt_compare_complement_morphism; simpl in |- *; + auto with arith. + rewrite (nat_of_P_minus_morphism p q). + rewrite minus_INR; auto with arith; ring. + apply ZC2; apply nat_of_P_lt_Lt_compare_complement_morphism; trivial. Qed. (**********) Lemma plus_IZR : forall n m:Z, IZR (n + m) = IZR n + IZR m. -intro z; destruct z; intro t; destruct t; intros; auto with real. -simpl in |- *; intros; rewrite nat_of_P_plus_morphism; auto with real. -apply plus_IZR_NEG_POS. -rewrite Zplus_comm; rewrite Rplus_comm; apply plus_IZR_NEG_POS. -simpl in |- *; intros; rewrite nat_of_P_plus_morphism; rewrite plus_INR; - auto with real. +Proof. + intro z; destruct z; intro t; destruct t; intros; auto with real. + simpl in |- *; intros; rewrite nat_of_P_plus_morphism; auto with real. + apply plus_IZR_NEG_POS. + rewrite Zplus_comm; rewrite Rplus_comm; apply plus_IZR_NEG_POS. + simpl in |- *; intros; rewrite nat_of_P_plus_morphism; rewrite plus_INR; + auto with real. Qed. (**********) Lemma mult_IZR : forall n m:Z, IZR (n * m) = IZR n * IZR m. -intros z t; case z; case t; simpl in |- *; auto with real. -intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real. -intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real. -rewrite Rmult_comm. -rewrite Ropp_mult_distr_l_reverse; auto with real. -apply Ropp_eq_compat; rewrite mult_comm; auto with real. -intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real. -rewrite Ropp_mult_distr_l_reverse; auto with real. -intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real. -rewrite Rmult_opp_opp; auto with real. +Proof. + intros z t; case z; case t; simpl in |- *; auto with real. + intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real. + intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real. + rewrite Rmult_comm. + rewrite Ropp_mult_distr_l_reverse; auto with real. + apply Ropp_eq_compat; rewrite mult_comm; auto with real. + intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real. + rewrite Ropp_mult_distr_l_reverse; auto with real. + intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real. + rewrite Rmult_opp_opp; auto with real. Qed. (**********) Lemma Ropp_Ropp_IZR : forall n:Z, IZR (- n) = - IZR n. -intro z; case z; simpl in |- *; auto with real. +Proof. + intro z; case z; simpl in |- *; auto with real. Qed. (**********) Lemma Z_R_minus : forall n m:Z, IZR n - IZR m = IZR (n - m). -intros z1 z2; unfold Rminus in |- *; unfold Zminus in |- *. -rewrite <- (Ropp_Ropp_IZR z2); symmetry in |- *; apply plus_IZR. +Proof. + intros z1 z2; unfold Rminus in |- *; unfold Zminus in |- *. + rewrite <- (Ropp_Ropp_IZR z2); symmetry in |- *; apply plus_IZR. Qed. (**********) Lemma lt_O_IZR : forall n:Z, 0 < IZR n -> (0 < n)%Z. -intro z; case z; simpl in |- *; intros. -absurd (0 < 0); auto with real. -unfold Zlt in |- *; simpl in |- *; trivial. -case Rlt_not_le with (1 := H). -replace 0 with (-0); auto with real. +Proof. + intro z; case z; simpl in |- *; intros. + absurd (0 < 0); auto with real. + unfold Zlt in |- *; simpl in |- *; trivial. + case Rlt_not_le with (1 := H). + replace 0 with (-0); auto with real. Qed. (**********) Lemma lt_IZR : forall n m:Z, IZR n < IZR m -> (n < m)%Z. -intros z1 z2 H; apply Zlt_0_minus_lt. -apply lt_O_IZR. -rewrite <- Z_R_minus. -exact (Rgt_minus (IZR z2) (IZR z1) H). +Proof. + intros z1 z2 H; apply Zlt_0_minus_lt. + apply lt_O_IZR. + rewrite <- Z_R_minus. + exact (Rgt_minus (IZR z2) (IZR z1) H). Qed. (**********) Lemma eq_IZR_R0 : forall n:Z, IZR n = 0 -> n = 0%Z. -intro z; destruct z; simpl in |- *; intros; auto with zarith. -case (Rlt_not_eq 0 (INR (nat_of_P p))); auto with real. -case (Rlt_not_eq (- INR (nat_of_P p)) 0); auto with real. -apply Ropp_lt_gt_0_contravar. unfold Rgt in |- *; apply INR_pos. +Proof. + intro z; destruct z; simpl in |- *; intros; auto with zarith. + case (Rlt_not_eq 0 (INR (nat_of_P p))); auto with real. + case (Rlt_not_eq (- INR (nat_of_P p)) 0); auto with real. + apply Ropp_lt_gt_0_contravar. unfold Rgt in |- *; apply INR_pos. Qed. (**********) Lemma eq_IZR : forall n m:Z, IZR n = IZR m -> n = m. -intros z1 z2 H; generalize (Rminus_diag_eq (IZR z1) (IZR z2) H); - rewrite (Z_R_minus z1 z2); intro; generalize (eq_IZR_R0 (z1 - z2) H0); - intro; omega. +Proof. + intros z1 z2 H; generalize (Rminus_diag_eq (IZR z1) (IZR z2) H); + rewrite (Z_R_minus z1 z2); intro; generalize (eq_IZR_R0 (z1 - z2) H0); + intro; omega. Qed. (**********) Lemma not_O_IZR : forall n:Z, n <> 0%Z -> IZR n <> 0. -intros z H; red in |- *; intros H0; case H. -apply eq_IZR; auto. +Proof. + intros z H; red in |- *; intros H0; case H. + apply eq_IZR; auto. Qed. (*********) Lemma le_O_IZR : forall n:Z, 0 <= IZR n -> (0 <= n)%Z. -unfold Rle in |- *; intros z [H| H]. -red in |- *; intro; apply (Zlt_le_weak 0 z (lt_O_IZR z H)); assumption. -rewrite (eq_IZR_R0 z); auto with zarith real. +Proof. + unfold Rle in |- *; intros z [H| H]. + red in |- *; intro; apply (Zlt_le_weak 0 z (lt_O_IZR z H)); assumption. + rewrite (eq_IZR_R0 z); auto with zarith real. Qed. (**********) Lemma le_IZR : forall n m:Z, IZR n <= IZR m -> (n <= m)%Z. -unfold Rle in |- *; intros z1 z2 [H| H]. -apply (Zlt_le_weak z1 z2); auto with real. -apply lt_IZR; trivial. -rewrite (eq_IZR z1 z2); auto with zarith real. +Proof. + unfold Rle in |- *; intros z1 z2 [H| H]. + apply (Zlt_le_weak z1 z2); auto with real. + apply lt_IZR; trivial. + rewrite (eq_IZR z1 z2); auto with zarith real. Qed. (**********) Lemma le_IZR_R1 : forall n:Z, IZR n <= 1 -> (n <= 1)%Z. -pattern 1 at 1 in |- *; replace 1 with (IZR 1); intros; auto. -apply le_IZR; trivial. +Proof. + pattern 1 at 1 in |- *; replace 1 with (IZR 1); intros; auto. + apply le_IZR; trivial. Qed. (**********) Lemma IZR_ge : forall n m:Z, (n >= m)%Z -> IZR n >= IZR m. -intros m n H; apply Rnot_lt_ge; red in |- *; intro. -generalize (lt_IZR m n H0); intro; omega. +Proof. + intros m n H; apply Rnot_lt_ge; red in |- *; intro. + generalize (lt_IZR m n H0); intro; omega. Qed. Lemma IZR_le : forall n m:Z, (n <= m)%Z -> IZR n <= IZR m. -intros m n H; apply Rnot_gt_le; red in |- *; intro. -unfold Rgt in H0; generalize (lt_IZR n m H0); intro; omega. +Proof. + intros m n H; apply Rnot_gt_le; red in |- *; intro. + unfold Rgt in H0; generalize (lt_IZR n m H0); intro; omega. Qed. Lemma IZR_lt : forall n m:Z, (n < m)%Z -> IZR n < IZR m. -intros m n H; cut (m <= n)%Z. -intro H0; elim (IZR_le m n H0); intro; auto. -generalize (eq_IZR m n H1); intro; elimtype False; omega. -omega. +Proof. + intros m n H; cut (m <= n)%Z. + intro H0; elim (IZR_le m n H0); intro; auto. + generalize (eq_IZR m n H1); intro; elimtype False; omega. + omega. Qed. Lemma one_IZR_lt1 : forall n:Z, -1 < IZR n < 1 -> n = 0%Z. -intros z [H1 H2]. -apply Zle_antisym. -apply Zlt_succ_le; apply lt_IZR; trivial. -replace 0%Z with (Zsucc (-1)); trivial. -apply Zlt_le_succ; apply lt_IZR; trivial. +Proof. + intros z [H1 H2]. + apply Zle_antisym. + apply Zlt_succ_le; apply lt_IZR; trivial. + replace 0%Z with (Zsucc (-1)); trivial. + apply Zlt_le_succ; apply lt_IZR; trivial. Qed. Lemma one_IZR_r_R1 : - forall r (n m:Z), r < IZR n <= r + 1 -> r < IZR m <= r + 1 -> n = m. -intros r z x [H1 H2] [H3 H4]. -cut ((z - x)%Z = 0%Z); auto with zarith. -apply one_IZR_lt1. -rewrite <- Z_R_minus; split. -replace (-1) with (r - (r + 1)). -unfold Rminus in |- *; apply Rplus_lt_le_compat; auto with real. -ring. -replace 1 with (r + 1 - r). -unfold Rminus in |- *; apply Rplus_le_lt_compat; auto with real. -ring. + forall r (n m:Z), r < IZR n <= r + 1 -> r < IZR m <= r + 1 -> n = m. +Proof. + intros r z x [H1 H2] [H3 H4]. + cut ((z - x)%Z = 0%Z); auto with zarith. + apply one_IZR_lt1. + rewrite <- Z_R_minus; split. + replace (-1) with (r - (r + 1)). + unfold Rminus in |- *; apply Rplus_lt_le_compat; auto with real. + ring. + replace 1 with (r + 1 - r). + unfold Rminus in |- *; apply Rplus_le_lt_compat; auto with real. + ring. Qed. (**********) Lemma single_z_r_R1 : - forall r (n m:Z), - r < IZR n -> IZR n <= r + 1 -> r < IZR m -> IZR m <= r + 1 -> n = m. -intros; apply one_IZR_r_R1 with r; auto. + forall r (n m:Z), + r < IZR n -> IZR n <= r + 1 -> r < IZR m -> IZR m <= r + 1 -> n = m. +Proof. + intros; apply one_IZR_r_R1 with r; auto. Qed. (**********) Lemma tech_single_z_r_R1 : - forall r (n:Z), - r < IZR n -> - IZR n <= r + 1 -> - (exists s : Z, s <> n /\ r < IZR s /\ IZR s <= r + 1) -> False. -intros r z H1 H2 [s [H3 [H4 H5]]]. -apply H3; apply single_z_r_R1 with r; trivial. + forall r (n:Z), + r < IZR n -> + IZR n <= r + 1 -> + (exists s : Z, s <> n /\ r < IZR s /\ IZR s <= r + 1) -> False. +Proof. + intros r z H1 H2 [s [H3 [H4 H5]]]. + apply H3; apply single_z_r_R1 with r; trivial. Qed. (*****************************************************************) -(** Definitions of new types *) +(** * Definitions of new types *) (*****************************************************************) Record nonnegreal : Type := mknonnegreal @@ -1507,125 +1692,138 @@ Record nonzeroreal : Type := mknonzeroreal (**********) Lemma prod_neq_R0 : forall r1 r2, r1 <> 0 -> r2 <> 0 -> r1 * r2 <> 0. -intros x y; intros; red in |- *; intro; generalize (Rmult_integral x y H1); - intro; elim H2; intro; - [ rewrite H3 in H; elim H | rewrite H3 in H0; elim H0 ]; - reflexivity. +Proof. + intros x y; intros; red in |- *; intro; generalize (Rmult_integral x y H1); + intro; elim H2; intro; + [ rewrite H3 in H; elim H | rewrite H3 in H0; elim H0 ]; + reflexivity. Qed. (*********) Lemma Rmult_le_pos : forall r1 r2, 0 <= r1 -> 0 <= r2 -> 0 <= r1 * r2. -intros x y H H0; rewrite <- (Rmult_0_l x); rewrite <- (Rmult_comm x); - apply (Rmult_le_compat_l x 0 y H H0). +Proof. + intros x y H H0; rewrite <- (Rmult_0_l x); rewrite <- (Rmult_comm x); + apply (Rmult_le_compat_l x 0 y H H0). Qed. Lemma double : forall r1, 2 * r1 = r1 + r1. -intro; ring. +Proof. + intro; ring. Qed. Lemma double_var : forall r1, r1 = r1 / 2 + r1 / 2. -intro; rewrite <- double; unfold Rdiv in |- *; rewrite <- Rmult_assoc; - symmetry in |- *; apply Rinv_r_simpl_m. -replace 2 with (INR 2); - [ apply not_O_INR; discriminate | unfold INR in |- *; ring ]. +Proof. + intro; rewrite <- double; unfold Rdiv in |- *; rewrite <- Rmult_assoc; + symmetry in |- *; apply Rinv_r_simpl_m. + replace 2 with (INR 2); + [ apply not_O_INR; discriminate | unfold INR in |- *; ring ]. Qed. (**********************************************************) -(** Other rules about < and <= *) +(** * Other rules about < and <= *) (**********************************************************) Lemma Rplus_lt_0_compat : forall r1 r2, 0 < r1 -> 0 < r2 -> 0 < r1 + r2. -intros x y; intros; apply Rlt_trans with x; - [ assumption - | pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_lt_compat_l; - assumption ]. +Proof. + intros x y; intros; apply Rlt_trans with x; + [ assumption + | pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_lt_compat_l; + assumption ]. Qed. Lemma Rplus_le_lt_0_compat : forall r1 r2, 0 <= r1 -> 0 < r2 -> 0 < r1 + r2. -intros x y; intros; apply Rle_lt_trans with x; - [ assumption - | pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_lt_compat_l; - assumption ]. +Proof. + intros x y; intros; apply Rle_lt_trans with x; + [ assumption + | pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_lt_compat_l; + assumption ]. Qed. Lemma Rplus_lt_le_0_compat : forall r1 r2, 0 < r1 -> 0 <= r2 -> 0 < r1 + r2. -intros x y; intros; rewrite <- Rplus_comm; apply Rplus_le_lt_0_compat; - assumption. +Proof. + intros x y; intros; rewrite <- Rplus_comm; apply Rplus_le_lt_0_compat; + assumption. Qed. Lemma Rplus_le_le_0_compat : forall r1 r2, 0 <= r1 -> 0 <= r2 -> 0 <= r1 + r2. -intros x y; intros; apply Rle_trans with x; - [ assumption - | pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; - assumption ]. +Proof. + intros x y; intros; apply Rle_trans with x; + [ assumption + | pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; + assumption ]. Qed. Lemma plus_le_is_le : forall r1 r2 r3, 0 <= r2 -> r1 + r2 <= r3 -> r1 <= r3. -intros x y z; intros; apply Rle_trans with (x + y); - [ pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; - assumption - | assumption ]. +Proof. + intros x y z; intros; apply Rle_trans with (x + y); + [ pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; + assumption + | assumption ]. Qed. Lemma plus_lt_is_lt : forall r1 r2 r3, 0 <= r2 -> r1 + r2 < r3 -> r1 < r3. -intros x y z; intros; apply Rle_lt_trans with (x + y); - [ pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; - assumption - | assumption ]. +Proof. + intros x y z; intros; apply Rle_lt_trans with (x + y); + [ pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; + assumption + | assumption ]. Qed. Lemma Rmult_le_0_lt_compat : - forall r1 r2 r3 r4, - 0 <= r1 -> 0 <= r3 -> r1 < r2 -> r3 < r4 -> r1 * r3 < r2 * r4. -intros; apply Rle_lt_trans with (r2 * r3); - [ apply Rmult_le_compat_r; [ assumption | left; assumption ] - | apply Rmult_lt_compat_l; - [ apply Rle_lt_trans with r1; assumption | assumption ] ]. + forall r1 r2 r3 r4, + 0 <= r1 -> 0 <= r3 -> r1 < r2 -> r3 < r4 -> r1 * r3 < r2 * r4. +Proof. + intros; apply Rle_lt_trans with (r2 * r3); + [ apply Rmult_le_compat_r; [ assumption | left; assumption ] + | apply Rmult_lt_compat_l; + [ apply Rle_lt_trans with r1; assumption | assumption ] ]. Qed. Lemma le_epsilon : - forall r1 r2, (forall eps:R, 0 < eps -> r1 <= r2 + eps) -> r1 <= r2. -intros x y; intros; elim (Rtotal_order x y); intro. -left; assumption. -elim H0; intro. -right; assumption. -clear H0; generalize (Rgt_minus x y H1); intro H2; change (0 < x - y) in H2. -cut (0 < 2). -intro. -generalize (Rmult_lt_0_compat (x - y) (/ 2) H2 (Rinv_0_lt_compat 2 H0)); - intro H3; generalize (H ((x - y) * / 2) H3); - replace (y + (x - y) * / 2) with ((y + x) * / 2). -intro H4; - generalize (Rmult_le_compat_l 2 x ((y + x) * / 2) (Rlt_le 0 2 H0) H4); - rewrite <- (Rmult_comm ((y + x) * / 2)); rewrite Rmult_assoc; - rewrite <- Rinv_l_sym. -rewrite Rmult_1_r; replace (2 * x) with (x + x). -rewrite (Rplus_comm y); intro H5; apply Rplus_le_reg_l with x; assumption. -ring. -replace 2 with (INR 2); [ apply not_O_INR; discriminate | ring ]. -pattern y at 2 in |- *; replace y with (y / 2 + y / 2). -unfold Rminus, Rdiv in |- *. -repeat rewrite Rmult_plus_distr_r. -ring. -cut (forall z:R, 2 * z = z + z). -intro. -rewrite <- (H4 (y / 2)). -unfold Rdiv in |- *. -rewrite <- Rmult_assoc; apply Rinv_r_simpl_m. -replace 2 with (INR 2). -apply not_O_INR. -discriminate. -unfold INR in |- *; reflexivity. -intro; ring. -cut (0%nat <> 2%nat); - [ intro H0; generalize (lt_INR_0 2 (neq_O_lt 2 H0)); unfold INR in |- *; - intro; assumption - | discriminate ]. + forall r1 r2, (forall eps:R, 0 < eps -> r1 <= r2 + eps) -> r1 <= r2. +Proof. + intros x y; intros; elim (Rtotal_order x y); intro. + left; assumption. + elim H0; intro. + right; assumption. + clear H0; generalize (Rgt_minus x y H1); intro H2; change (0 < x - y) in H2. + cut (0 < 2). + intro. + generalize (Rmult_lt_0_compat (x - y) (/ 2) H2 (Rinv_0_lt_compat 2 H0)); + intro H3; generalize (H ((x - y) * / 2) H3); + replace (y + (x - y) * / 2) with ((y + x) * / 2). + intro H4; + generalize (Rmult_le_compat_l 2 x ((y + x) * / 2) (Rlt_le 0 2 H0) H4); + rewrite <- (Rmult_comm ((y + x) * / 2)); rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. + rewrite Rmult_1_r; replace (2 * x) with (x + x). + rewrite (Rplus_comm y); intro H5; apply Rplus_le_reg_l with x; assumption. + ring. + replace 2 with (INR 2); [ apply not_O_INR; discriminate | reflexivity ]. + pattern y at 2 in |- *; replace y with (y / 2 + y / 2). + unfold Rminus, Rdiv in |- *. + repeat rewrite Rmult_plus_distr_r. + ring. + cut (forall z:R, 2 * z = z + z). + intro. + rewrite <- (H4 (y / 2)). + unfold Rdiv in |- *. + rewrite <- Rmult_assoc; apply Rinv_r_simpl_m. + replace 2 with (INR 2). + apply not_O_INR. + discriminate. + unfold INR in |- *; reflexivity. + intro; ring. + cut (0%nat <> 2%nat); + [ intro H0; generalize (lt_INR_0 2 (neq_O_lt 2 H0)); unfold INR in |- *; + intro; assumption + | discriminate ]. Qed. (**********) Lemma completeness_weak : - forall E:R -> Prop, - bound E -> (exists x : R, E x) -> exists m : R, is_lub E m. -intros; elim (completeness E H H0); intros; split with x; assumption. + forall E:R -> Prop, + bound E -> (exists x : R, E x) -> exists m : R, is_lub E m. +Proof. + intros; elim (completeness E H H0); intros; split with x; assumption. Qed. diff --git a/theories/Reals/RList.v b/theories/Reals/RList.v index 551aec98..19f2b4ff 100644 --- a/theories/Reals/RList.v +++ b/theories/Reals/RList.v @@ -5,208 +5,217 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) - -(*i $Id: RList.v 5920 2004-07-16 20:01:26Z herbelin $ i*) + +(*i $Id: RList.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. Open Local Scope R_scope. Inductive Rlist : Type := - | nil : Rlist - | cons : R -> Rlist -> Rlist. +| nil : Rlist +| cons : R -> Rlist -> Rlist. Fixpoint In (x:R) (l:Rlist) {struct l} : Prop := match l with - | nil => False - | cons a l' => x = a \/ In x l' + | nil => False + | cons a l' => x = a \/ In x l' end. Fixpoint Rlength (l:Rlist) : nat := match l with - | nil => 0%nat - | cons a l' => S (Rlength l') + | nil => 0%nat + | cons a l' => S (Rlength l') end. Fixpoint MaxRlist (l:Rlist) : R := match l with - | nil => 0 - | cons a l1 => + | nil => 0 + | cons a l1 => match l1 with - | nil => a - | cons a' l2 => Rmax a (MaxRlist l1) + | nil => a + | cons a' l2 => Rmax a (MaxRlist l1) end end. Fixpoint MinRlist (l:Rlist) : R := match l with - | nil => 1 - | cons a l1 => + | nil => 1 + | cons a l1 => match l1 with - | nil => a - | cons a' l2 => Rmin a (MinRlist l1) + | nil => a + | cons a' l2 => Rmin a (MinRlist l1) end end. Lemma MaxRlist_P1 : forall (l:Rlist) (x:R), In x l -> x <= MaxRlist l. -intros; induction l as [| r l Hrecl]. -simpl in H; elim H. -induction l as [| r0 l Hrecl0]. -simpl in H; elim H; intro. -simpl in |- *; right; assumption. -elim H0. -replace (MaxRlist (cons r (cons r0 l))) with (Rmax r (MaxRlist (cons r0 l))). -simpl in H; decompose [or] H. -rewrite H0; apply RmaxLess1. -unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l))); intro. -apply Hrecl; simpl in |- *; tauto. -apply Rle_trans with (MaxRlist (cons r0 l)); - [ apply Hrecl; simpl in |- *; tauto | left; auto with real ]. -unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l))); intro. -apply Hrecl; simpl in |- *; tauto. -apply Rle_trans with (MaxRlist (cons r0 l)); - [ apply Hrecl; simpl in |- *; tauto | left; auto with real ]. -reflexivity. +Proof. + intros; induction l as [| r l Hrecl]. + simpl in H; elim H. + induction l as [| r0 l Hrecl0]. + simpl in H; elim H; intro. + simpl in |- *; right; assumption. + elim H0. + replace (MaxRlist (cons r (cons r0 l))) with (Rmax r (MaxRlist (cons r0 l))). + simpl in H; decompose [or] H. + rewrite H0; apply RmaxLess1. + unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l))); intro. + apply Hrecl; simpl in |- *; tauto. + apply Rle_trans with (MaxRlist (cons r0 l)); + [ apply Hrecl; simpl in |- *; tauto | left; auto with real ]. + unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l))); intro. + apply Hrecl; simpl in |- *; tauto. + apply Rle_trans with (MaxRlist (cons r0 l)); + [ apply Hrecl; simpl in |- *; tauto | left; auto with real ]. + reflexivity. Qed. Fixpoint AbsList (l:Rlist) (x:R) {struct l} : Rlist := match l with - | nil => nil - | cons a l' => cons (Rabs (a - x) / 2) (AbsList l' x) + | nil => nil + | cons a l' => cons (Rabs (a - x) / 2) (AbsList l' x) end. Lemma MinRlist_P1 : forall (l:Rlist) (x:R), In x l -> MinRlist l <= x. -intros; induction l as [| r l Hrecl]. -simpl in H; elim H. -induction l as [| r0 l Hrecl0]. -simpl in H; elim H; intro. -simpl in |- *; right; symmetry in |- *; assumption. -elim H0. -replace (MinRlist (cons r (cons r0 l))) with (Rmin r (MinRlist (cons r0 l))). -simpl in H; decompose [or] H. -rewrite H0; apply Rmin_l. -unfold Rmin in |- *; case (Rle_dec r (MinRlist (cons r0 l))); intro. -apply Rle_trans with (MinRlist (cons r0 l)). -assumption. -apply Hrecl; simpl in |- *; tauto. -apply Hrecl; simpl in |- *; tauto. -apply Rle_trans with (MinRlist (cons r0 l)). -apply Rmin_r. -apply Hrecl; simpl in |- *; tauto. -reflexivity. +Proof. + intros; induction l as [| r l Hrecl]. + simpl in H; elim H. + induction l as [| r0 l Hrecl0]. + simpl in H; elim H; intro. + simpl in |- *; right; symmetry in |- *; assumption. + elim H0. + replace (MinRlist (cons r (cons r0 l))) with (Rmin r (MinRlist (cons r0 l))). + simpl in H; decompose [or] H. + rewrite H0; apply Rmin_l. + unfold Rmin in |- *; case (Rle_dec r (MinRlist (cons r0 l))); intro. + apply Rle_trans with (MinRlist (cons r0 l)). + assumption. + apply Hrecl; simpl in |- *; tauto. + apply Hrecl; simpl in |- *; tauto. + apply Rle_trans with (MinRlist (cons r0 l)). + apply Rmin_r. + apply Hrecl; simpl in |- *; tauto. + reflexivity. Qed. Lemma AbsList_P1 : - forall (l:Rlist) (x y:R), In y l -> In (Rabs (y - x) / 2) (AbsList l x). -intros; induction l as [| r l Hrecl]. -elim H. -simpl in |- *; simpl in H; elim H; intro. -left; rewrite H0; reflexivity. -right; apply Hrecl; assumption. + forall (l:Rlist) (x y:R), In y l -> In (Rabs (y - x) / 2) (AbsList l x). +Proof. + intros; induction l as [| r l Hrecl]. + elim H. + simpl in |- *; simpl in H; elim H; intro. + left; rewrite H0; reflexivity. + right; apply Hrecl; assumption. Qed. Lemma MinRlist_P2 : - forall l:Rlist, (forall y:R, In y l -> 0 < y) -> 0 < MinRlist l. -intros; induction l as [| r l Hrecl]. -apply Rlt_0_1. -induction l as [| r0 l Hrecl0]. -simpl in |- *; apply H; simpl in |- *; tauto. -replace (MinRlist (cons r (cons r0 l))) with (Rmin r (MinRlist (cons r0 l))). -unfold Rmin in |- *; case (Rle_dec r (MinRlist (cons r0 l))); intro. -apply H; simpl in |- *; tauto. -apply Hrecl; intros; apply H; simpl in |- *; simpl in H0; tauto. -reflexivity. + forall l:Rlist, (forall y:R, In y l -> 0 < y) -> 0 < MinRlist l. +Proof. + intros; induction l as [| r l Hrecl]. + apply Rlt_0_1. + induction l as [| r0 l Hrecl0]. + simpl in |- *; apply H; simpl in |- *; tauto. + replace (MinRlist (cons r (cons r0 l))) with (Rmin r (MinRlist (cons r0 l))). + unfold Rmin in |- *; case (Rle_dec r (MinRlist (cons r0 l))); intro. + apply H; simpl in |- *; tauto. + apply Hrecl; intros; apply H; simpl in |- *; simpl in H0; tauto. + reflexivity. Qed. Lemma AbsList_P2 : - forall (l:Rlist) (x y:R), - In y (AbsList l x) -> exists z : R, In z l /\ y = Rabs (z - x) / 2. -intros; induction l as [| r l Hrecl]. -elim H. -elim H; intro. -exists r; split. -simpl in |- *; tauto. -assumption. -assert (H1 := Hrecl H0); elim H1; intros; elim H2; clear H2; intros; - exists x0; simpl in |- *; simpl in H2; tauto. + forall (l:Rlist) (x y:R), + In y (AbsList l x) -> exists z : R, In z l /\ y = Rabs (z - x) / 2. +Proof. + intros; induction l as [| r l Hrecl]. + elim H. + elim H; intro. + exists r; split. + simpl in |- *; tauto. + assumption. + assert (H1 := Hrecl H0); elim H1; intros; elim H2; clear H2; intros; + exists x0; simpl in |- *; simpl in H2; tauto. Qed. Lemma MaxRlist_P2 : - forall l:Rlist, (exists y : R, In y l) -> In (MaxRlist l) l. -intros; induction l as [| r l Hrecl]. -simpl in H; elim H; trivial. -induction l as [| r0 l Hrecl0]. -simpl in |- *; left; reflexivity. -change (In (Rmax r (MaxRlist (cons r0 l))) (cons r (cons r0 l))) in |- *; - unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l))); - intro. -right; apply Hrecl; exists r0; left; reflexivity. -left; reflexivity. + forall l:Rlist, (exists y : R, In y l) -> In (MaxRlist l) l. +Proof. + intros; induction l as [| r l Hrecl]. + simpl in H; elim H; trivial. + induction l as [| r0 l Hrecl0]. + simpl in |- *; left; reflexivity. + change (In (Rmax r (MaxRlist (cons r0 l))) (cons r (cons r0 l))) in |- *; + unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l))); + intro. + right; apply Hrecl; exists r0; left; reflexivity. + left; reflexivity. Qed. Fixpoint pos_Rl (l:Rlist) (i:nat) {struct l} : R := match l with - | nil => 0 - | cons a l' => match i with - | O => a - | S i' => pos_Rl l' i' - end + | nil => 0 + | cons a l' => match i with + | O => a + | S i' => pos_Rl l' i' + end end. Lemma pos_Rl_P1 : - forall (l:Rlist) (a:R), - (0 < Rlength l)%nat -> - pos_Rl (cons a l) (Rlength l) = pos_Rl l (pred (Rlength l)). -intros; induction l as [| r l Hrecl]; - [ elim (lt_n_O _ H) - | simpl in |- *; case (Rlength l); [ reflexivity | intro; reflexivity ] ]. + forall (l:Rlist) (a:R), + (0 < Rlength l)%nat -> + pos_Rl (cons a l) (Rlength l) = pos_Rl l (pred (Rlength l)). +Proof. + intros; induction l as [| r l Hrecl]; + [ elim (lt_n_O _ H) + | simpl in |- *; case (Rlength l); [ reflexivity | intro; reflexivity ] ]. Qed. Lemma pos_Rl_P2 : - forall (l:Rlist) (x:R), - In x l <-> (exists i : nat, (i < Rlength l)%nat /\ x = pos_Rl l i). -intros; induction l as [| r l Hrecl]. -split; intro; - [ elim H | elim H; intros; elim H0; intros; elim (lt_n_O _ H1) ]. -split; intro. -elim H; intro. -exists 0%nat; split; - [ simpl in |- *; apply lt_O_Sn | simpl in |- *; apply H0 ]. -elim Hrecl; intros; assert (H3 := H1 H0); elim H3; intros; elim H4; intros; - exists (S x0); split; - [ simpl in |- *; apply lt_n_S; assumption | simpl in |- *; assumption ]. -elim H; intros; elim H0; intros; elim (zerop x0); intro. -rewrite a in H2; simpl in H2; left; assumption. -right; elim Hrecl; intros; apply H4; assert (H5 : S (pred x0) = x0). -symmetry in |- *; apply S_pred with 0%nat; assumption. -exists (pred x0); split; - [ simpl in H1; apply lt_S_n; rewrite H5; assumption - | rewrite <- H5 in H2; simpl in H2; assumption ]. + forall (l:Rlist) (x:R), + In x l <-> (exists i : nat, (i < Rlength l)%nat /\ x = pos_Rl l i). +Proof. + intros; induction l as [| r l Hrecl]. + split; intro; + [ elim H | elim H; intros; elim H0; intros; elim (lt_n_O _ H1) ]. + split; intro. + elim H; intro. + exists 0%nat; split; + [ simpl in |- *; apply lt_O_Sn | simpl in |- *; apply H0 ]. + elim Hrecl; intros; assert (H3 := H1 H0); elim H3; intros; elim H4; intros; + exists (S x0); split; + [ simpl in |- *; apply lt_n_S; assumption | simpl in |- *; assumption ]. + elim H; intros; elim H0; intros; elim (zerop x0); intro. + rewrite a in H2; simpl in H2; left; assumption. + right; elim Hrecl; intros; apply H4; assert (H5 : S (pred x0) = x0). + symmetry in |- *; apply S_pred with 0%nat; assumption. + exists (pred x0); split; + [ simpl in H1; apply lt_S_n; rewrite H5; assumption + | rewrite <- H5 in H2; simpl in H2; assumption ]. Qed. Lemma Rlist_P1 : - forall (l:Rlist) (P:R -> R -> Prop), - (forall x:R, In x l -> exists y : R, P x y) -> + forall (l:Rlist) (P:R -> R -> Prop), + (forall x:R, In x l -> exists y : R, P x y) -> exists l' : Rlist, - Rlength l = Rlength l' /\ - (forall i:nat, (i < Rlength l)%nat -> P (pos_Rl l i) (pos_Rl l' i)). -intros; induction l as [| r l Hrecl]. -exists nil; intros; split; - [ reflexivity | intros; simpl in H0; elim (lt_n_O _ H0) ]. -assert (H0 : In r (cons r l)). -simpl in |- *; left; reflexivity. -assert (H1 := H _ H0); - assert (H2 : forall x:R, In x l -> exists y : R, P x y). -intros; apply H; simpl in |- *; right; assumption. -assert (H3 := Hrecl H2); elim H1; intros; elim H3; intros; exists (cons x x0); - intros; elim H5; clear H5; intros; split. -simpl in |- *; rewrite H5; reflexivity. -intros; elim (zerop i); intro. -rewrite a; simpl in |- *; assumption. -assert (H8 : i = S (pred i)). -apply S_pred with 0%nat; assumption. -rewrite H8; simpl in |- *; apply H6; simpl in H7; apply lt_S_n; rewrite <- H8; - assumption. + Rlength l = Rlength l' /\ + (forall i:nat, (i < Rlength l)%nat -> P (pos_Rl l i) (pos_Rl l' i)). +Proof. + intros; induction l as [| r l Hrecl]. + exists nil; intros; split; + [ reflexivity | intros; simpl in H0; elim (lt_n_O _ H0) ]. + assert (H0 : In r (cons r l)). + simpl in |- *; left; reflexivity. + assert (H1 := H _ H0); + assert (H2 : forall x:R, In x l -> exists y : R, P x y). + intros; apply H; simpl in |- *; right; assumption. + assert (H3 := Hrecl H2); elim H1; intros; elim H3; intros; exists (cons x x0); + intros; elim H5; clear H5; intros; split. + simpl in |- *; rewrite H5; reflexivity. + intros; elim (zerop i); intro. + rewrite a; simpl in |- *; assumption. + assert (H8 : i = S (pred i)). + apply S_pred with 0%nat; assumption. + rewrite H8; simpl in |- *; apply H6; simpl in H7; apply lt_S_n; rewrite <- H8; + assumption. Qed. Definition ordered_Rlist (l:Rlist) : Prop := @@ -214,531 +223,561 @@ Definition ordered_Rlist (l:Rlist) : Prop := Fixpoint insert (l:Rlist) (x:R) {struct l} : Rlist := match l with - | nil => cons x nil - | cons a l' => + | nil => cons x nil + | cons a l' => match Rle_dec a x with - | left _ => cons a (insert l' x) - | right _ => cons x l + | left _ => cons a (insert l' x) + | right _ => cons x l end end. Fixpoint cons_Rlist (l k:Rlist) {struct l} : Rlist := match l with - | nil => k - | cons a l' => cons a (cons_Rlist l' k) + | nil => k + | cons a l' => cons a (cons_Rlist l' k) end. Fixpoint cons_ORlist (k l:Rlist) {struct k} : Rlist := match k with - | nil => l - | cons a k' => cons_ORlist k' (insert l a) + | nil => l + | cons a k' => cons_ORlist k' (insert l a) end. Fixpoint app_Rlist (l:Rlist) (f:R -> R) {struct l} : Rlist := match l with - | nil => nil - | cons a l' => cons (f a) (app_Rlist l' f) + | nil => nil + | cons a l' => cons (f a) (app_Rlist l' f) end. Fixpoint mid_Rlist (l:Rlist) (x:R) {struct l} : Rlist := match l with - | nil => nil - | cons a l' => cons ((x + a) / 2) (mid_Rlist l' a) + | nil => nil + | cons a l' => cons ((x + a) / 2) (mid_Rlist l' a) end. Definition Rtail (l:Rlist) : Rlist := match l with - | nil => nil - | cons a l' => l' + | nil => nil + | cons a l' => l' end. Definition FF (l:Rlist) (f:R -> R) : Rlist := match l with - | nil => nil - | cons a l' => app_Rlist (mid_Rlist l' a) f + | nil => nil + | cons a l' => app_Rlist (mid_Rlist l' a) f end. Lemma RList_P0 : - forall (l:Rlist) (a:R), - pos_Rl (insert l a) 0 = a \/ pos_Rl (insert l a) 0 = pos_Rl l 0. -intros; induction l as [| r l Hrecl]; - [ left; reflexivity - | simpl in |- *; case (Rle_dec r a); intro; - [ right; reflexivity | left; reflexivity ] ]. + forall (l:Rlist) (a:R), + pos_Rl (insert l a) 0 = a \/ pos_Rl (insert l a) 0 = pos_Rl l 0. +Proof. + intros; induction l as [| r l Hrecl]; + [ left; reflexivity + | simpl in |- *; case (Rle_dec r a); intro; + [ right; reflexivity | left; reflexivity ] ]. Qed. Lemma RList_P1 : - forall (l:Rlist) (a:R), ordered_Rlist l -> ordered_Rlist (insert l a). -intros; induction l as [| r l Hrecl]. -simpl in |- *; unfold ordered_Rlist in |- *; intros; simpl in H0; - elim (lt_n_O _ H0). -simpl in |- *; case (Rle_dec r a); intro. -assert (H1 : ordered_Rlist l). -unfold ordered_Rlist in |- *; unfold ordered_Rlist in H; intros; - assert (H1 : (S i < pred (Rlength (cons r l)))%nat); - [ simpl in |- *; replace (Rlength l) with (S (pred (Rlength l))); - [ apply lt_n_S; assumption - | symmetry in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *; - intro; rewrite <- H1 in H0; simpl in H0; elim (lt_n_O _ H0) ] - | apply (H _ H1) ]. -assert (H2 := Hrecl H1); unfold ordered_Rlist in |- *; intros; - induction i as [| i Hreci]. -simpl in |- *; assert (H3 := RList_P0 l a); elim H3; intro. -rewrite H4; assumption. -induction l as [| r1 l Hrecl0]; - [ simpl in |- *; assumption - | rewrite H4; apply (H 0%nat); simpl in |- *; apply lt_O_Sn ]. -simpl in |- *; apply H2; simpl in H0; apply lt_S_n; - replace (S (pred (Rlength (insert l a)))) with (Rlength (insert l a)); - [ assumption - | apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; - rewrite <- H3 in H0; elim (lt_n_O _ H0) ]. -unfold ordered_Rlist in |- *; intros; induction i as [| i Hreci]; - [ simpl in |- *; auto with real - | change (pos_Rl (cons r l) i <= pos_Rl (cons r l) (S i)) in |- *; apply H; - simpl in H0; simpl in |- *; apply (lt_S_n _ _ H0) ]. + forall (l:Rlist) (a:R), ordered_Rlist l -> ordered_Rlist (insert l a). +Proof. + intros; induction l as [| r l Hrecl]. + simpl in |- *; unfold ordered_Rlist in |- *; intros; simpl in H0; + elim (lt_n_O _ H0). + simpl in |- *; case (Rle_dec r a); intro. + assert (H1 : ordered_Rlist l). + unfold ordered_Rlist in |- *; unfold ordered_Rlist in H; intros; + assert (H1 : (S i < pred (Rlength (cons r l)))%nat); + [ simpl in |- *; replace (Rlength l) with (S (pred (Rlength l))); + [ apply lt_n_S; assumption + | symmetry in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *; + intro; rewrite <- H1 in H0; simpl in H0; elim (lt_n_O _ H0) ] + | apply (H _ H1) ]. + assert (H2 := Hrecl H1); unfold ordered_Rlist in |- *; intros; + induction i as [| i Hreci]. + simpl in |- *; assert (H3 := RList_P0 l a); elim H3; intro. + rewrite H4; assumption. + induction l as [| r1 l Hrecl0]; + [ simpl in |- *; assumption + | rewrite H4; apply (H 0%nat); simpl in |- *; apply lt_O_Sn ]. + simpl in |- *; apply H2; simpl in H0; apply lt_S_n; + replace (S (pred (Rlength (insert l a)))) with (Rlength (insert l a)); + [ assumption + | apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; + rewrite <- H3 in H0; elim (lt_n_O _ H0) ]. + unfold ordered_Rlist in |- *; intros; induction i as [| i Hreci]; + [ simpl in |- *; auto with real + | change (pos_Rl (cons r l) i <= pos_Rl (cons r l) (S i)) in |- *; apply H; + simpl in H0; simpl in |- *; apply (lt_S_n _ _ H0) ]. Qed. Lemma RList_P2 : - forall l1 l2:Rlist, ordered_Rlist l2 -> ordered_Rlist (cons_ORlist l1 l2). -simple induction l1; - [ intros; simpl in |- *; apply H - | intros; simpl in |- *; apply H; apply RList_P1; assumption ]. + forall l1 l2:Rlist, ordered_Rlist l2 -> ordered_Rlist (cons_ORlist l1 l2). +Proof. + simple induction l1; + [ intros; simpl in |- *; apply H + | intros; simpl in |- *; apply H; apply RList_P1; assumption ]. Qed. Lemma RList_P3 : - forall (l:Rlist) (x:R), - In x l <-> (exists i : nat, x = pos_Rl l i /\ (i < Rlength l)%nat). -intros; split; intro; - [ induction l as [| r l Hrecl] | induction l as [| r l Hrecl] ]. -elim H. -elim H; intro; - [ exists 0%nat; split; [ apply H0 | simpl in |- *; apply lt_O_Sn ] - | elim (Hrecl H0); intros; elim H1; clear H1; intros; exists (S x0); split; - [ apply H1 | simpl in |- *; apply lt_n_S; assumption ] ]. -elim H; intros; elim H0; intros; elim (lt_n_O _ H2). -simpl in |- *; elim H; intros; elim H0; clear H0; intros; - induction x0 as [| x0 Hrecx0]; - [ left; apply H0 - | right; apply Hrecl; exists x0; split; - [ apply H0 | simpl in H1; apply lt_S_n; assumption ] ]. + forall (l:Rlist) (x:R), + In x l <-> (exists i : nat, x = pos_Rl l i /\ (i < Rlength l)%nat). +Proof. + intros; split; intro; + [ induction l as [| r l Hrecl] | induction l as [| r l Hrecl] ]. + elim H. + elim H; intro; + [ exists 0%nat; split; [ apply H0 | simpl in |- *; apply lt_O_Sn ] + | elim (Hrecl H0); intros; elim H1; clear H1; intros; exists (S x0); split; + [ apply H1 | simpl in |- *; apply lt_n_S; assumption ] ]. + elim H; intros; elim H0; intros; elim (lt_n_O _ H2). + simpl in |- *; elim H; intros; elim H0; clear H0; intros; + induction x0 as [| x0 Hrecx0]; + [ left; apply H0 + | right; apply Hrecl; exists x0; split; + [ apply H0 | simpl in H1; apply lt_S_n; assumption ] ]. Qed. Lemma RList_P4 : - forall (l1:Rlist) (a:R), ordered_Rlist (cons a l1) -> ordered_Rlist l1. -intros; unfold ordered_Rlist in |- *; intros; apply (H (S i)); simpl in |- *; - replace (Rlength l1) with (S (pred (Rlength l1))); - [ apply lt_n_S; assumption - | symmetry in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *; - intro; rewrite <- H1 in H0; elim (lt_n_O _ H0) ]. + forall (l1:Rlist) (a:R), ordered_Rlist (cons a l1) -> ordered_Rlist l1. +Proof. + intros; unfold ordered_Rlist in |- *; intros; apply (H (S i)); simpl in |- *; + replace (Rlength l1) with (S (pred (Rlength l1))); + [ apply lt_n_S; assumption + | symmetry in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *; + intro; rewrite <- H1 in H0; elim (lt_n_O _ H0) ]. Qed. Lemma RList_P5 : - forall (l:Rlist) (x:R), ordered_Rlist l -> In x l -> pos_Rl l 0 <= x. -intros; induction l as [| r l Hrecl]; - [ elim H0 - | simpl in |- *; elim H0; intro; - [ rewrite H1; right; reflexivity - | apply Rle_trans with (pos_Rl l 0); - [ apply (H 0%nat); simpl in |- *; induction l as [| r0 l Hrecl0]; - [ elim H1 | simpl in |- *; apply lt_O_Sn ] - | apply Hrecl; [ eapply RList_P4; apply H | assumption ] ] ] ]. + forall (l:Rlist) (x:R), ordered_Rlist l -> In x l -> pos_Rl l 0 <= x. +Proof. + intros; induction l as [| r l Hrecl]; + [ elim H0 + | simpl in |- *; elim H0; intro; + [ rewrite H1; right; reflexivity + | apply Rle_trans with (pos_Rl l 0); + [ apply (H 0%nat); simpl in |- *; induction l as [| r0 l Hrecl0]; + [ elim H1 | simpl in |- *; apply lt_O_Sn ] + | apply Hrecl; [ eapply RList_P4; apply H | assumption ] ] ] ]. Qed. Lemma RList_P6 : - forall l:Rlist, - ordered_Rlist l <-> - (forall i j:nat, + forall l:Rlist, + ordered_Rlist l <-> + (forall i j:nat, (i <= j)%nat -> (j < Rlength l)%nat -> pos_Rl l i <= pos_Rl l j). -simple induction l; split; intro. -intros; right; reflexivity. -unfold ordered_Rlist in |- *; intros; simpl in H0; elim (lt_n_O _ H0). -intros; induction i as [| i Hreci]; - [ induction j as [| j Hrecj]; - [ right; reflexivity - | simpl in |- *; apply Rle_trans with (pos_Rl r0 0); - [ apply (H0 0%nat); simpl in |- *; simpl in H2; apply neq_O_lt; - red in |- *; intro; rewrite <- H3 in H2; - assert (H4 := lt_S_n _ _ H2); elim (lt_n_O _ H4) - | elim H; intros; apply H3; - [ apply RList_P4 with r; assumption - | apply le_O_n - | simpl in H2; apply lt_S_n; assumption ] ] ] - | induction j as [| j Hrecj]; - [ elim (le_Sn_O _ H1) - | simpl in |- *; elim H; intros; apply H3; - [ apply RList_P4 with r; assumption - | apply le_S_n; assumption - | simpl in H2; apply lt_S_n; assumption ] ] ]. -unfold ordered_Rlist in |- *; intros; apply H0; - [ apply le_n_Sn | simpl in |- *; simpl in H1; apply lt_n_S; assumption ]. +Proof. + simple induction l; split; intro. + intros; right; reflexivity. + unfold ordered_Rlist in |- *; intros; simpl in H0; elim (lt_n_O _ H0). + intros; induction i as [| i Hreci]; + [ induction j as [| j Hrecj]; + [ right; reflexivity + | simpl in |- *; apply Rle_trans with (pos_Rl r0 0); + [ apply (H0 0%nat); simpl in |- *; simpl in H2; apply neq_O_lt; + red in |- *; intro; rewrite <- H3 in H2; + assert (H4 := lt_S_n _ _ H2); elim (lt_n_O _ H4) + | elim H; intros; apply H3; + [ apply RList_P4 with r; assumption + | apply le_O_n + | simpl in H2; apply lt_S_n; assumption ] ] ] + | induction j as [| j Hrecj]; + [ elim (le_Sn_O _ H1) + | simpl in |- *; elim H; intros; apply H3; + [ apply RList_P4 with r; assumption + | apply le_S_n; assumption + | simpl in H2; apply lt_S_n; assumption ] ] ]. + unfold ordered_Rlist in |- *; intros; apply H0; + [ apply le_n_Sn | simpl in |- *; simpl in H1; apply lt_n_S; assumption ]. Qed. Lemma RList_P7 : - forall (l:Rlist) (x:R), - ordered_Rlist l -> In x l -> x <= pos_Rl l (pred (Rlength l)). -intros; assert (H1 := RList_P6 l); elim H1; intros H2 _; assert (H3 := H2 H); - clear H1 H2; assert (H1 := RList_P3 l x); elim H1; - clear H1; intros; assert (H4 := H1 H0); elim H4; clear H4; - intros; elim H4; clear H4; intros; rewrite H4; - assert (H6 : Rlength l = S (pred (Rlength l))). -apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; - rewrite <- H6 in H5; elim (lt_n_O _ H5). -apply H3; - [ rewrite H6 in H5; apply lt_n_Sm_le; assumption - | apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H7 in H5; - elim (lt_n_O _ H5) ]. + forall (l:Rlist) (x:R), + ordered_Rlist l -> In x l -> x <= pos_Rl l (pred (Rlength l)). +Proof. + intros; assert (H1 := RList_P6 l); elim H1; intros H2 _; assert (H3 := H2 H); + clear H1 H2; assert (H1 := RList_P3 l x); elim H1; + clear H1; intros; assert (H4 := H1 H0); elim H4; clear H4; + intros; elim H4; clear H4; intros; rewrite H4; + assert (H6 : Rlength l = S (pred (Rlength l))). + apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; + rewrite <- H6 in H5; elim (lt_n_O _ H5). + apply H3; + [ rewrite H6 in H5; apply lt_n_Sm_le; assumption + | apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H7 in H5; + elim (lt_n_O _ H5) ]. Qed. Lemma RList_P8 : - forall (l:Rlist) (a x:R), In x (insert l a) <-> x = a \/ In x l. -simple induction l. -intros; split; intro; simpl in H; apply H. -intros; split; intro; - [ simpl in H0; generalize H0; case (Rle_dec r a); intros; - [ simpl in H1; elim H1; intro; - [ right; left; assumption - | elim (H a x); intros; elim (H3 H2); intro; - [ left; assumption | right; right; assumption ] ] - | simpl in H1; decompose [or] H1; - [ left; assumption - | right; left; assumption - | right; right; assumption ] ] - | simpl in |- *; case (Rle_dec r a); intro; - [ simpl in H0; decompose [or] H0; - [ right; elim (H a x); intros; apply H3; left - | left - | right; elim (H a x); intros; apply H3; right ] - | simpl in H0; decompose [or] H0; [ left | right; left | right; right ] ]; - assumption ]. + forall (l:Rlist) (a x:R), In x (insert l a) <-> x = a \/ In x l. +Proof. + simple induction l. + intros; split; intro; simpl in H; apply H. + intros; split; intro; + [ simpl in H0; generalize H0; case (Rle_dec r a); intros; + [ simpl in H1; elim H1; intro; + [ right; left; assumption + | elim (H a x); intros; elim (H3 H2); intro; + [ left; assumption | right; right; assumption ] ] + | simpl in H1; decompose [or] H1; + [ left; assumption + | right; left; assumption + | right; right; assumption ] ] + | simpl in |- *; case (Rle_dec r a); intro; + [ simpl in H0; decompose [or] H0; + [ right; elim (H a x); intros; apply H3; left + | left + | right; elim (H a x); intros; apply H3; right ] + | simpl in H0; decompose [or] H0; [ left | right; left | right; right ] ]; + assumption ]. Qed. Lemma RList_P9 : - forall (l1 l2:Rlist) (x:R), In x (cons_ORlist l1 l2) <-> In x l1 \/ In x l2. -simple induction l1. -intros; split; intro; - [ simpl in H; right; assumption - | simpl in |- *; elim H; intro; [ elim H0 | assumption ] ]. -intros; split. -simpl in |- *; intros; elim (H (insert l2 r) x); intros; assert (H3 := H1 H0); - elim H3; intro; - [ left; right; assumption - | elim (RList_P8 l2 r x); intros H5 _; assert (H6 := H5 H4); elim H6; intro; - [ left; left; assumption | right; assumption ] ]. -intro; simpl in |- *; elim (H (insert l2 r) x); intros _ H1; apply H1; - elim H0; intro; - [ elim H2; intro; - [ right; elim (RList_P8 l2 r x); intros _ H4; apply H4; left; assumption - | left; assumption ] - | right; elim (RList_P8 l2 r x); intros _ H3; apply H3; right; assumption ]. + forall (l1 l2:Rlist) (x:R), In x (cons_ORlist l1 l2) <-> In x l1 \/ In x l2. +Proof. + simple induction l1. + intros; split; intro; + [ simpl in H; right; assumption + | simpl in |- *; elim H; intro; [ elim H0 | assumption ] ]. + intros; split. + simpl in |- *; intros; elim (H (insert l2 r) x); intros; assert (H3 := H1 H0); + elim H3; intro; + [ left; right; assumption + | elim (RList_P8 l2 r x); intros H5 _; assert (H6 := H5 H4); elim H6; intro; + [ left; left; assumption | right; assumption ] ]. + intro; simpl in |- *; elim (H (insert l2 r) x); intros _ H1; apply H1; + elim H0; intro; + [ elim H2; intro; + [ right; elim (RList_P8 l2 r x); intros _ H4; apply H4; left; assumption + | left; assumption ] + | right; elim (RList_P8 l2 r x); intros _ H3; apply H3; right; assumption ]. Qed. Lemma RList_P10 : - forall (l:Rlist) (a:R), Rlength (insert l a) = S (Rlength l). -intros; induction l as [| r l Hrecl]; - [ reflexivity - | simpl in |- *; case (Rle_dec r a); intro; - [ simpl in |- *; rewrite Hrecl; reflexivity | reflexivity ] ]. + forall (l:Rlist) (a:R), Rlength (insert l a) = S (Rlength l). +Proof. + intros; induction l as [| r l Hrecl]; + [ reflexivity + | simpl in |- *; case (Rle_dec r a); intro; + [ simpl in |- *; rewrite Hrecl; reflexivity | reflexivity ] ]. Qed. Lemma RList_P11 : - forall l1 l2:Rlist, - Rlength (cons_ORlist l1 l2) = (Rlength l1 + Rlength l2)%nat. -simple induction l1; - [ intro; reflexivity - | intros; simpl in |- *; rewrite (H (insert l2 r)); rewrite RList_P10; - apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; - rewrite S_INR; ring ]. + forall l1 l2:Rlist, + Rlength (cons_ORlist l1 l2) = (Rlength l1 + Rlength l2)%nat. +Proof. + simple induction l1; + [ intro; reflexivity + | intros; simpl in |- *; rewrite (H (insert l2 r)); rewrite RList_P10; + apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; + rewrite S_INR; ring ]. Qed. Lemma RList_P12 : - forall (l:Rlist) (i:nat) (f:R -> R), - (i < Rlength l)%nat -> pos_Rl (app_Rlist l f) i = f (pos_Rl l i). -simple induction l; - [ intros; elim (lt_n_O _ H) - | intros; induction i as [| i Hreci]; - [ reflexivity | simpl in |- *; apply H; apply lt_S_n; apply H0 ] ]. + forall (l:Rlist) (i:nat) (f:R -> R), + (i < Rlength l)%nat -> pos_Rl (app_Rlist l f) i = f (pos_Rl l i). +Proof. + simple induction l; + [ intros; elim (lt_n_O _ H) + | intros; induction i as [| i Hreci]; + [ reflexivity | simpl in |- *; apply H; apply lt_S_n; apply H0 ] ]. Qed. Lemma RList_P13 : - forall (l:Rlist) (i:nat) (a:R), - (i < pred (Rlength l))%nat -> - pos_Rl (mid_Rlist l a) (S i) = (pos_Rl l i + pos_Rl l (S i)) / 2. -simple induction l. -intros; simpl in H; elim (lt_n_O _ H). -simple induction r0. -intros; simpl in H0; elim (lt_n_O _ H0). -intros; simpl in H1; induction i as [| i Hreci]. -reflexivity. -change - (pos_Rl (mid_Rlist (cons r1 r2) r) (S i) = - (pos_Rl (cons r1 r2) i + pos_Rl (cons r1 r2) (S i)) / 2) - in |- *; apply H0; simpl in |- *; apply lt_S_n; assumption. + forall (l:Rlist) (i:nat) (a:R), + (i < pred (Rlength l))%nat -> + pos_Rl (mid_Rlist l a) (S i) = (pos_Rl l i + pos_Rl l (S i)) / 2. +Proof. + simple induction l. + intros; simpl in H; elim (lt_n_O _ H). + simple induction r0. + intros; simpl in H0; elim (lt_n_O _ H0). + intros; simpl in H1; induction i as [| i Hreci]. + reflexivity. + change + (pos_Rl (mid_Rlist (cons r1 r2) r) (S i) = + (pos_Rl (cons r1 r2) i + pos_Rl (cons r1 r2) (S i)) / 2) + in |- *; apply H0; simpl in |- *; apply lt_S_n; assumption. Qed. Lemma RList_P14 : forall (l:Rlist) (a:R), Rlength (mid_Rlist l a) = Rlength l. -simple induction l; intros; - [ reflexivity | simpl in |- *; rewrite (H r); reflexivity ]. +Proof. + simple induction l; intros; + [ reflexivity | simpl in |- *; rewrite (H r); reflexivity ]. Qed. Lemma RList_P15 : - forall l1 l2:Rlist, - ordered_Rlist l1 -> - ordered_Rlist l2 -> - pos_Rl l1 0 = pos_Rl l2 0 -> pos_Rl (cons_ORlist l1 l2) 0 = pos_Rl l1 0. -intros; apply Rle_antisym. -induction l1 as [| r l1 Hrecl1]; - [ simpl in |- *; simpl in H1; right; symmetry in |- *; assumption - | elim (RList_P9 (cons r l1) l2 (pos_Rl (cons r l1) 0)); intros; - assert - (H4 : - In (pos_Rl (cons r l1) 0) (cons r l1) \/ In (pos_Rl (cons r l1) 0) l2); - [ left; left; reflexivity - | assert (H5 := H3 H4); apply RList_P5; - [ apply RList_P2; assumption | assumption ] ] ]. -induction l1 as [| r l1 Hrecl1]; - [ simpl in |- *; simpl in H1; right; assumption - | assert - (H2 : - In (pos_Rl (cons_ORlist (cons r l1) l2) 0) (cons_ORlist (cons r l1) l2)); - [ elim - (RList_P3 (cons_ORlist (cons r l1) l2) - (pos_Rl (cons_ORlist (cons r l1) l2) 0)); - intros; apply H3; exists 0%nat; split; - [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_O_Sn ] - | elim (RList_P9 (cons r l1) l2 (pos_Rl (cons_ORlist (cons r l1) l2) 0)); - intros; assert (H5 := H3 H2); elim H5; intro; - [ apply RList_P5; assumption - | rewrite H1; apply RList_P5; assumption ] ] ]. + forall l1 l2:Rlist, + ordered_Rlist l1 -> + ordered_Rlist l2 -> + pos_Rl l1 0 = pos_Rl l2 0 -> pos_Rl (cons_ORlist l1 l2) 0 = pos_Rl l1 0. +Proof. + intros; apply Rle_antisym. + induction l1 as [| r l1 Hrecl1]; + [ simpl in |- *; simpl in H1; right; symmetry in |- *; assumption + | elim (RList_P9 (cons r l1) l2 (pos_Rl (cons r l1) 0)); intros; + assert + (H4 : + In (pos_Rl (cons r l1) 0) (cons r l1) \/ In (pos_Rl (cons r l1) 0) l2); + [ left; left; reflexivity + | assert (H5 := H3 H4); apply RList_P5; + [ apply RList_P2; assumption | assumption ] ] ]. + induction l1 as [| r l1 Hrecl1]; + [ simpl in |- *; simpl in H1; right; assumption + | assert + (H2 : + In (pos_Rl (cons_ORlist (cons r l1) l2) 0) (cons_ORlist (cons r l1) l2)); + [ elim + (RList_P3 (cons_ORlist (cons r l1) l2) + (pos_Rl (cons_ORlist (cons r l1) l2) 0)); + intros; apply H3; exists 0%nat; split; + [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_O_Sn ] + | elim (RList_P9 (cons r l1) l2 (pos_Rl (cons_ORlist (cons r l1) l2) 0)); + intros; assert (H5 := H3 H2); elim H5; intro; + [ apply RList_P5; assumption + | rewrite H1; apply RList_P5; assumption ] ] ]. Qed. Lemma RList_P16 : - forall l1 l2:Rlist, - ordered_Rlist l1 -> - ordered_Rlist l2 -> - pos_Rl l1 (pred (Rlength l1)) = pos_Rl l2 (pred (Rlength l2)) -> - pos_Rl (cons_ORlist l1 l2) (pred (Rlength (cons_ORlist l1 l2))) = - pos_Rl l1 (pred (Rlength l1)). -intros; apply Rle_antisym. -induction l1 as [| r l1 Hrecl1]. -simpl in |- *; simpl in H1; right; symmetry in |- *; assumption. -assert - (H2 : - In - (pos_Rl (cons_ORlist (cons r l1) l2) - (pred (Rlength (cons_ORlist (cons r l1) l2)))) - (cons_ORlist (cons r l1) l2)); - [ elim - (RList_P3 (cons_ORlist (cons r l1) l2) - (pos_Rl (cons_ORlist (cons r l1) l2) - (pred (Rlength (cons_ORlist (cons r l1) l2))))); - intros; apply H3; exists (pred (Rlength (cons_ORlist (cons r l1) l2))); - split; [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_n_Sn ] - | elim - (RList_P9 (cons r l1) l2 - (pos_Rl (cons_ORlist (cons r l1) l2) + forall l1 l2:Rlist, + ordered_Rlist l1 -> + ordered_Rlist l2 -> + pos_Rl l1 (pred (Rlength l1)) = pos_Rl l2 (pred (Rlength l2)) -> + pos_Rl (cons_ORlist l1 l2) (pred (Rlength (cons_ORlist l1 l2))) = + pos_Rl l1 (pred (Rlength l1)). +Proof. + intros; apply Rle_antisym. + induction l1 as [| r l1 Hrecl1]. + simpl in |- *; simpl in H1; right; symmetry in |- *; assumption. + assert + (H2 : + In + (pos_Rl (cons_ORlist (cons r l1) l2) + (pred (Rlength (cons_ORlist (cons r l1) l2)))) + (cons_ORlist (cons r l1) l2)); + [ elim + (RList_P3 (cons_ORlist (cons r l1) l2) + (pos_Rl (cons_ORlist (cons r l1) l2) (pred (Rlength (cons_ORlist (cons r l1) l2))))); - intros; assert (H5 := H3 H2); elim H5; intro; - [ apply RList_P7; assumption | rewrite H1; apply RList_P7; assumption ] ]. -induction l1 as [| r l1 Hrecl1]. -simpl in |- *; simpl in H1; right; assumption. -elim - (RList_P9 (cons r l1) l2 (pos_Rl (cons r l1) (pred (Rlength (cons r l1))))); - intros; - assert - (H4 : - In (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))) (cons r l1) \/ - In (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))) l2); - [ left; change (In (pos_Rl (cons r l1) (Rlength l1)) (cons r l1)) in |- *; - elim (RList_P3 (cons r l1) (pos_Rl (cons r l1) (Rlength l1))); - intros; apply H5; exists (Rlength l1); split; - [ reflexivity | simpl in |- *; apply lt_n_Sn ] - | assert (H5 := H3 H4); apply RList_P7; - [ apply RList_P2; assumption - | elim - (RList_P9 (cons r l1) l2 - (pos_Rl (cons r l1) (pred (Rlength (cons r l1))))); - intros; apply H7; left; - elim - (RList_P3 (cons r l1) - (pos_Rl (cons r l1) (pred (Rlength (cons r l1))))); - intros; apply H9; exists (pred (Rlength (cons r l1))); - split; [ reflexivity | simpl in |- *; apply lt_n_Sn ] ] ]. + intros; apply H3; exists (pred (Rlength (cons_ORlist (cons r l1) l2))); + split; [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_n_Sn ] + | elim + (RList_P9 (cons r l1) l2 + (pos_Rl (cons_ORlist (cons r l1) l2) + (pred (Rlength (cons_ORlist (cons r l1) l2))))); + intros; assert (H5 := H3 H2); elim H5; intro; + [ apply RList_P7; assumption | rewrite H1; apply RList_P7; assumption ] ]. + induction l1 as [| r l1 Hrecl1]. + simpl in |- *; simpl in H1; right; assumption. + elim + (RList_P9 (cons r l1) l2 (pos_Rl (cons r l1) (pred (Rlength (cons r l1))))); + intros; + assert + (H4 : + In (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))) (cons r l1) \/ + In (pos_Rl (cons r l1) (pred (Rlength (cons r l1)))) l2); + [ left; change (In (pos_Rl (cons r l1) (Rlength l1)) (cons r l1)) in |- *; + elim (RList_P3 (cons r l1) (pos_Rl (cons r l1) (Rlength l1))); + intros; apply H5; exists (Rlength l1); split; + [ reflexivity | simpl in |- *; apply lt_n_Sn ] + | assert (H5 := H3 H4); apply RList_P7; + [ apply RList_P2; assumption + | elim + (RList_P9 (cons r l1) l2 + (pos_Rl (cons r l1) (pred (Rlength (cons r l1))))); + intros; apply H7; left; + elim + (RList_P3 (cons r l1) + (pos_Rl (cons r l1) (pred (Rlength (cons r l1))))); + intros; apply H9; exists (pred (Rlength (cons r l1))); + split; [ reflexivity | simpl in |- *; apply lt_n_Sn ] ] ]. Qed. Lemma RList_P17 : - forall (l1:Rlist) (x:R) (i:nat), - ordered_Rlist l1 -> - In x l1 -> - pos_Rl l1 i < x -> (i < pred (Rlength l1))%nat -> pos_Rl l1 (S i) <= x. -simple induction l1. -intros; elim H0. -intros; induction i as [| i Hreci]. -simpl in |- *; elim H1; intro; - [ simpl in H2; rewrite H4 in H2; elim (Rlt_irrefl _ H2) - | apply RList_P5; [ apply RList_P4 with r; assumption | assumption ] ]. -simpl in |- *; simpl in H2; elim H1; intro. -rewrite H4 in H2; assert (H5 : r <= pos_Rl r0 i); - [ apply Rle_trans with (pos_Rl r0 0); - [ apply (H0 0%nat); simpl in |- *; simpl in H3; apply neq_O_lt; - red in |- *; intro; rewrite <- H5 in H3; elim (lt_n_O _ H3) - | elim (RList_P6 r0); intros; apply H5; - [ apply RList_P4 with r; assumption - | apply le_O_n - | simpl in H3; apply lt_S_n; apply lt_trans with (Rlength r0); - [ apply H3 | apply lt_n_Sn ] ] ] - | elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H2)) ]. -apply H; try assumption; - [ apply RList_P4 with r; assumption - | simpl in H3; apply lt_S_n; - replace (S (pred (Rlength r0))) with (Rlength r0); - [ apply H3 - | apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; - rewrite <- H5 in H3; elim (lt_n_O _ H3) ] ]. + forall (l1:Rlist) (x:R) (i:nat), + ordered_Rlist l1 -> + In x l1 -> + pos_Rl l1 i < x -> (i < pred (Rlength l1))%nat -> pos_Rl l1 (S i) <= x. +Proof. + simple induction l1. + intros; elim H0. + intros; induction i as [| i Hreci]. + simpl in |- *; elim H1; intro; + [ simpl in H2; rewrite H4 in H2; elim (Rlt_irrefl _ H2) + | apply RList_P5; [ apply RList_P4 with r; assumption | assumption ] ]. + simpl in |- *; simpl in H2; elim H1; intro. + rewrite H4 in H2; assert (H5 : r <= pos_Rl r0 i); + [ apply Rle_trans with (pos_Rl r0 0); + [ apply (H0 0%nat); simpl in |- *; simpl in H3; apply neq_O_lt; + red in |- *; intro; rewrite <- H5 in H3; elim (lt_n_O _ H3) + | elim (RList_P6 r0); intros; apply H5; + [ apply RList_P4 with r; assumption + | apply le_O_n + | simpl in H3; apply lt_S_n; apply lt_trans with (Rlength r0); + [ apply H3 | apply lt_n_Sn ] ] ] + | elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H2)) ]. + apply H; try assumption; + [ apply RList_P4 with r; assumption + | simpl in H3; apply lt_S_n; + replace (S (pred (Rlength r0))) with (Rlength r0); + [ apply H3 + | apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; + rewrite <- H5 in H3; elim (lt_n_O _ H3) ] ]. Qed. Lemma RList_P18 : - forall (l:Rlist) (f:R -> R), Rlength (app_Rlist l f) = Rlength l. -simple induction l; intros; - [ reflexivity | simpl in |- *; rewrite H; reflexivity ]. + forall (l:Rlist) (f:R -> R), Rlength (app_Rlist l f) = Rlength l. +Proof. + simple induction l; intros; + [ reflexivity | simpl in |- *; rewrite H; reflexivity ]. Qed. Lemma RList_P19 : - forall l:Rlist, - l <> nil -> exists r : R, (exists r0 : Rlist, l = cons r r0). -intros; induction l as [| r l Hrecl]; - [ elim H; reflexivity | exists r; exists l; reflexivity ]. + forall l:Rlist, + l <> nil -> exists r : R, (exists r0 : Rlist, l = cons r r0). +Proof. + intros; induction l as [| r l Hrecl]; + [ elim H; reflexivity | exists r; exists l; reflexivity ]. Qed. Lemma RList_P20 : - forall l:Rlist, - (2 <= Rlength l)%nat -> + forall l:Rlist, + (2 <= Rlength l)%nat -> exists r : R, - (exists r1 : R, (exists l' : Rlist, l = cons r (cons r1 l'))). -intros; induction l as [| r l Hrecl]; - [ simpl in H; elim (le_Sn_O _ H) - | induction l as [| r0 l Hrecl0]; - [ simpl in H; elim (le_Sn_O _ (le_S_n _ _ H)) - | exists r; exists r0; exists l; reflexivity ] ]. + (exists r1 : R, (exists l' : Rlist, l = cons r (cons r1 l'))). +Proof. + intros; induction l as [| r l Hrecl]; + [ simpl in H; elim (le_Sn_O _ H) + | induction l as [| r0 l Hrecl0]; + [ simpl in H; elim (le_Sn_O _ (le_S_n _ _ H)) + | exists r; exists r0; exists l; reflexivity ] ]. Qed. Lemma RList_P21 : forall l l':Rlist, l = l' -> Rtail l = Rtail l'. -intros; rewrite H; reflexivity. +Proof. + intros; rewrite H; reflexivity. Qed. Lemma RList_P22 : - forall l1 l2:Rlist, l1 <> nil -> pos_Rl (cons_Rlist l1 l2) 0 = pos_Rl l1 0. -simple induction l1; [ intros; elim H; reflexivity | intros; reflexivity ]. + forall l1 l2:Rlist, l1 <> nil -> pos_Rl (cons_Rlist l1 l2) 0 = pos_Rl l1 0. +Proof. + simple induction l1; [ intros; elim H; reflexivity | intros; reflexivity ]. Qed. Lemma RList_P23 : - forall l1 l2:Rlist, - Rlength (cons_Rlist l1 l2) = (Rlength l1 + Rlength l2)%nat. -simple induction l1; - [ intro; reflexivity | intros; simpl in |- *; rewrite H; reflexivity ]. + forall l1 l2:Rlist, + Rlength (cons_Rlist l1 l2) = (Rlength l1 + Rlength l2)%nat. +Proof. + simple induction l1; + [ intro; reflexivity | intros; simpl in |- *; rewrite H; reflexivity ]. Qed. Lemma RList_P24 : - forall l1 l2:Rlist, - l2 <> nil -> - pos_Rl (cons_Rlist l1 l2) (pred (Rlength (cons_Rlist l1 l2))) = - pos_Rl l2 (pred (Rlength l2)). -simple induction l1. -intros; reflexivity. -intros; rewrite <- (H l2 H0); induction l2 as [| r1 l2 Hrecl2]. -elim H0; reflexivity. -do 2 rewrite RList_P23; - replace (Rlength (cons r r0) + Rlength (cons r1 l2))%nat with - (S (S (Rlength r0 + Rlength l2))); - [ replace (Rlength r0 + Rlength (cons r1 l2))%nat with - (S (Rlength r0 + Rlength l2)); - [ reflexivity - | simpl in |- *; apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; - rewrite S_INR; ring ] - | simpl in |- *; apply INR_eq; do 3 rewrite S_INR; do 2 rewrite plus_INR; - rewrite S_INR; ring ]. + forall l1 l2:Rlist, + l2 <> nil -> + pos_Rl (cons_Rlist l1 l2) (pred (Rlength (cons_Rlist l1 l2))) = + pos_Rl l2 (pred (Rlength l2)). +Proof. + simple induction l1. + intros; reflexivity. + intros; rewrite <- (H l2 H0); induction l2 as [| r1 l2 Hrecl2]. + elim H0; reflexivity. + do 2 rewrite RList_P23; + replace (Rlength (cons r r0) + Rlength (cons r1 l2))%nat with + (S (S (Rlength r0 + Rlength l2))); + [ replace (Rlength r0 + Rlength (cons r1 l2))%nat with + (S (Rlength r0 + Rlength l2)); + [ reflexivity + | simpl in |- *; apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; + rewrite S_INR; ring ] + | simpl in |- *; apply INR_eq; do 3 rewrite S_INR; do 2 rewrite plus_INR; + rewrite S_INR; ring ]. Qed. Lemma RList_P25 : - forall l1 l2:Rlist, - ordered_Rlist l1 -> - ordered_Rlist l2 -> - pos_Rl l1 (pred (Rlength l1)) <= pos_Rl l2 0 -> - ordered_Rlist (cons_Rlist l1 l2). -simple induction l1. -intros; simpl in |- *; assumption. -simple induction r0. -intros; simpl in |- *; simpl in H2; unfold ordered_Rlist in |- *; intros; - simpl in H3. -induction i as [| i Hreci]. -simpl in |- *; assumption. -change (pos_Rl l2 i <= pos_Rl l2 (S i)) in |- *; apply (H1 i); apply lt_S_n; - replace (S (pred (Rlength l2))) with (Rlength l2); - [ assumption - | apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; - rewrite <- H4 in H3; elim (lt_n_O _ H3) ]. -intros; clear H; assert (H : ordered_Rlist (cons_Rlist (cons r1 r2) l2)). -apply H0; try assumption. -apply RList_P4 with r; assumption. -unfold ordered_Rlist in |- *; intros; simpl in H4; - induction i as [| i Hreci]. -simpl in |- *; apply (H1 0%nat); simpl in |- *; apply lt_O_Sn. -change - (pos_Rl (cons_Rlist (cons r1 r2) l2) i <= - pos_Rl (cons_Rlist (cons r1 r2) l2) (S i)) in |- *; - apply (H i); simpl in |- *; apply lt_S_n; assumption. + forall l1 l2:Rlist, + ordered_Rlist l1 -> + ordered_Rlist l2 -> + pos_Rl l1 (pred (Rlength l1)) <= pos_Rl l2 0 -> + ordered_Rlist (cons_Rlist l1 l2). +Proof. + simple induction l1. + intros; simpl in |- *; assumption. + simple induction r0. + intros; simpl in |- *; simpl in H2; unfold ordered_Rlist in |- *; intros; + simpl in H3. + induction i as [| i Hreci]. + simpl in |- *; assumption. + change (pos_Rl l2 i <= pos_Rl l2 (S i)) in |- *; apply (H1 i); apply lt_S_n; + replace (S (pred (Rlength l2))) with (Rlength l2); + [ assumption + | apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; + rewrite <- H4 in H3; elim (lt_n_O _ H3) ]. + intros; clear H; assert (H : ordered_Rlist (cons_Rlist (cons r1 r2) l2)). + apply H0; try assumption. + apply RList_P4 with r; assumption. + unfold ordered_Rlist in |- *; intros; simpl in H4; + induction i as [| i Hreci]. + simpl in |- *; apply (H1 0%nat); simpl in |- *; apply lt_O_Sn. + change + (pos_Rl (cons_Rlist (cons r1 r2) l2) i <= + pos_Rl (cons_Rlist (cons r1 r2) l2) (S i)) in |- *; + apply (H i); simpl in |- *; apply lt_S_n; assumption. Qed. Lemma RList_P26 : - forall (l1 l2:Rlist) (i:nat), - (i < Rlength l1)%nat -> pos_Rl (cons_Rlist l1 l2) i = pos_Rl l1 i. -simple induction l1. -intros; elim (lt_n_O _ H). -intros; induction i as [| i Hreci]. -apply RList_P22; discriminate. -apply (H l2 i); simpl in H0; apply lt_S_n; assumption. + forall (l1 l2:Rlist) (i:nat), + (i < Rlength l1)%nat -> pos_Rl (cons_Rlist l1 l2) i = pos_Rl l1 i. +Proof. + simple induction l1. + intros; elim (lt_n_O _ H). + intros; induction i as [| i Hreci]. + apply RList_P22; discriminate. + apply (H l2 i); simpl in H0; apply lt_S_n; assumption. Qed. Lemma RList_P27 : - forall l1 l2 l3:Rlist, - cons_Rlist l1 (cons_Rlist l2 l3) = cons_Rlist (cons_Rlist l1 l2) l3. -simple induction l1; intros; - [ reflexivity | simpl in |- *; rewrite (H l2 l3); reflexivity ]. + forall l1 l2 l3:Rlist, + cons_Rlist l1 (cons_Rlist l2 l3) = cons_Rlist (cons_Rlist l1 l2) l3. +Proof. + simple induction l1; intros; + [ reflexivity | simpl in |- *; rewrite (H l2 l3); reflexivity ]. Qed. Lemma RList_P28 : forall l:Rlist, cons_Rlist l nil = l. -simple induction l; - [ reflexivity | intros; simpl in |- *; rewrite H; reflexivity ]. +Proof. + simple induction l; + [ reflexivity | intros; simpl in |- *; rewrite H; reflexivity ]. Qed. Lemma RList_P29 : - forall (l2 l1:Rlist) (i:nat), - (Rlength l1 <= i)%nat -> - (i < Rlength (cons_Rlist l1 l2))%nat -> - pos_Rl (cons_Rlist l1 l2) i = pos_Rl l2 (i - Rlength l1). -simple induction l2. -intros; rewrite RList_P28 in H0; elim (lt_irrefl _ (le_lt_trans _ _ _ H H0)). -intros; - replace (cons_Rlist l1 (cons r r0)) with - (cons_Rlist (cons_Rlist l1 (cons r nil)) r0). -inversion H0. -rewrite <- minus_n_n; simpl in |- *; rewrite RList_P26. -clear l2 r0 H i H0 H1 H2; induction l1 as [| r0 l1 Hrecl1]. -reflexivity. -simpl in |- *; assumption. -rewrite RList_P23; rewrite plus_comm; simpl in |- *; apply lt_n_Sn. -replace (S m - Rlength l1)%nat with (S (S m - S (Rlength l1))). -rewrite H3; simpl in |- *; - replace (S (Rlength l1)) with (Rlength (cons_Rlist l1 (cons r nil))). -apply (H (cons_Rlist l1 (cons r nil)) i). -rewrite RList_P23; rewrite plus_comm; simpl in |- *; rewrite <- H3; - apply le_n_S; assumption. -repeat rewrite RList_P23; simpl in |- *; rewrite RList_P23 in H1; - rewrite plus_comm in H1; simpl in H1; rewrite (plus_comm (Rlength l1)); - simpl in |- *; rewrite plus_comm; apply H1. -rewrite RList_P23; rewrite plus_comm; reflexivity. -change (S (m - Rlength l1) = (S m - Rlength l1)%nat) in |- *; - apply minus_Sn_m; assumption. -replace (cons r r0) with (cons_Rlist (cons r nil) r0); - [ symmetry in |- *; apply RList_P27 | reflexivity ]. + forall (l2 l1:Rlist) (i:nat), + (Rlength l1 <= i)%nat -> + (i < Rlength (cons_Rlist l1 l2))%nat -> + pos_Rl (cons_Rlist l1 l2) i = pos_Rl l2 (i - Rlength l1). +Proof. + simple induction l2. + intros; rewrite RList_P28 in H0; elim (lt_irrefl _ (le_lt_trans _ _ _ H H0)). + intros; + replace (cons_Rlist l1 (cons r r0)) with + (cons_Rlist (cons_Rlist l1 (cons r nil)) r0). + inversion H0. + rewrite <- minus_n_n; simpl in |- *; rewrite RList_P26. + clear l2 r0 H i H0 H1 H2; induction l1 as [| r0 l1 Hrecl1]. + reflexivity. + simpl in |- *; assumption. + rewrite RList_P23; rewrite plus_comm; simpl in |- *; apply lt_n_Sn. + replace (S m - Rlength l1)%nat with (S (S m - S (Rlength l1))). + rewrite H3; simpl in |- *; + replace (S (Rlength l1)) with (Rlength (cons_Rlist l1 (cons r nil))). + apply (H (cons_Rlist l1 (cons r nil)) i). + rewrite RList_P23; rewrite plus_comm; simpl in |- *; rewrite <- H3; + apply le_n_S; assumption. + repeat rewrite RList_P23; simpl in |- *; rewrite RList_P23 in H1; + rewrite plus_comm in H1; simpl in H1; rewrite (plus_comm (Rlength l1)); + simpl in |- *; rewrite plus_comm; apply H1. + rewrite RList_P23; rewrite plus_comm; reflexivity. + change (S (m - Rlength l1) = (S m - Rlength l1)%nat) in |- *; + apply minus_Sn_m; assumption. + replace (cons r r0) with (cons_Rlist (cons r nil) r0); + [ symmetry in |- *; apply RList_P27 | reflexivity ]. Qed. diff --git a/theories/Reals/R_Ifp.v b/theories/Reals/R_Ifp.v index 97355238..82d7bebd 100644 --- a/theories/Reals/R_Ifp.v +++ b/theories/Reals/R_Ifp.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: R_Ifp.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: R_Ifp.v 9245 2006-10-17 12:53:34Z notin $ i*) (**********************************************************) (** Complements for the reals.Integer and fractional part *) @@ -18,7 +18,7 @@ Require Import Omega. Open Local Scope R_scope. (*********************************************************) -(** Fractional part *) +(** * Fractional part *) (*********************************************************) (**********) @@ -29,517 +29,534 @@ Definition frac_part (r:R) : R := r - IZR (Int_part r). (**********) Lemma tech_up : forall (r:R) (z:Z), r < IZR z -> IZR z <= r + 1 -> z = up r. -intros; generalize (archimed r); intro; elim H1; intros; clear H1; - unfold Rgt in H2; unfold Rminus in H3; - generalize (Rplus_le_compat_l r (IZR (up r) + - r) 1 H3); - intro; clear H3; rewrite (Rplus_comm (IZR (up r)) (- r)) in H1; - rewrite <- (Rplus_assoc r (- r) (IZR (up r))) in H1; - rewrite (Rplus_opp_r r) in H1; elim (Rplus_ne (IZR (up r))); - intros a b; rewrite b in H1; clear a b; apply (single_z_r_R1 r z (up r)); - auto with zarith real. +Proof. + intros; generalize (archimed r); intro; elim H1; intros; clear H1; + unfold Rgt in H2; unfold Rminus in H3; + generalize (Rplus_le_compat_l r (IZR (up r) + - r) 1 H3); + intro; clear H3; rewrite (Rplus_comm (IZR (up r)) (- r)) in H1; + rewrite <- (Rplus_assoc r (- r) (IZR (up r))) in H1; + rewrite (Rplus_opp_r r) in H1; elim (Rplus_ne (IZR (up r))); + intros a b; rewrite b in H1; clear a b; apply (single_z_r_R1 r z (up r)); + auto with zarith real. Qed. (**********) Lemma up_tech : - forall (r:R) (z:Z), IZR z <= r -> r < IZR (z + 1) -> (z + 1)%Z = up r. -intros; generalize (Rplus_le_compat_l 1 (IZR z) r H); intro; clear H; - rewrite (Rplus_comm 1 (IZR z)) in H1; rewrite (Rplus_comm 1 r) in H1; - cut (1 = IZR 1); auto with zarith real. -intro; generalize H1; pattern 1 at 1 in |- *; rewrite H; intro; clear H H1; - rewrite <- (plus_IZR z 1) in H2; apply (tech_up r (z + 1)); - auto with zarith real. + forall (r:R) (z:Z), IZR z <= r -> r < IZR (z + 1) -> (z + 1)%Z = up r. +Proof. + intros; generalize (Rplus_le_compat_l 1 (IZR z) r H); intro; clear H; + rewrite (Rplus_comm 1 (IZR z)) in H1; rewrite (Rplus_comm 1 r) in H1; + cut (1 = IZR 1); auto with zarith real. + intro; generalize H1; pattern 1 at 1 in |- *; rewrite H; intro; clear H H1; + rewrite <- (plus_IZR z 1) in H2; apply (tech_up r (z + 1)); + auto with zarith real. Qed. (**********) Lemma fp_R0 : frac_part 0 = 0. -unfold frac_part in |- *; unfold Int_part in |- *; elim (archimed 0); intros; - unfold Rminus in |- *; elim (Rplus_ne (- IZR (up 0 - 1))); - intros a b; rewrite b; clear a b; rewrite <- Z_R_minus; - cut (up 0 = 1%Z). -intro; rewrite H1; - rewrite (Rminus_diag_eq (IZR 1) (IZR 1) (refl_equal (IZR 1))); - apply Ropp_0. -elim (archimed 0); intros; clear H2; unfold Rgt in H1; - rewrite (Rminus_0_r (IZR (up 0))) in H0; generalize (lt_O_IZR (up 0) H1); - intro; clear H1; generalize (le_IZR_R1 (up 0) H0); - intro; clear H H0; omega. +Proof. + unfold frac_part in |- *; unfold Int_part in |- *; elim (archimed 0); intros; + unfold Rminus in |- *; elim (Rplus_ne (- IZR (up 0 - 1))); + intros a b; rewrite b; clear a b; rewrite <- Z_R_minus; + cut (up 0 = 1%Z). + intro; rewrite H1; + rewrite (Rminus_diag_eq (IZR 1) (IZR 1) (refl_equal (IZR 1))); + apply Ropp_0. + elim (archimed 0); intros; clear H2; unfold Rgt in H1; + rewrite (Rminus_0_r (IZR (up 0))) in H0; generalize (lt_O_IZR (up 0) H1); + intro; clear H1; generalize (le_IZR_R1 (up 0) H0); + intro; clear H H0; omega. Qed. (**********) Lemma for_base_fp : forall r:R, IZR (up r) - r > 0 /\ IZR (up r) - r <= 1. -intro; split; cut (IZR (up r) > r /\ IZR (up r) - r <= 1). -intro; elim H; intros. -apply (Rgt_minus (IZR (up r)) r H0). -apply archimed. -intro; elim H; intros. -exact H1. -apply archimed. +Proof. + intro; split; cut (IZR (up r) > r /\ IZR (up r) - r <= 1). + intro; elim H; intros. + apply (Rgt_minus (IZR (up r)) r H0). + apply archimed. + intro; elim H; intros. + exact H1. + apply archimed. Qed. (**********) Lemma base_fp : forall r:R, frac_part r >= 0 /\ frac_part r < 1. -intro; unfold frac_part in |- *; unfold Int_part in |- *; split. +Proof. + intro; unfold frac_part in |- *; unfold Int_part in |- *; split. (*sup a O*) -cut (r - IZR (up r) >= -1). -rewrite <- Z_R_minus; simpl in |- *; intro; unfold Rminus in |- *; - rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; - fold (r - IZR (up r)) in |- *; fold (r - IZR (up r) - -1) in |- *; - apply Rge_minus; auto with zarith real. -rewrite <- Ropp_minus_distr; apply Ropp_le_ge_contravar; elim (for_base_fp r); - auto with zarith real. + cut (r - IZR (up r) >= -1). + rewrite <- Z_R_minus; simpl in |- *; intro; unfold Rminus in |- *; + rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; + fold (r - IZR (up r)) in |- *; fold (r - IZR (up r) - -1) in |- *; + apply Rge_minus; auto with zarith real. + rewrite <- Ropp_minus_distr; apply Ropp_le_ge_contravar; elim (for_base_fp r); + auto with zarith real. (*inf a 1*) -cut (r - IZR (up r) < 0). -rewrite <- Z_R_minus; simpl in |- *; intro; unfold Rminus in |- *; - rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; - fold (r - IZR (up r)) in |- *; rewrite Ropp_involutive; - elim (Rplus_ne 1); intros a b; pattern 1 at 2 in |- *; - rewrite <- a; clear a b; rewrite (Rplus_comm (r - IZR (up r)) 1); - apply Rplus_lt_compat_l; auto with zarith real. -elim (for_base_fp r); intros; rewrite <- Ropp_0; rewrite <- Ropp_minus_distr; - apply Ropp_gt_lt_contravar; auto with zarith real. + cut (r - IZR (up r) < 0). + rewrite <- Z_R_minus; simpl in |- *; intro; unfold Rminus in |- *; + rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; + fold (r - IZR (up r)) in |- *; rewrite Ropp_involutive; + elim (Rplus_ne 1); intros a b; pattern 1 at 2 in |- *; + rewrite <- a; clear a b; rewrite (Rplus_comm (r - IZR (up r)) 1); + apply Rplus_lt_compat_l; auto with zarith real. + elim (for_base_fp r); intros; rewrite <- Ropp_0; rewrite <- Ropp_minus_distr; + apply Ropp_gt_lt_contravar; auto with zarith real. Qed. (*********************************************************) -(** Properties *) +(** * Properties *) (*********************************************************) (**********) Lemma base_Int_part : - forall r:R, IZR (Int_part r) <= r /\ IZR (Int_part r) - r > -1. -intro; unfold Int_part in |- *; elim (archimed r); intros. -split; rewrite <- (Z_R_minus (up r) 1); simpl in |- *. -generalize (Rle_minus (IZR (up r) - r) 1 H0); intro; unfold Rminus in H1; - rewrite (Rplus_assoc (IZR (up r)) (- r) (-1)) in H1; - rewrite (Rplus_comm (- r) (-1)) in H1; - rewrite <- (Rplus_assoc (IZR (up r)) (-1) (- r)) in H1; - fold (IZR (up r) - 1) in H1; fold (IZR (up r) - 1 - r) in H1; - apply Rminus_le; auto with zarith real. -generalize (Rplus_gt_compat_l (-1) (IZR (up r)) r H); intro; - rewrite (Rplus_comm (-1) (IZR (up r))) in H1; - generalize (Rplus_gt_compat_l (- r) (IZR (up r) + -1) (-1 + r) H1); - intro; clear H H0 H1; rewrite (Rplus_comm (- r) (IZR (up r) + -1)) in H2; - fold (IZR (up r) - 1) in H2; fold (IZR (up r) - 1 - r) in H2; - rewrite (Rplus_comm (- r) (-1 + r)) in H2; - rewrite (Rplus_assoc (-1) r (- r)) in H2; rewrite (Rplus_opp_r r) in H2; - elim (Rplus_ne (-1)); intros a b; rewrite a in H2; - clear a b; auto with zarith real. + forall r:R, IZR (Int_part r) <= r /\ IZR (Int_part r) - r > -1. +Proof. + intro; unfold Int_part in |- *; elim (archimed r); intros. + split; rewrite <- (Z_R_minus (up r) 1); simpl in |- *. + generalize (Rle_minus (IZR (up r) - r) 1 H0); intro; unfold Rminus in H1; + rewrite (Rplus_assoc (IZR (up r)) (- r) (-1)) in H1; + rewrite (Rplus_comm (- r) (-1)) in H1; + rewrite <- (Rplus_assoc (IZR (up r)) (-1) (- r)) in H1; + fold (IZR (up r) - 1) in H1; fold (IZR (up r) - 1 - r) in H1; + apply Rminus_le; auto with zarith real. + generalize (Rplus_gt_compat_l (-1) (IZR (up r)) r H); intro; + rewrite (Rplus_comm (-1) (IZR (up r))) in H1; + generalize (Rplus_gt_compat_l (- r) (IZR (up r) + -1) (-1 + r) H1); + intro; clear H H0 H1; rewrite (Rplus_comm (- r) (IZR (up r) + -1)) in H2; + fold (IZR (up r) - 1) in H2; fold (IZR (up r) - 1 - r) in H2; + rewrite (Rplus_comm (- r) (-1 + r)) in H2; + rewrite (Rplus_assoc (-1) r (- r)) in H2; rewrite (Rplus_opp_r r) in H2; + elim (Rplus_ne (-1)); intros a b; rewrite a in H2; + clear a b; auto with zarith real. Qed. (**********) Lemma Int_part_INR : forall n:nat, Int_part (INR n) = Z_of_nat n. -intros n; unfold Int_part in |- *. -cut (up (INR n) = (Z_of_nat n + Z_of_nat 1)%Z). -intros H'; rewrite H'; simpl in |- *; ring. -apply sym_equal; apply tech_up; auto. -replace (Z_of_nat n + Z_of_nat 1)%Z with (Z_of_nat (S n)). -repeat rewrite <- INR_IZR_INZ. -apply lt_INR; auto. -rewrite Zplus_comm; rewrite <- Znat.inj_plus; simpl in |- *; auto. -rewrite plus_IZR; simpl in |- *; auto with real. -repeat rewrite <- INR_IZR_INZ; auto with real. +Proof. + intros n; unfold Int_part in |- *. + cut (up (INR n) = (Z_of_nat n + Z_of_nat 1)%Z). + intros H'; rewrite H'; simpl in |- *; ring. + apply sym_equal; apply tech_up; auto. + replace (Z_of_nat n + Z_of_nat 1)%Z with (Z_of_nat (S n)). + repeat rewrite <- INR_IZR_INZ. + apply lt_INR; auto. + rewrite Zplus_comm; rewrite <- Znat.inj_plus; simpl in |- *; auto. + rewrite plus_IZR; simpl in |- *; auto with real. + repeat rewrite <- INR_IZR_INZ; auto with real. Qed. (**********) Lemma fp_nat : forall r:R, frac_part r = 0 -> exists c : Z, r = IZR c. -unfold frac_part in |- *; intros; split with (Int_part r); - apply Rminus_diag_uniq; auto with zarith real. +Proof. + unfold frac_part in |- *; intros; split with (Int_part r); + apply Rminus_diag_uniq; auto with zarith real. Qed. (**********) Lemma R0_fp_O : forall r:R, 0 <> frac_part r -> 0 <> r. -red in |- *; intros; rewrite <- H0 in H; generalize fp_R0; intro; - auto with zarith real. +Proof. + red in |- *; intros; rewrite <- H0 in H; generalize fp_R0; intro; + auto with zarith real. Qed. (**********) Lemma Rminus_Int_part1 : - forall r1 r2:R, - frac_part r1 >= frac_part r2 -> - Int_part (r1 - r2) = (Int_part r1 - Int_part r2)%Z. -intros; elim (base_fp r1); elim (base_fp r2); intros; - generalize (Rge_le (frac_part r2) 0 H0); intro; clear H0; - generalize (Ropp_le_ge_contravar 0 (frac_part r2) H4); - intro; clear H4; rewrite Ropp_0 in H0; - generalize (Rge_le 0 (- frac_part r2) H0); intro; - clear H0; generalize (Rge_le (frac_part r1) 0 H2); - intro; clear H2; generalize (Ropp_lt_gt_contravar (frac_part r2) 1 H1); - intro; clear H1; unfold Rgt in H2; - generalize - (sum_inequa_Rle_lt 0 (frac_part r1) 1 (-1) (- frac_part r2) 0 H0 H3 H2 H4); - intro; elim H1; intros; clear H1; elim (Rplus_ne 1); - intros a b; rewrite a in H6; clear a b H5; - generalize (Rge_minus (frac_part r1) (frac_part r2) H); - intro; clear H; fold (frac_part r1 - frac_part r2) in H6; - generalize (Rge_le (frac_part r1 - frac_part r2) 0 H1); - intro; clear H1 H3 H4 H0 H2; unfold frac_part in H6, H; - unfold Rminus in H6, H; - rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H; - rewrite (Ropp_involutive (IZR (Int_part r2))) in H; - rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2))) - in H; - rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2))) - in H; rewrite (Rplus_comm (- IZR (Int_part r1)) (- r2)) in H; - rewrite (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))) in H; - rewrite <- (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2))) - in H; rewrite (Rplus_comm (- IZR (Int_part r1)) (IZR (Int_part r2))) in H; - fold (r1 - r2) in H; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H; - generalize - (Rplus_le_compat_l (IZR (Int_part r1) - IZR (Int_part r2)) 0 - (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) H); - intro; clear H; - rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H0; - rewrite <- - (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2)) - (IZR (Int_part r2) - IZR (Int_part r1)) (r1 - r2)) - in H0; unfold Rminus in H0; fold (r1 - r2) in H0; - rewrite - (Rplus_assoc (IZR (Int_part r1)) (- IZR (Int_part r2)) - (IZR (Int_part r2) + - IZR (Int_part r1))) in H0; - rewrite <- - (Rplus_assoc (- IZR (Int_part r2)) (IZR (Int_part r2)) - (- IZR (Int_part r1))) in H0; - rewrite (Rplus_opp_l (IZR (Int_part r2))) in H0; - elim (Rplus_ne (- IZR (Int_part r1))); intros a b; - rewrite b in H0; clear a b; - elim (Rplus_ne (IZR (Int_part r1) + - IZR (Int_part r2))); - intros a b; rewrite a in H0; clear a b; - rewrite (Rplus_opp_r (IZR (Int_part r1))) in H0; elim (Rplus_ne (r1 - r2)); - intros a b; rewrite b in H0; clear a b; - fold (IZR (Int_part r1) - IZR (Int_part r2)) in H0; - rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H6; - rewrite (Ropp_involutive (IZR (Int_part r2))) in H6; - rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2))) - in H6; - rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2))) - in H6; rewrite (Rplus_comm (- IZR (Int_part r1)) (- r2)) in H6; - rewrite (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))) in H6; - rewrite <- (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2))) - in H6; - rewrite (Rplus_comm (- IZR (Int_part r1)) (IZR (Int_part r2))) in H6; - fold (r1 - r2) in H6; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H6; - generalize - (Rplus_lt_compat_l (IZR (Int_part r1) - IZR (Int_part r2)) - (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) 1 H6); - intro; clear H6; - rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H; - rewrite <- - (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2)) - (IZR (Int_part r2) - IZR (Int_part r1)) (r1 - r2)) - in H; - rewrite <- (Ropp_minus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H; - rewrite (Rplus_opp_r (IZR (Int_part r1) - IZR (Int_part r2))) in H; - elim (Rplus_ne (r1 - r2)); intros a b; rewrite b in H; - clear a b; rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H0; - rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H; - cut (1 = IZR 1); auto with zarith real. -intro; rewrite H1 in H; clear H1; - rewrite <- (plus_IZR (Int_part r1 - Int_part r2) 1) in H; - generalize (up_tech (r1 - r2) (Int_part r1 - Int_part r2) H0 H); - intros; clear H H0; unfold Int_part at 1 in |- *; - omega. + forall r1 r2:R, + frac_part r1 >= frac_part r2 -> + Int_part (r1 - r2) = (Int_part r1 - Int_part r2)%Z. +Proof. + intros; elim (base_fp r1); elim (base_fp r2); intros; + generalize (Rge_le (frac_part r2) 0 H0); intro; clear H0; + generalize (Ropp_le_ge_contravar 0 (frac_part r2) H4); + intro; clear H4; rewrite Ropp_0 in H0; + generalize (Rge_le 0 (- frac_part r2) H0); intro; + clear H0; generalize (Rge_le (frac_part r1) 0 H2); + intro; clear H2; generalize (Ropp_lt_gt_contravar (frac_part r2) 1 H1); + intro; clear H1; unfold Rgt in H2; + generalize + (sum_inequa_Rle_lt 0 (frac_part r1) 1 (-1) (- frac_part r2) 0 H0 H3 H2 H4); + intro; elim H1; intros; clear H1; elim (Rplus_ne 1); + intros a b; rewrite a in H6; clear a b H5; + generalize (Rge_minus (frac_part r1) (frac_part r2) H); + intro; clear H; fold (frac_part r1 - frac_part r2) in H6; + generalize (Rge_le (frac_part r1 - frac_part r2) 0 H1); + intro; clear H1 H3 H4 H0 H2; unfold frac_part in H6, H; + unfold Rminus in H6, H; + rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H; + rewrite (Ropp_involutive (IZR (Int_part r2))) in H; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2))) + in H; + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2))) + in H; rewrite (Rplus_comm (- IZR (Int_part r1)) (- r2)) in H; + rewrite (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))) in H; + rewrite <- (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2))) + in H; rewrite (Rplus_comm (- IZR (Int_part r1)) (IZR (Int_part r2))) in H; + fold (r1 - r2) in H; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H; + generalize + (Rplus_le_compat_l (IZR (Int_part r1) - IZR (Int_part r2)) 0 + (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) H); + intro; clear H; + rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H0; + rewrite <- + (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2)) + (IZR (Int_part r2) - IZR (Int_part r1)) (r1 - r2)) + in H0; unfold Rminus in H0; fold (r1 - r2) in H0; + rewrite + (Rplus_assoc (IZR (Int_part r1)) (- IZR (Int_part r2)) + (IZR (Int_part r2) + - IZR (Int_part r1))) in H0; + rewrite <- + (Rplus_assoc (- IZR (Int_part r2)) (IZR (Int_part r2)) + (- IZR (Int_part r1))) in H0; + rewrite (Rplus_opp_l (IZR (Int_part r2))) in H0; + elim (Rplus_ne (- IZR (Int_part r1))); intros a b; + rewrite b in H0; clear a b; + elim (Rplus_ne (IZR (Int_part r1) + - IZR (Int_part r2))); + intros a b; rewrite a in H0; clear a b; + rewrite (Rplus_opp_r (IZR (Int_part r1))) in H0; elim (Rplus_ne (r1 - r2)); + intros a b; rewrite b in H0; clear a b; + fold (IZR (Int_part r1) - IZR (Int_part r2)) in H0; + rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H6; + rewrite (Ropp_involutive (IZR (Int_part r2))) in H6; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2))) + in H6; + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2))) + in H6; rewrite (Rplus_comm (- IZR (Int_part r1)) (- r2)) in H6; + rewrite (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))) in H6; + rewrite <- (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2))) + in H6; + rewrite (Rplus_comm (- IZR (Int_part r1)) (IZR (Int_part r2))) in H6; + fold (r1 - r2) in H6; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H6; + generalize + (Rplus_lt_compat_l (IZR (Int_part r1) - IZR (Int_part r2)) + (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) 1 H6); + intro; clear H6; + rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H; + rewrite <- + (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2)) + (IZR (Int_part r2) - IZR (Int_part r1)) (r1 - r2)) + in H; + rewrite <- (Ropp_minus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H; + rewrite (Rplus_opp_r (IZR (Int_part r1) - IZR (Int_part r2))) in H; + elim (Rplus_ne (r1 - r2)); intros a b; rewrite b in H; + clear a b; rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H0; + rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H; + cut (1 = IZR 1); auto with zarith real. + intro; rewrite H1 in H; clear H1; + rewrite <- (plus_IZR (Int_part r1 - Int_part r2) 1) in H; + generalize (up_tech (r1 - r2) (Int_part r1 - Int_part r2) H0 H); + intros; clear H H0; unfold Int_part at 1 in |- *; + omega. Qed. (**********) Lemma Rminus_Int_part2 : - forall r1 r2:R, - frac_part r1 < frac_part r2 -> - Int_part (r1 - r2) = (Int_part r1 - Int_part r2 - 1)%Z. -intros; elim (base_fp r1); elim (base_fp r2); intros; - generalize (Rge_le (frac_part r2) 0 H0); intro; clear H0; - generalize (Ropp_le_ge_contravar 0 (frac_part r2) H4); - intro; clear H4; rewrite Ropp_0 in H0; - generalize (Rge_le 0 (- frac_part r2) H0); intro; - clear H0; generalize (Rge_le (frac_part r1) 0 H2); - intro; clear H2; generalize (Ropp_lt_gt_contravar (frac_part r2) 1 H1); - intro; clear H1; unfold Rgt in H2; - generalize - (sum_inequa_Rle_lt 0 (frac_part r1) 1 (-1) (- frac_part r2) 0 H0 H3 H2 H4); - intro; elim H1; intros; clear H1; elim (Rplus_ne (-1)); - intros a b; rewrite b in H5; clear a b H6; - generalize (Rlt_minus (frac_part r1) (frac_part r2) H); - intro; clear H; fold (frac_part r1 - frac_part r2) in H5; - clear H3 H4 H0 H2; unfold frac_part in H5, H1; unfold Rminus in H5, H1; - rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H5; - rewrite (Ropp_involutive (IZR (Int_part r2))) in H5; - rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2))) - in H5; - rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2))) - in H5; rewrite (Rplus_comm (- IZR (Int_part r1)) (- r2)) in H5; - rewrite (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))) in H5; - rewrite <- (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2))) - in H5; - rewrite (Rplus_comm (- IZR (Int_part r1)) (IZR (Int_part r2))) in H5; - fold (r1 - r2) in H5; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H5; - generalize - (Rplus_lt_compat_l (IZR (Int_part r1) - IZR (Int_part r2)) (-1) - (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) H5); - intro; clear H5; - rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H; - rewrite <- - (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2)) - (IZR (Int_part r2) - IZR (Int_part r1)) (r1 - r2)) - in H; unfold Rminus in H; fold (r1 - r2) in H; - rewrite - (Rplus_assoc (IZR (Int_part r1)) (- IZR (Int_part r2)) - (IZR (Int_part r2) + - IZR (Int_part r1))) in H; - rewrite <- - (Rplus_assoc (- IZR (Int_part r2)) (IZR (Int_part r2)) - (- IZR (Int_part r1))) in H; - rewrite (Rplus_opp_l (IZR (Int_part r2))) in H; - elim (Rplus_ne (- IZR (Int_part r1))); intros a b; - rewrite b in H; clear a b; rewrite (Rplus_opp_r (IZR (Int_part r1))) in H; - elim (Rplus_ne (r1 - r2)); intros a b; rewrite b in H; - clear a b; fold (IZR (Int_part r1) - IZR (Int_part r2)) in H; - fold (IZR (Int_part r1) - IZR (Int_part r2) - 1) in H; - rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H1; - rewrite (Ropp_involutive (IZR (Int_part r2))) in H1; - rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2))) - in H1; - rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2))) - in H1; rewrite (Rplus_comm (- IZR (Int_part r1)) (- r2)) in H1; - rewrite (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))) in H1; - rewrite <- (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2))) - in H1; - rewrite (Rplus_comm (- IZR (Int_part r1)) (IZR (Int_part r2))) in H1; - fold (r1 - r2) in H1; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H1; - generalize - (Rplus_lt_compat_l (IZR (Int_part r1) - IZR (Int_part r2)) - (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) 0 H1); - intro; clear H1; - rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H0; - rewrite <- - (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2)) - (IZR (Int_part r2) - IZR (Int_part r1)) (r1 - r2)) - in H0; - rewrite <- (Ropp_minus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H0; - rewrite (Rplus_opp_r (IZR (Int_part r1) - IZR (Int_part r2))) in H0; - elim (Rplus_ne (r1 - r2)); intros a b; rewrite b in H0; - clear a b; rewrite <- (Rplus_opp_l 1) in H0; - rewrite <- (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2)) (-1) 1) - in H0; fold (IZR (Int_part r1) - IZR (Int_part r2) - 1) in H0; - rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H0; - rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H; - cut (1 = IZR 1); auto with zarith real. -intro; rewrite H1 in H; rewrite H1 in H0; clear H1; - rewrite (Z_R_minus (Int_part r1 - Int_part r2) 1) in H; - rewrite (Z_R_minus (Int_part r1 - Int_part r2) 1) in H0; - rewrite <- (plus_IZR (Int_part r1 - Int_part r2 - 1) 1) in H0; - generalize (Rlt_le (IZR (Int_part r1 - Int_part r2 - 1)) (r1 - r2) H); - intro; clear H; - generalize (up_tech (r1 - r2) (Int_part r1 - Int_part r2 - 1) H1 H0); - intros; clear H0 H1; unfold Int_part at 1 in |- *; - omega. + forall r1 r2:R, + frac_part r1 < frac_part r2 -> + Int_part (r1 - r2) = (Int_part r1 - Int_part r2 - 1)%Z. +Proof. + intros; elim (base_fp r1); elim (base_fp r2); intros; + generalize (Rge_le (frac_part r2) 0 H0); intro; clear H0; + generalize (Ropp_le_ge_contravar 0 (frac_part r2) H4); + intro; clear H4; rewrite Ropp_0 in H0; + generalize (Rge_le 0 (- frac_part r2) H0); intro; + clear H0; generalize (Rge_le (frac_part r1) 0 H2); + intro; clear H2; generalize (Ropp_lt_gt_contravar (frac_part r2) 1 H1); + intro; clear H1; unfold Rgt in H2; + generalize + (sum_inequa_Rle_lt 0 (frac_part r1) 1 (-1) (- frac_part r2) 0 H0 H3 H2 H4); + intro; elim H1; intros; clear H1; elim (Rplus_ne (-1)); + intros a b; rewrite b in H5; clear a b H6; + generalize (Rlt_minus (frac_part r1) (frac_part r2) H); + intro; clear H; fold (frac_part r1 - frac_part r2) in H5; + clear H3 H4 H0 H2; unfold frac_part in H5, H1; unfold Rminus in H5, H1; + rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H5; + rewrite (Ropp_involutive (IZR (Int_part r2))) in H5; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2))) + in H5; + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2))) + in H5; rewrite (Rplus_comm (- IZR (Int_part r1)) (- r2)) in H5; + rewrite (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))) in H5; + rewrite <- (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2))) + in H5; + rewrite (Rplus_comm (- IZR (Int_part r1)) (IZR (Int_part r2))) in H5; + fold (r1 - r2) in H5; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H5; + generalize + (Rplus_lt_compat_l (IZR (Int_part r1) - IZR (Int_part r2)) (-1) + (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) H5); + intro; clear H5; + rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H; + rewrite <- + (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2)) + (IZR (Int_part r2) - IZR (Int_part r1)) (r1 - r2)) + in H; unfold Rminus in H; fold (r1 - r2) in H; + rewrite + (Rplus_assoc (IZR (Int_part r1)) (- IZR (Int_part r2)) + (IZR (Int_part r2) + - IZR (Int_part r1))) in H; + rewrite <- + (Rplus_assoc (- IZR (Int_part r2)) (IZR (Int_part r2)) + (- IZR (Int_part r1))) in H; + rewrite (Rplus_opp_l (IZR (Int_part r2))) in H; + elim (Rplus_ne (- IZR (Int_part r1))); intros a b; + rewrite b in H; clear a b; rewrite (Rplus_opp_r (IZR (Int_part r1))) in H; + elim (Rplus_ne (r1 - r2)); intros a b; rewrite b in H; + clear a b; fold (IZR (Int_part r1) - IZR (Int_part r2)) in H; + fold (IZR (Int_part r1) - IZR (Int_part r2) - 1) in H; + rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H1; + rewrite (Ropp_involutive (IZR (Int_part r2))) in H1; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2))) + in H1; + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2))) + in H1; rewrite (Rplus_comm (- IZR (Int_part r1)) (- r2)) in H1; + rewrite (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))) in H1; + rewrite <- (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2))) + in H1; + rewrite (Rplus_comm (- IZR (Int_part r1)) (IZR (Int_part r2))) in H1; + fold (r1 - r2) in H1; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H1; + generalize + (Rplus_lt_compat_l (IZR (Int_part r1) - IZR (Int_part r2)) + (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) 0 H1); + intro; clear H1; + rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H0; + rewrite <- + (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2)) + (IZR (Int_part r2) - IZR (Int_part r1)) (r1 - r2)) + in H0; + rewrite <- (Ropp_minus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H0; + rewrite (Rplus_opp_r (IZR (Int_part r1) - IZR (Int_part r2))) in H0; + elim (Rplus_ne (r1 - r2)); intros a b; rewrite b in H0; + clear a b; rewrite <- (Rplus_opp_l 1) in H0; + rewrite <- (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2)) (-1) 1) + in H0; fold (IZR (Int_part r1) - IZR (Int_part r2) - 1) in H0; + rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H0; + rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H; + cut (1 = IZR 1); auto with zarith real. + intro; rewrite H1 in H; rewrite H1 in H0; clear H1; + rewrite (Z_R_minus (Int_part r1 - Int_part r2) 1) in H; + rewrite (Z_R_minus (Int_part r1 - Int_part r2) 1) in H0; + rewrite <- (plus_IZR (Int_part r1 - Int_part r2 - 1) 1) in H0; + generalize (Rlt_le (IZR (Int_part r1 - Int_part r2 - 1)) (r1 - r2) H); + intro; clear H; + generalize (up_tech (r1 - r2) (Int_part r1 - Int_part r2 - 1) H1 H0); + intros; clear H0 H1; unfold Int_part at 1 in |- *; + omega. Qed. (**********) Lemma Rminus_fp1 : - forall r1 r2:R, - frac_part r1 >= frac_part r2 -> - frac_part (r1 - r2) = frac_part r1 - frac_part r2. -intros; unfold frac_part in |- *; generalize (Rminus_Int_part1 r1 r2 H); - intro; rewrite H0; rewrite <- (Z_R_minus (Int_part r1) (Int_part r2)); - unfold Rminus in |- *; - rewrite (Ropp_plus_distr (IZR (Int_part r1)) (- IZR (Int_part r2))); - rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))); - rewrite (Ropp_involutive (IZR (Int_part r2))); - rewrite (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2))); - rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2))); - rewrite <- (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))); - rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2))); - rewrite (Rplus_comm (- r2) (- IZR (Int_part r1))); - auto with zarith real. + forall r1 r2:R, + frac_part r1 >= frac_part r2 -> + frac_part (r1 - r2) = frac_part r1 - frac_part r2. +Proof. + intros; unfold frac_part in |- *; generalize (Rminus_Int_part1 r1 r2 H); + intro; rewrite H0; rewrite <- (Z_R_minus (Int_part r1) (Int_part r2)); + unfold Rminus in |- *; + rewrite (Ropp_plus_distr (IZR (Int_part r1)) (- IZR (Int_part r2))); + rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))); + rewrite (Ropp_involutive (IZR (Int_part r2))); + rewrite (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2))); + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2))); + rewrite <- (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))); + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2))); + rewrite (Rplus_comm (- r2) (- IZR (Int_part r1))); + auto with zarith real. Qed. (**********) Lemma Rminus_fp2 : - forall r1 r2:R, - frac_part r1 < frac_part r2 -> - frac_part (r1 - r2) = frac_part r1 - frac_part r2 + 1. -intros; unfold frac_part in |- *; generalize (Rminus_Int_part2 r1 r2 H); - intro; rewrite H0; rewrite <- (Z_R_minus (Int_part r1 - Int_part r2) 1); - rewrite <- (Z_R_minus (Int_part r1) (Int_part r2)); - unfold Rminus in |- *; - rewrite - (Ropp_plus_distr (IZR (Int_part r1) + - IZR (Int_part r2)) (- IZR 1)) - ; rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))); - rewrite (Ropp_involutive (IZR 1)); - rewrite (Ropp_involutive (IZR (Int_part r2))); - rewrite (Ropp_plus_distr (IZR (Int_part r1))); - rewrite (Ropp_involutive (IZR (Int_part r2))); simpl in |- *; - rewrite <- - (Rplus_assoc (r1 + - r2) (- IZR (Int_part r1) + IZR (Int_part r2)) 1) - ; rewrite (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2))); - rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2))); - rewrite <- (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))); - rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2))); - rewrite (Rplus_comm (- r2) (- IZR (Int_part r1))); - auto with zarith real. + forall r1 r2:R, + frac_part r1 < frac_part r2 -> + frac_part (r1 - r2) = frac_part r1 - frac_part r2 + 1. +Proof. + intros; unfold frac_part in |- *; generalize (Rminus_Int_part2 r1 r2 H); + intro; rewrite H0; rewrite <- (Z_R_minus (Int_part r1 - Int_part r2) 1); + rewrite <- (Z_R_minus (Int_part r1) (Int_part r2)); + unfold Rminus in |- *; + rewrite + (Ropp_plus_distr (IZR (Int_part r1) + - IZR (Int_part r2)) (- IZR 1)) + ; rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))); + rewrite (Ropp_involutive (IZR 1)); + rewrite (Ropp_involutive (IZR (Int_part r2))); + rewrite (Ropp_plus_distr (IZR (Int_part r1))); + rewrite (Ropp_involutive (IZR (Int_part r2))); simpl in |- *; + rewrite <- + (Rplus_assoc (r1 + - r2) (- IZR (Int_part r1) + IZR (Int_part r2)) 1) + ; rewrite (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2))); + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2))); + rewrite <- (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))); + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2))); + rewrite (Rplus_comm (- r2) (- IZR (Int_part r1))); + auto with zarith real. Qed. (**********) Lemma plus_Int_part1 : - forall r1 r2:R, - frac_part r1 + frac_part r2 >= 1 -> - Int_part (r1 + r2) = (Int_part r1 + Int_part r2 + 1)%Z. -intros; generalize (Rge_le (frac_part r1 + frac_part r2) 1 H); intro; clear H; - elim (base_fp r1); elim (base_fp r2); intros; clear H H2; - generalize (Rplus_lt_compat_l (frac_part r2) (frac_part r1) 1 H3); - intro; clear H3; generalize (Rplus_lt_compat_l 1 (frac_part r2) 1 H1); - intro; clear H1; rewrite (Rplus_comm 1 (frac_part r2)) in H2; - generalize - (Rlt_trans (frac_part r2 + frac_part r1) (frac_part r2 + 1) 2 H H2); - intro; clear H H2; rewrite (Rplus_comm (frac_part r2) (frac_part r1)) in H1; - unfold frac_part in H0, H1; unfold Rminus in H0, H1; - rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))) - in H1; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H1; - rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2) - in H1; - rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H1; - rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))) - in H1; - rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H1; - rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))) - in H0; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H0; - rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2) - in H0; - rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H0; - rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))) - in H0; - rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H0; - generalize - (Rplus_le_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) 1 - (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) H0); - intro; clear H0; - generalize - (Rplus_lt_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) - (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) 2 H1); - intro; clear H1; - rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2)))) - in H; - rewrite <- - (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) - (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2)) - in H; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H; - elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H; - clear a b; - rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2)))) - in H0; - rewrite <- - (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) - (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2)) - in H0; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H0; - elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H0; - clear a b; - rewrite <- (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) 1 1) in H0; - cut (1 = IZR 1); auto with zarith real. -intro; rewrite H1 in H0; rewrite H1 in H; clear H1; - rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H; - rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H0; - rewrite <- (plus_IZR (Int_part r1 + Int_part r2) 1) in H; - rewrite <- (plus_IZR (Int_part r1 + Int_part r2) 1) in H0; - rewrite <- (plus_IZR (Int_part r1 + Int_part r2 + 1) 1) in H0; - generalize (up_tech (r1 + r2) (Int_part r1 + Int_part r2 + 1) H H0); - intro; clear H H0; unfold Int_part at 1 in |- *; omega. + forall r1 r2:R, + frac_part r1 + frac_part r2 >= 1 -> + Int_part (r1 + r2) = (Int_part r1 + Int_part r2 + 1)%Z. +Proof. + intros; generalize (Rge_le (frac_part r1 + frac_part r2) 1 H); intro; clear H; + elim (base_fp r1); elim (base_fp r2); intros; clear H H2; + generalize (Rplus_lt_compat_l (frac_part r2) (frac_part r1) 1 H3); + intro; clear H3; generalize (Rplus_lt_compat_l 1 (frac_part r2) 1 H1); + intro; clear H1; rewrite (Rplus_comm 1 (frac_part r2)) in H2; + generalize + (Rlt_trans (frac_part r2 + frac_part r1) (frac_part r2 + 1) 2 H H2); + intro; clear H H2; rewrite (Rplus_comm (frac_part r2) (frac_part r1)) in H1; + unfold frac_part in H0, H1; unfold Rminus in H0, H1; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))) + in H1; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H1; + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2) + in H1; + rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H1; + rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))) + in H1; + rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H1; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))) + in H0; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H0; + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2) + in H0; + rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H0; + rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))) + in H0; + rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H0; + generalize + (Rplus_le_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) 1 + (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) H0); + intro; clear H0; + generalize + (Rplus_lt_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) + (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) 2 H1); + intro; clear H1; + rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2)))) + in H; + rewrite <- + (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) + (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2)) + in H; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H; + elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H; + clear a b; + rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2)))) + in H0; + rewrite <- + (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) + (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2)) + in H0; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H0; + elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H0; + clear a b; + rewrite <- (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) 1 1) in H0; + cut (1 = IZR 1); auto with zarith real. + intro; rewrite H1 in H0; rewrite H1 in H; clear H1; + rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H; + rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H0; + rewrite <- (plus_IZR (Int_part r1 + Int_part r2) 1) in H; + rewrite <- (plus_IZR (Int_part r1 + Int_part r2) 1) in H0; + rewrite <- (plus_IZR (Int_part r1 + Int_part r2 + 1) 1) in H0; + generalize (up_tech (r1 + r2) (Int_part r1 + Int_part r2 + 1) H H0); + intro; clear H H0; unfold Int_part at 1 in |- *; omega. Qed. (**********) Lemma plus_Int_part2 : - forall r1 r2:R, - frac_part r1 + frac_part r2 < 1 -> - Int_part (r1 + r2) = (Int_part r1 + Int_part r2)%Z. -intros; elim (base_fp r1); elim (base_fp r2); intros; clear H1 H3; - generalize (Rge_le (frac_part r2) 0 H0); intro; clear H0; - generalize (Rge_le (frac_part r1) 0 H2); intro; clear H2; - generalize (Rplus_le_compat_l (frac_part r1) 0 (frac_part r2) H1); - intro; clear H1; elim (Rplus_ne (frac_part r1)); intros a b; - rewrite a in H2; clear a b; - generalize (Rle_trans 0 (frac_part r1) (frac_part r1 + frac_part r2) H0 H2); - intro; clear H0 H2; unfold frac_part in H, H1; unfold Rminus in H, H1; - rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))) - in H1; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H1; - rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2) - in H1; - rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H1; - rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))) - in H1; - rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H1; - rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))) - in H; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H; - rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2) in H; - rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H; - rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))) - in H; - rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H; - generalize - (Rplus_le_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) 0 - (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) H1); - intro; clear H1; - generalize - (Rplus_lt_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) - (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) 1 H); - intro; clear H; - rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2)))) - in H1; - rewrite <- - (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) - (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2)) - in H1; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H1; - elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H1; - clear a b; - rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2)))) - in H0; - rewrite <- - (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) - (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2)) - in H0; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H0; - elim (Rplus_ne (IZR (Int_part r1) + IZR (Int_part r2))); - intros a b; rewrite a in H0; clear a b; elim (Rplus_ne (r1 + r2)); - intros a b; rewrite b in H0; clear a b; cut (1 = IZR 1); - auto with zarith real. -intro; rewrite H in H1; clear H; - rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H0; - rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H1; - rewrite <- (plus_IZR (Int_part r1 + Int_part r2) 1) in H1; - generalize (up_tech (r1 + r2) (Int_part r1 + Int_part r2) H0 H1); - intro; clear H0 H1; unfold Int_part at 1 in |- *; - omega. + forall r1 r2:R, + frac_part r1 + frac_part r2 < 1 -> + Int_part (r1 + r2) = (Int_part r1 + Int_part r2)%Z. +Proof. + intros; elim (base_fp r1); elim (base_fp r2); intros; clear H1 H3; + generalize (Rge_le (frac_part r2) 0 H0); intro; clear H0; + generalize (Rge_le (frac_part r1) 0 H2); intro; clear H2; + generalize (Rplus_le_compat_l (frac_part r1) 0 (frac_part r2) H1); + intro; clear H1; elim (Rplus_ne (frac_part r1)); intros a b; + rewrite a in H2; clear a b; + generalize (Rle_trans 0 (frac_part r1) (frac_part r1 + frac_part r2) H0 H2); + intro; clear H0 H2; unfold frac_part in H, H1; unfold Rminus in H, H1; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))) + in H1; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H1; + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2) + in H1; + rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H1; + rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))) + in H1; + rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H1; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))) + in H; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H; + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2) in H; + rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H; + rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))) + in H; + rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H; + generalize + (Rplus_le_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) 0 + (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) H1); + intro; clear H1; + generalize + (Rplus_lt_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) + (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) 1 H); + intro; clear H; + rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2)))) + in H1; + rewrite <- + (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) + (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2)) + in H1; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H1; + elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H1; + clear a b; + rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2)))) + in H0; + rewrite <- + (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) + (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2)) + in H0; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H0; + elim (Rplus_ne (IZR (Int_part r1) + IZR (Int_part r2))); + intros a b; rewrite a in H0; clear a b; elim (Rplus_ne (r1 + r2)); + intros a b; rewrite b in H0; clear a b; cut (1 = IZR 1); + auto with zarith real. + intro; rewrite H in H1; clear H; + rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H0; + rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H1; + rewrite <- (plus_IZR (Int_part r1 + Int_part r2) 1) in H1; + generalize (up_tech (r1 + r2) (Int_part r1 + Int_part r2) H0 H1); + intro; clear H0 H1; unfold Int_part at 1 in |- *; + omega. Qed. (**********) Lemma plus_frac_part1 : - forall r1 r2:R, - frac_part r1 + frac_part r2 >= 1 -> - frac_part (r1 + r2) = frac_part r1 + frac_part r2 - 1. -intros; unfold frac_part in |- *; generalize (plus_Int_part1 r1 r2 H); intro; - rewrite H0; rewrite (plus_IZR (Int_part r1 + Int_part r2) 1); - rewrite (plus_IZR (Int_part r1) (Int_part r2)); simpl in |- *; - unfold Rminus at 3 4 in |- *; - rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))); - rewrite (Rplus_comm r2 (- IZR (Int_part r2))); - rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2); - rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2); - rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))); - rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))); - unfold Rminus in |- *; - rewrite - (Rplus_assoc (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2))) (-1)) - ; rewrite <- (Ropp_plus_distr (IZR (Int_part r1) + IZR (Int_part r2)) 1); - trivial with zarith real. + forall r1 r2:R, + frac_part r1 + frac_part r2 >= 1 -> + frac_part (r1 + r2) = frac_part r1 + frac_part r2 - 1. +Proof. + intros; unfold frac_part in |- *; generalize (plus_Int_part1 r1 r2 H); intro; + rewrite H0; rewrite (plus_IZR (Int_part r1 + Int_part r2) 1); + rewrite (plus_IZR (Int_part r1) (Int_part r2)); simpl in |- *; + unfold Rminus at 3 4 in |- *; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))); + rewrite (Rplus_comm r2 (- IZR (Int_part r2))); + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2); + rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2); + rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))); + rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))); + unfold Rminus in |- *; + rewrite + (Rplus_assoc (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2))) (-1)) + ; rewrite <- (Ropp_plus_distr (IZR (Int_part r1) + IZR (Int_part r2)) 1); + trivial with zarith real. Qed. (**********) Lemma plus_frac_part2 : - forall r1 r2:R, - frac_part r1 + frac_part r2 < 1 -> - frac_part (r1 + r2) = frac_part r1 + frac_part r2. -intros; unfold frac_part in |- *; generalize (plus_Int_part2 r1 r2 H); intro; - rewrite H0; rewrite (plus_IZR (Int_part r1) (Int_part r2)); - unfold Rminus at 2 3 in |- *; - rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))); - rewrite (Rplus_comm r2 (- IZR (Int_part r2))); - rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2); - rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2); - rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))); - rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))); - unfold Rminus in |- *; trivial with zarith real. -Qed.
\ No newline at end of file + forall r1 r2:R, + frac_part r1 + frac_part r2 < 1 -> + frac_part (r1 + r2) = frac_part r1 + frac_part r2. +Proof. + intros; unfold frac_part in |- *; generalize (plus_Int_part2 r1 r2 H); intro; + rewrite H0; rewrite (plus_IZR (Int_part r1) (Int_part r2)); + unfold Rminus at 2 3 in |- *; + rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))); + rewrite (Rplus_comm r2 (- IZR (Int_part r2))); + rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2); + rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2); + rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))); + rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))); + unfold Rminus in |- *; trivial with zarith real. +Qed. diff --git a/theories/Reals/R_sqr.v b/theories/Reals/R_sqr.v index d87adc24..270ea6da 100644 --- a/theories/Reals/R_sqr.v +++ b/theories/Reals/R_sqr.v @@ -6,325 +6,359 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: R_sqr.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: R_sqr.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rbasic_fun. Open Local Scope R_scope. (****************************************************) -(* Rsqr : some results *) +(** Rsqr : some results *) (****************************************************) Ltac ring_Rsqr := unfold Rsqr in |- *; ring. Lemma Rsqr_neg : forall x:R, Rsqr x = Rsqr (- x). -intros; ring_Rsqr. +Proof. + intros; ring_Rsqr. Qed. Lemma Rsqr_mult : forall x y:R, Rsqr (x * y) = Rsqr x * Rsqr y. -intros; ring_Rsqr. +Proof. + intros; ring_Rsqr. Qed. Lemma Rsqr_plus : forall x y:R, Rsqr (x + y) = Rsqr x + Rsqr y + 2 * x * y. -intros; ring_Rsqr. +Proof. + intros; ring_Rsqr. Qed. Lemma Rsqr_minus : forall x y:R, Rsqr (x - y) = Rsqr x + Rsqr y - 2 * x * y. -intros; ring_Rsqr. +Proof. + intros; ring_Rsqr. Qed. Lemma Rsqr_neg_minus : forall x y:R, Rsqr (x - y) = Rsqr (y - x). -intros; ring_Rsqr. +Proof. + intros; ring_Rsqr. Qed. Lemma Rsqr_1 : Rsqr 1 = 1. -ring_Rsqr. +Proof. + ring_Rsqr. Qed. Lemma Rsqr_gt_0_0 : forall x:R, 0 < Rsqr x -> x <> 0. -intros; red in |- *; intro; rewrite H0 in H; rewrite Rsqr_0 in H; - elim (Rlt_irrefl 0 H). +Proof. + intros; red in |- *; intro; rewrite H0 in H; rewrite Rsqr_0 in H; + elim (Rlt_irrefl 0 H). Qed. Lemma Rsqr_pos_lt : forall x:R, x <> 0 -> 0 < Rsqr x. -intros; case (Rtotal_order 0 x); intro; - [ unfold Rsqr in |- *; apply Rmult_lt_0_compat; assumption - | elim H0; intro; - [ elim H; symmetry in |- *; exact H1 - | rewrite Rsqr_neg; generalize (Ropp_lt_gt_contravar x 0 H1); - rewrite Ropp_0; intro; unfold Rsqr in |- *; - apply Rmult_lt_0_compat; assumption ] ]. +Proof. + intros; case (Rtotal_order 0 x); intro; + [ unfold Rsqr in |- *; apply Rmult_lt_0_compat; assumption + | elim H0; intro; + [ elim H; symmetry in |- *; exact H1 + | rewrite Rsqr_neg; generalize (Ropp_lt_gt_contravar x 0 H1); + rewrite Ropp_0; intro; unfold Rsqr in |- *; + apply Rmult_lt_0_compat; assumption ] ]. Qed. Lemma Rsqr_div : forall x y:R, y <> 0 -> Rsqr (x / y) = Rsqr x / Rsqr y. -intros; unfold Rsqr in |- *. -unfold Rdiv in |- *. -rewrite Rinv_mult_distr. -repeat rewrite Rmult_assoc. -apply Rmult_eq_compat_l. -pattern x at 2 in |- *; rewrite Rmult_comm. -repeat rewrite Rmult_assoc. -apply Rmult_eq_compat_l. -reflexivity. -assumption. -assumption. +Proof. + intros; unfold Rsqr in |- *. + unfold Rdiv in |- *. + rewrite Rinv_mult_distr. + repeat rewrite Rmult_assoc. + apply Rmult_eq_compat_l. + pattern x at 2 in |- *; rewrite Rmult_comm. + repeat rewrite Rmult_assoc. + apply Rmult_eq_compat_l. + reflexivity. + assumption. + assumption. Qed. Lemma Rsqr_eq_0 : forall x:R, Rsqr x = 0 -> x = 0. -unfold Rsqr in |- *; intros; generalize (Rmult_integral x x H); intro; - elim H0; intro; assumption. +Proof. + unfold Rsqr in |- *; intros; generalize (Rmult_integral x x H); intro; + elim H0; intro; assumption. Qed. Lemma Rsqr_minus_plus : forall a b:R, (a - b) * (a + b) = Rsqr a - Rsqr b. -intros; ring_Rsqr. +Proof. + intros; ring_Rsqr. Qed. Lemma Rsqr_plus_minus : forall a b:R, (a + b) * (a - b) = Rsqr a - Rsqr b. -intros; ring_Rsqr. +Proof. + intros; ring_Rsqr. Qed. Lemma Rsqr_incr_0 : - forall x y:R, Rsqr x <= Rsqr y -> 0 <= x -> 0 <= y -> x <= y. -intros; case (Rle_dec x y); intro; - [ assumption - | cut (y < x); - [ intro; unfold Rsqr in H; - generalize (Rmult_le_0_lt_compat y x y x H1 H1 H2 H2); - intro; generalize (Rle_lt_trans (x * x) (y * y) (x * x) H H3); - intro; elim (Rlt_irrefl (x * x) H4) - | auto with real ] ]. + forall x y:R, Rsqr x <= Rsqr y -> 0 <= x -> 0 <= y -> x <= y. +Proof. + intros; case (Rle_dec x y); intro; + [ assumption + | cut (y < x); + [ intro; unfold Rsqr in H; + generalize (Rmult_le_0_lt_compat y x y x H1 H1 H2 H2); + intro; generalize (Rle_lt_trans (x * x) (y * y) (x * x) H H3); + intro; elim (Rlt_irrefl (x * x) H4) + | auto with real ] ]. Qed. Lemma Rsqr_incr_0_var : forall x y:R, Rsqr x <= Rsqr y -> 0 <= y -> x <= y. -intros; case (Rle_dec x y); intro; - [ assumption - | cut (y < x); - [ intro; unfold Rsqr in H; - generalize (Rmult_le_0_lt_compat y x y x H0 H0 H1 H1); - intro; generalize (Rle_lt_trans (x * x) (y * y) (x * x) H H2); - intro; elim (Rlt_irrefl (x * x) H3) - | auto with real ] ]. +Proof. + intros; case (Rle_dec x y); intro; + [ assumption + | cut (y < x); + [ intro; unfold Rsqr in H; + generalize (Rmult_le_0_lt_compat y x y x H0 H0 H1 H1); + intro; generalize (Rle_lt_trans (x * x) (y * y) (x * x) H H2); + intro; elim (Rlt_irrefl (x * x) H3) + | auto with real ] ]. Qed. Lemma Rsqr_incr_1 : - forall x y:R, x <= y -> 0 <= x -> 0 <= y -> Rsqr x <= Rsqr y. -intros; unfold Rsqr in |- *; apply Rmult_le_compat; assumption. + forall x y:R, x <= y -> 0 <= x -> 0 <= y -> Rsqr x <= Rsqr y. +Proof. + intros; unfold Rsqr in |- *; apply Rmult_le_compat; assumption. Qed. Lemma Rsqr_incrst_0 : - forall x y:R, Rsqr x < Rsqr y -> 0 <= x -> 0 <= y -> x < y. -intros; case (Rtotal_order x y); intro; - [ assumption - | elim H2; intro; - [ rewrite H3 in H; elim (Rlt_irrefl (Rsqr y) H) - | generalize (Rmult_le_0_lt_compat y x y x H1 H1 H3 H3); intro; - unfold Rsqr in H; generalize (Rlt_trans (x * x) (y * y) (x * x) H H4); - intro; elim (Rlt_irrefl (x * x) H5) ] ]. + forall x y:R, Rsqr x < Rsqr y -> 0 <= x -> 0 <= y -> x < y. +Proof. + intros; case (Rtotal_order x y); intro; + [ assumption + | elim H2; intro; + [ rewrite H3 in H; elim (Rlt_irrefl (Rsqr y) H) + | generalize (Rmult_le_0_lt_compat y x y x H1 H1 H3 H3); intro; + unfold Rsqr in H; generalize (Rlt_trans (x * x) (y * y) (x * x) H H4); + intro; elim (Rlt_irrefl (x * x) H5) ] ]. Qed. Lemma Rsqr_incrst_1 : - forall x y:R, x < y -> 0 <= x -> 0 <= y -> Rsqr x < Rsqr y. -intros; unfold Rsqr in |- *; apply Rmult_le_0_lt_compat; assumption. + forall x y:R, x < y -> 0 <= x -> 0 <= y -> Rsqr x < Rsqr y. +Proof. + intros; unfold Rsqr in |- *; apply Rmult_le_0_lt_compat; assumption. Qed. Lemma Rsqr_neg_pos_le_0 : - forall x y:R, Rsqr x <= Rsqr y -> 0 <= y -> - y <= x. -intros; case (Rcase_abs x); intro. -generalize (Ropp_lt_gt_contravar x 0 r); rewrite Ropp_0; intro; - generalize (Rlt_le 0 (- x) H1); intro; rewrite (Rsqr_neg x) in H; - generalize (Rsqr_incr_0 (- x) y H H2 H0); intro; - rewrite <- (Ropp_involutive x); apply Ropp_ge_le_contravar; - apply Rle_ge; assumption. -apply Rle_trans with 0; - [ rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; assumption - | apply Rge_le; assumption ]. + forall x y:R, Rsqr x <= Rsqr y -> 0 <= y -> - y <= x. +Proof. + intros; case (Rcase_abs x); intro. + generalize (Ropp_lt_gt_contravar x 0 r); rewrite Ropp_0; intro; + generalize (Rlt_le 0 (- x) H1); intro; rewrite (Rsqr_neg x) in H; + generalize (Rsqr_incr_0 (- x) y H H2 H0); intro; + rewrite <- (Ropp_involutive x); apply Ropp_ge_le_contravar; + apply Rle_ge; assumption. + apply Rle_trans with 0; + [ rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; assumption + | apply Rge_le; assumption ]. Qed. Lemma Rsqr_neg_pos_le_1 : - forall x y:R, - y <= x -> x <= y -> 0 <= y -> Rsqr x <= Rsqr y. -intros; case (Rcase_abs x); intro. -generalize (Ropp_lt_gt_contravar x 0 r); rewrite Ropp_0; intro; - generalize (Rlt_le 0 (- x) H2); intro; - generalize (Ropp_le_ge_contravar (- y) x H); rewrite Ropp_involutive; - intro; generalize (Rge_le y (- x) H4); intro; rewrite (Rsqr_neg x); - apply Rsqr_incr_1; assumption. -generalize (Rge_le x 0 r); intro; apply Rsqr_incr_1; assumption. + forall x y:R, - y <= x -> x <= y -> 0 <= y -> Rsqr x <= Rsqr y. +Proof. + intros; case (Rcase_abs x); intro. + generalize (Ropp_lt_gt_contravar x 0 r); rewrite Ropp_0; intro; + generalize (Rlt_le 0 (- x) H2); intro; + generalize (Ropp_le_ge_contravar (- y) x H); rewrite Ropp_involutive; + intro; generalize (Rge_le y (- x) H4); intro; rewrite (Rsqr_neg x); + apply Rsqr_incr_1; assumption. + generalize (Rge_le x 0 r); intro; apply Rsqr_incr_1; assumption. Qed. Lemma neg_pos_Rsqr_le : forall x y:R, - y <= x -> x <= y -> Rsqr x <= Rsqr y. -intros; case (Rcase_abs x); intro. -generalize (Ropp_lt_gt_contravar x 0 r); rewrite Ropp_0; intro; - generalize (Ropp_le_ge_contravar (- y) x H); rewrite Ropp_involutive; - intro; generalize (Rge_le y (- x) H2); intro; generalize (Rlt_le 0 (- x) H1); - intro; generalize (Rle_trans 0 (- x) y H4 H3); intro; - rewrite (Rsqr_neg x); apply Rsqr_incr_1; assumption. -generalize (Rge_le x 0 r); intro; generalize (Rle_trans 0 x y H1 H0); intro; - apply Rsqr_incr_1; assumption. +Proof. + intros; case (Rcase_abs x); intro. + generalize (Ropp_lt_gt_contravar x 0 r); rewrite Ropp_0; intro; + generalize (Ropp_le_ge_contravar (- y) x H); rewrite Ropp_involutive; + intro; generalize (Rge_le y (- x) H2); intro; generalize (Rlt_le 0 (- x) H1); + intro; generalize (Rle_trans 0 (- x) y H4 H3); intro; + rewrite (Rsqr_neg x); apply Rsqr_incr_1; assumption. + generalize (Rge_le x 0 r); intro; generalize (Rle_trans 0 x y H1 H0); intro; + apply Rsqr_incr_1; assumption. Qed. Lemma Rsqr_abs : forall x:R, Rsqr x = Rsqr (Rabs x). -intro; unfold Rabs in |- *; case (Rcase_abs x); intro; - [ apply Rsqr_neg | reflexivity ]. +Proof. + intro; unfold Rabs in |- *; case (Rcase_abs x); intro; + [ apply Rsqr_neg | reflexivity ]. Qed. Lemma Rsqr_le_abs_0 : forall x y:R, Rsqr x <= Rsqr y -> Rabs x <= Rabs y. -intros; apply Rsqr_incr_0; repeat rewrite <- Rsqr_abs; - [ assumption | apply Rabs_pos | apply Rabs_pos ]. +Proof. + intros; apply Rsqr_incr_0; repeat rewrite <- Rsqr_abs; + [ assumption | apply Rabs_pos | apply Rabs_pos ]. Qed. Lemma Rsqr_le_abs_1 : forall x y:R, Rabs x <= Rabs y -> Rsqr x <= Rsqr y. -intros; rewrite (Rsqr_abs x); rewrite (Rsqr_abs y); - apply (Rsqr_incr_1 (Rabs x) (Rabs y) H (Rabs_pos x) (Rabs_pos y)). +Proof. + intros; rewrite (Rsqr_abs x); rewrite (Rsqr_abs y); + apply (Rsqr_incr_1 (Rabs x) (Rabs y) H (Rabs_pos x) (Rabs_pos y)). Qed. Lemma Rsqr_lt_abs_0 : forall x y:R, Rsqr x < Rsqr y -> Rabs x < Rabs y. -intros; apply Rsqr_incrst_0; repeat rewrite <- Rsqr_abs; - [ assumption | apply Rabs_pos | apply Rabs_pos ]. +Proof. + intros; apply Rsqr_incrst_0; repeat rewrite <- Rsqr_abs; + [ assumption | apply Rabs_pos | apply Rabs_pos ]. Qed. Lemma Rsqr_lt_abs_1 : forall x y:R, Rabs x < Rabs y -> Rsqr x < Rsqr y. -intros; rewrite (Rsqr_abs x); rewrite (Rsqr_abs y); - apply (Rsqr_incrst_1 (Rabs x) (Rabs y) H (Rabs_pos x) (Rabs_pos y)). +Proof. + intros; rewrite (Rsqr_abs x); rewrite (Rsqr_abs y); + apply (Rsqr_incrst_1 (Rabs x) (Rabs y) H (Rabs_pos x) (Rabs_pos y)). Qed. Lemma Rsqr_inj : forall x y:R, 0 <= x -> 0 <= y -> Rsqr x = Rsqr y -> x = y. -intros; generalize (Rle_le_eq (Rsqr x) (Rsqr y)); intro; elim H2; intros _ H3; - generalize (H3 H1); intro; elim H4; intros; apply Rle_antisym; - apply Rsqr_incr_0; assumption. +Proof. + intros; generalize (Rle_le_eq (Rsqr x) (Rsqr y)); intro; elim H2; intros _ H3; + generalize (H3 H1); intro; elim H4; intros; apply Rle_antisym; + apply Rsqr_incr_0; assumption. Qed. Lemma Rsqr_eq_abs_0 : forall x y:R, Rsqr x = Rsqr y -> Rabs x = Rabs y. -intros; unfold Rabs in |- *; case (Rcase_abs x); case (Rcase_abs y); intros. -rewrite (Rsqr_neg x) in H; rewrite (Rsqr_neg y) in H; - generalize (Ropp_lt_gt_contravar y 0 r); - generalize (Ropp_lt_gt_contravar x 0 r0); rewrite Ropp_0; - intros; generalize (Rlt_le 0 (- x) H0); generalize (Rlt_le 0 (- y) H1); - intros; apply Rsqr_inj; assumption. -rewrite (Rsqr_neg x) in H; generalize (Rge_le y 0 r); intro; - generalize (Ropp_lt_gt_contravar x 0 r0); rewrite Ropp_0; - intro; generalize (Rlt_le 0 (- x) H1); intro; apply Rsqr_inj; - assumption. -rewrite (Rsqr_neg y) in H; generalize (Rge_le x 0 r0); intro; - generalize (Ropp_lt_gt_contravar y 0 r); rewrite Ropp_0; - intro; generalize (Rlt_le 0 (- y) H1); intro; apply Rsqr_inj; - assumption. -generalize (Rge_le x 0 r0); generalize (Rge_le y 0 r); intros; apply Rsqr_inj; - assumption. +Proof. + intros; unfold Rabs in |- *; case (Rcase_abs x); case (Rcase_abs y); intros. + rewrite (Rsqr_neg x) in H; rewrite (Rsqr_neg y) in H; + generalize (Ropp_lt_gt_contravar y 0 r); + generalize (Ropp_lt_gt_contravar x 0 r0); rewrite Ropp_0; + intros; generalize (Rlt_le 0 (- x) H0); generalize (Rlt_le 0 (- y) H1); + intros; apply Rsqr_inj; assumption. + rewrite (Rsqr_neg x) in H; generalize (Rge_le y 0 r); intro; + generalize (Ropp_lt_gt_contravar x 0 r0); rewrite Ropp_0; + intro; generalize (Rlt_le 0 (- x) H1); intro; apply Rsqr_inj; + assumption. + rewrite (Rsqr_neg y) in H; generalize (Rge_le x 0 r0); intro; + generalize (Ropp_lt_gt_contravar y 0 r); rewrite Ropp_0; + intro; generalize (Rlt_le 0 (- y) H1); intro; apply Rsqr_inj; + assumption. + generalize (Rge_le x 0 r0); generalize (Rge_le y 0 r); intros; apply Rsqr_inj; + assumption. Qed. Lemma Rsqr_eq_asb_1 : forall x y:R, Rabs x = Rabs y -> Rsqr x = Rsqr y. -intros; cut (Rsqr (Rabs x) = Rsqr (Rabs y)). -intro; repeat rewrite <- Rsqr_abs in H0; assumption. -rewrite H; reflexivity. +Proof. + intros; cut (Rsqr (Rabs x) = Rsqr (Rabs y)). + intro; repeat rewrite <- Rsqr_abs in H0; assumption. + rewrite H; reflexivity. Qed. Lemma triangle_rectangle : - forall x y z:R, - 0 <= z -> Rsqr x + Rsqr y <= Rsqr z -> - z <= x <= z /\ - z <= y <= z. -intros; - generalize (plus_le_is_le (Rsqr x) (Rsqr y) (Rsqr z) (Rle_0_sqr y) H0); - rewrite Rplus_comm in H0; - generalize (plus_le_is_le (Rsqr y) (Rsqr x) (Rsqr z) (Rle_0_sqr x) H0); - intros; split; - [ split; - [ apply Rsqr_neg_pos_le_0; assumption - | apply Rsqr_incr_0_var; assumption ] - | split; - [ apply Rsqr_neg_pos_le_0; assumption - | apply Rsqr_incr_0_var; assumption ] ]. + forall x y z:R, + 0 <= z -> Rsqr x + Rsqr y <= Rsqr z -> - z <= x <= z /\ - z <= y <= z. +Proof. + intros; + generalize (plus_le_is_le (Rsqr x) (Rsqr y) (Rsqr z) (Rle_0_sqr y) H0); + rewrite Rplus_comm in H0; + generalize (plus_le_is_le (Rsqr y) (Rsqr x) (Rsqr z) (Rle_0_sqr x) H0); + intros; split; + [ split; + [ apply Rsqr_neg_pos_le_0; assumption + | apply Rsqr_incr_0_var; assumption ] + | split; + [ apply Rsqr_neg_pos_le_0; assumption + | apply Rsqr_incr_0_var; assumption ] ]. Qed. Lemma triangle_rectangle_lt : - forall x y z:R, - Rsqr x + Rsqr y < Rsqr z -> Rabs x < Rabs z /\ Rabs y < Rabs z. -intros; split; - [ generalize (plus_lt_is_lt (Rsqr x) (Rsqr y) (Rsqr z) (Rle_0_sqr y) H); - intro; apply Rsqr_lt_abs_0; assumption - | rewrite Rplus_comm in H; - generalize (plus_lt_is_lt (Rsqr y) (Rsqr x) (Rsqr z) (Rle_0_sqr x) H); - intro; apply Rsqr_lt_abs_0; assumption ]. + forall x y z:R, + Rsqr x + Rsqr y < Rsqr z -> Rabs x < Rabs z /\ Rabs y < Rabs z. +Proof. + intros; split; + [ generalize (plus_lt_is_lt (Rsqr x) (Rsqr y) (Rsqr z) (Rle_0_sqr y) H); + intro; apply Rsqr_lt_abs_0; assumption + | rewrite Rplus_comm in H; + generalize (plus_lt_is_lt (Rsqr y) (Rsqr x) (Rsqr z) (Rle_0_sqr x) H); + intro; apply Rsqr_lt_abs_0; assumption ]. Qed. Lemma triangle_rectangle_le : - forall x y z:R, - Rsqr x + Rsqr y <= Rsqr z -> Rabs x <= Rabs z /\ Rabs y <= Rabs z. -intros; split; - [ generalize (plus_le_is_le (Rsqr x) (Rsqr y) (Rsqr z) (Rle_0_sqr y) H); - intro; apply Rsqr_le_abs_0; assumption - | rewrite Rplus_comm in H; - generalize (plus_le_is_le (Rsqr y) (Rsqr x) (Rsqr z) (Rle_0_sqr x) H); - intro; apply Rsqr_le_abs_0; assumption ]. + forall x y z:R, + Rsqr x + Rsqr y <= Rsqr z -> Rabs x <= Rabs z /\ Rabs y <= Rabs z. +Proof. + intros; split; + [ generalize (plus_le_is_le (Rsqr x) (Rsqr y) (Rsqr z) (Rle_0_sqr y) H); + intro; apply Rsqr_le_abs_0; assumption + | rewrite Rplus_comm in H; + generalize (plus_le_is_le (Rsqr y) (Rsqr x) (Rsqr z) (Rle_0_sqr x) H); + intro; apply Rsqr_le_abs_0; assumption ]. Qed. Lemma Rsqr_inv : forall x:R, x <> 0 -> Rsqr (/ x) = / Rsqr x. -intros; unfold Rsqr in |- *. -rewrite Rinv_mult_distr; try reflexivity || assumption. +Proof. + intros; unfold Rsqr in |- *. + rewrite Rinv_mult_distr; try reflexivity || assumption. Qed. Lemma canonical_Rsqr : - forall (a:nonzeroreal) (b c x:R), - a * Rsqr x + b * x + c = - a * Rsqr (x + b / (2 * a)) + (4 * a * c - Rsqr b) / (4 * a). -intros. -rewrite Rsqr_plus. -repeat rewrite Rmult_plus_distr_l. -repeat rewrite Rplus_assoc. -apply Rplus_eq_compat_l. -unfold Rdiv, Rminus in |- *. -replace (2 * 1 + 2 * 1) with 4; [ idtac | ring ]. -rewrite (Rmult_plus_distr_r (4 * a * c) (- Rsqr b) (/ (4 * a))). -rewrite Rsqr_mult. -repeat rewrite Rinv_mult_distr. -repeat rewrite (Rmult_comm a). -repeat rewrite Rmult_assoc. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_r. -rewrite (Rmult_comm 2). -repeat rewrite Rmult_assoc. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_r. -rewrite (Rmult_comm (/ 2)). -rewrite (Rmult_comm 2). -repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_r. -rewrite (Rmult_comm a). -repeat rewrite Rmult_assoc. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_r. -rewrite (Rmult_comm 2). -repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_r. -repeat rewrite Rplus_assoc. -rewrite (Rplus_comm (Rsqr b * (Rsqr (/ a * / 2) * a))). -repeat rewrite Rplus_assoc. -rewrite (Rmult_comm x). -apply Rplus_eq_compat_l. -rewrite (Rmult_comm (/ a)). -unfold Rsqr in |- *; repeat rewrite Rmult_assoc. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_r. -ring. -apply (cond_nonzero a). -discrR. -apply (cond_nonzero a). -discrR. -discrR. -apply (cond_nonzero a). -discrR. -discrR. -discrR. -apply (cond_nonzero a). -discrR. -apply (cond_nonzero a). + forall (a:nonzeroreal) (b c x:R), + a * Rsqr x + b * x + c = + a * Rsqr (x + b / (2 * a)) + (4 * a * c - Rsqr b) / (4 * a). +Proof. + intros. + rewrite Rsqr_plus. + repeat rewrite Rmult_plus_distr_l. + repeat rewrite Rplus_assoc. + apply Rplus_eq_compat_l. + unfold Rdiv, Rminus in |- *. + replace (2 * 1 + 2 * 1) with 4; [ idtac | ring ]. + rewrite (Rmult_plus_distr_r (4 * a * c) (- Rsqr b) (/ (4 * a))). + rewrite Rsqr_mult. + repeat rewrite Rinv_mult_distr. + repeat rewrite (Rmult_comm a). + repeat rewrite Rmult_assoc. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_r. + rewrite (Rmult_comm 2). + repeat rewrite Rmult_assoc. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_r. + rewrite (Rmult_comm (/ 2)). + rewrite (Rmult_comm 2). + repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_r. + rewrite (Rmult_comm a). + repeat rewrite Rmult_assoc. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_r. + rewrite (Rmult_comm 2). + repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_r. + repeat rewrite Rplus_assoc. + rewrite (Rplus_comm (Rsqr b * (Rsqr (/ a * / 2) * a))). + repeat rewrite Rplus_assoc. + rewrite (Rmult_comm x). + apply Rplus_eq_compat_l. + rewrite (Rmult_comm (/ a)). + unfold Rsqr in |- *; repeat rewrite Rmult_assoc. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_r. + ring. + apply (cond_nonzero a). + discrR. + apply (cond_nonzero a). + discrR. + discrR. + apply (cond_nonzero a). + discrR. + discrR. + discrR. + apply (cond_nonzero a). + discrR. + apply (cond_nonzero a). Qed. Lemma Rsqr_eq : forall x y:R, Rsqr x = Rsqr y -> x = y \/ x = - y. -intros; unfold Rsqr in H; - generalize (Rplus_eq_compat_l (- (y * y)) (x * x) (y * y) H); - rewrite Rplus_opp_l; replace (- (y * y) + x * x) with ((x - y) * (x + y)). -intro; generalize (Rmult_integral (x - y) (x + y) H0); intro; elim H1; intros. -left; apply Rminus_diag_uniq; assumption. -right; apply Rminus_diag_uniq; unfold Rminus in |- *; rewrite Ropp_involutive; - assumption. -ring. -Qed.
\ No newline at end of file +Proof. + intros; unfold Rsqr in H; + generalize (Rplus_eq_compat_l (- (y * y)) (x * x) (y * y) H); + rewrite Rplus_opp_l; replace (- (y * y) + x * x) with ((x - y) * (x + y)). + intro; generalize (Rmult_integral (x - y) (x + y) H0); intro; elim H1; intros. + left; apply Rminus_diag_uniq; assumption. + right; apply Rminus_diag_uniq; unfold Rminus in |- *; rewrite Ropp_involutive; + assumption. + ring. +Qed. diff --git a/theories/Reals/R_sqrt.v b/theories/Reals/R_sqrt.v index cb372840..736365a0 100644 --- a/theories/Reals/R_sqrt.v +++ b/theories/Reals/R_sqrt.v @@ -6,219 +6,242 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: R_sqrt.v 6295 2004-11-12 16:40:39Z gregoire $ i*) +(*i $Id: R_sqrt.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. Require Import Rsqrt_def. Open Local Scope R_scope. -(* Here is a continuous extension of Rsqrt on R *) +(** * Continuous extension of Rsqrt on R *) Definition sqrt (x:R) : R := match Rcase_abs x with - | left _ => 0 - | right a => Rsqrt (mknonnegreal x (Rge_le _ _ a)) + | left _ => 0 + | right a => Rsqrt (mknonnegreal x (Rge_le _ _ a)) end. Lemma sqrt_positivity : forall x:R, 0 <= x -> 0 <= sqrt x. -intros. -unfold sqrt in |- *. -case (Rcase_abs x); intro. -elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ r H)). -apply Rsqrt_positivity. +Proof. + intros. + unfold sqrt in |- *. + case (Rcase_abs x); intro. + elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ r H)). + apply Rsqrt_positivity. Qed. Lemma sqrt_sqrt : forall x:R, 0 <= x -> sqrt x * sqrt x = x. -intros. -unfold sqrt in |- *. -case (Rcase_abs x); intro. -elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ r H)). -rewrite Rsqrt_Rsqrt; reflexivity. +Proof. + intros. + unfold sqrt in |- *. + case (Rcase_abs x); intro. + elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ r H)). + rewrite Rsqrt_Rsqrt; reflexivity. Qed. Lemma sqrt_0 : sqrt 0 = 0. -apply Rsqr_eq_0; unfold Rsqr in |- *; apply sqrt_sqrt; right; reflexivity. +Proof. + apply Rsqr_eq_0; unfold Rsqr in |- *; apply sqrt_sqrt; right; reflexivity. Qed. Lemma sqrt_1 : sqrt 1 = 1. -apply (Rsqr_inj (sqrt 1) 1); - [ apply sqrt_positivity; left - | left - | unfold Rsqr in |- *; rewrite sqrt_sqrt; [ ring | left ] ]; - apply Rlt_0_1. +Proof. + apply (Rsqr_inj (sqrt 1) 1); + [ apply sqrt_positivity; left + | left + | unfold Rsqr in |- *; rewrite sqrt_sqrt; [ ring | left ] ]; + apply Rlt_0_1. Qed. Lemma sqrt_eq_0 : forall x:R, 0 <= x -> sqrt x = 0 -> x = 0. -intros; cut (Rsqr (sqrt x) = 0). -intro; unfold Rsqr in H1; rewrite sqrt_sqrt in H1; assumption. -rewrite H0; apply Rsqr_0. +Proof. + intros; cut (Rsqr (sqrt x) = 0). + intro; unfold Rsqr in H1; rewrite sqrt_sqrt in H1; assumption. + rewrite H0; apply Rsqr_0. Qed. Lemma sqrt_lem_0 : forall x y:R, 0 <= x -> 0 <= y -> sqrt x = y -> y * y = x. -intros; rewrite <- H1; apply (sqrt_sqrt x H). +Proof. + intros; rewrite <- H1; apply (sqrt_sqrt x H). Qed. -Lemma sqtr_lem_1 : forall x y:R, 0 <= x -> 0 <= y -> y * y = x -> sqrt x = y. -intros; apply Rsqr_inj; - [ apply (sqrt_positivity x H) - | assumption - | unfold Rsqr in |- *; rewrite H1; apply (sqrt_sqrt x H) ]. +Lemma sqrt_lem_1 : forall x y:R, 0 <= x -> 0 <= y -> y * y = x -> sqrt x = y. +Proof. + intros; apply Rsqr_inj; + [ apply (sqrt_positivity x H) + | assumption + | unfold Rsqr in |- *; rewrite H1; apply (sqrt_sqrt x H) ]. Qed. Lemma sqrt_def : forall x:R, 0 <= x -> sqrt x * sqrt x = x. -intros; apply (sqrt_sqrt x H). +Proof. + intros; apply (sqrt_sqrt x H). Qed. Lemma sqrt_square : forall x:R, 0 <= x -> sqrt (x * x) = x. -intros; - apply - (Rsqr_inj (sqrt (Rsqr x)) x (sqrt_positivity (Rsqr x) (Rle_0_sqr x)) H); - unfold Rsqr in |- *; apply (sqrt_sqrt (Rsqr x) (Rle_0_sqr x)). +Proof. + intros; + apply + (Rsqr_inj (sqrt (Rsqr x)) x (sqrt_positivity (Rsqr x) (Rle_0_sqr x)) H); + unfold Rsqr in |- *; apply (sqrt_sqrt (Rsqr x) (Rle_0_sqr x)). Qed. Lemma sqrt_Rsqr : forall x:R, 0 <= x -> sqrt (Rsqr x) = x. -intros; unfold Rsqr in |- *; apply sqrt_square; assumption. +Proof. + intros; unfold Rsqr in |- *; apply sqrt_square; assumption. Qed. Lemma sqrt_Rsqr_abs : forall x:R, sqrt (Rsqr x) = Rabs x. -intro x; rewrite Rsqr_abs; apply sqrt_Rsqr; apply Rabs_pos. +Proof. + intro x; rewrite Rsqr_abs; apply sqrt_Rsqr; apply Rabs_pos. Qed. Lemma Rsqr_sqrt : forall x:R, 0 <= x -> Rsqr (sqrt x) = x. -intros x H1; unfold Rsqr in |- *; apply (sqrt_sqrt x H1). +Proof. + intros x H1; unfold Rsqr in |- *; apply (sqrt_sqrt x H1). Qed. Lemma sqrt_mult : - forall x y:R, 0 <= x -> 0 <= y -> sqrt (x * y) = sqrt x * sqrt y. -intros x y H1 H2; - apply - (Rsqr_inj (sqrt (x * y)) (sqrt x * sqrt y) - (sqrt_positivity (x * y) (Rmult_le_pos x y H1 H2)) - (Rmult_le_pos (sqrt x) (sqrt y) (sqrt_positivity x H1) - (sqrt_positivity y H2))); rewrite Rsqr_mult; - repeat rewrite Rsqr_sqrt; - [ ring | assumption | assumption | apply (Rmult_le_pos x y H1 H2) ]. + forall x y:R, 0 <= x -> 0 <= y -> sqrt (x * y) = sqrt x * sqrt y. +Proof. + intros x y H1 H2; + apply + (Rsqr_inj (sqrt (x * y)) (sqrt x * sqrt y) + (sqrt_positivity (x * y) (Rmult_le_pos x y H1 H2)) + (Rmult_le_pos (sqrt x) (sqrt y) (sqrt_positivity x H1) + (sqrt_positivity y H2))); rewrite Rsqr_mult; + repeat rewrite Rsqr_sqrt; + [ ring | assumption | assumption | apply (Rmult_le_pos x y H1 H2) ]. Qed. Lemma sqrt_lt_R0 : forall x:R, 0 < x -> 0 < sqrt x. -intros x H1; apply Rsqr_incrst_0; - [ rewrite Rsqr_0; rewrite Rsqr_sqrt; [ assumption | left; assumption ] - | right; reflexivity - | apply (sqrt_positivity x (Rlt_le 0 x H1)) ]. +Proof. + intros x H1; apply Rsqr_incrst_0; + [ rewrite Rsqr_0; rewrite Rsqr_sqrt; [ assumption | left; assumption ] + | right; reflexivity + | apply (sqrt_positivity x (Rlt_le 0 x H1)) ]. Qed. Lemma sqrt_div : - forall x y:R, 0 <= x -> 0 < y -> sqrt (x / y) = sqrt x / sqrt y. -intros x y H1 H2; apply Rsqr_inj; - [ apply sqrt_positivity; apply (Rmult_le_pos x (/ y)); - [ assumption - | generalize (Rinv_0_lt_compat y H2); clear H2; intro H2; left; - assumption ] - | apply (Rmult_le_pos (sqrt x) (/ sqrt y)); - [ apply (sqrt_positivity x H1) - | generalize (sqrt_lt_R0 y H2); clear H2; intro H2; - generalize (Rinv_0_lt_compat (sqrt y) H2); clear H2; - intro H2; left; assumption ] - | rewrite Rsqr_div; repeat rewrite Rsqr_sqrt; - [ reflexivity - | left; assumption - | assumption - | generalize (Rinv_0_lt_compat y H2); intro H3; - generalize (Rlt_le 0 (/ y) H3); intro H4; - apply (Rmult_le_pos x (/ y) H1 H4) - | red in |- *; intro H3; generalize (Rlt_le 0 y H2); intro H4; - generalize (sqrt_eq_0 y H4 H3); intro H5; rewrite H5 in H2; - elim (Rlt_irrefl 0 H2) ] ]. + forall x y:R, 0 <= x -> 0 < y -> sqrt (x / y) = sqrt x / sqrt y. +Proof. + intros x y H1 H2; apply Rsqr_inj; + [ apply sqrt_positivity; apply (Rmult_le_pos x (/ y)); + [ assumption + | generalize (Rinv_0_lt_compat y H2); clear H2; intro H2; left; + assumption ] + | apply (Rmult_le_pos (sqrt x) (/ sqrt y)); + [ apply (sqrt_positivity x H1) + | generalize (sqrt_lt_R0 y H2); clear H2; intro H2; + generalize (Rinv_0_lt_compat (sqrt y) H2); clear H2; + intro H2; left; assumption ] + | rewrite Rsqr_div; repeat rewrite Rsqr_sqrt; + [ reflexivity + | left; assumption + | assumption + | generalize (Rinv_0_lt_compat y H2); intro H3; + generalize (Rlt_le 0 (/ y) H3); intro H4; + apply (Rmult_le_pos x (/ y) H1 H4) + | red in |- *; intro H3; generalize (Rlt_le 0 y H2); intro H4; + generalize (sqrt_eq_0 y H4 H3); intro H5; rewrite H5 in H2; + elim (Rlt_irrefl 0 H2) ] ]. Qed. Lemma sqrt_lt_0 : forall x y:R, 0 <= x -> 0 <= y -> sqrt x < sqrt y -> x < y. -intros x y H1 H2 H3; - generalize - (Rsqr_incrst_1 (sqrt x) (sqrt y) H3 (sqrt_positivity x H1) - (sqrt_positivity y H2)); intro H4; rewrite (Rsqr_sqrt x H1) in H4; - rewrite (Rsqr_sqrt y H2) in H4; assumption. +Proof. + intros x y H1 H2 H3; + generalize + (Rsqr_incrst_1 (sqrt x) (sqrt y) H3 (sqrt_positivity x H1) + (sqrt_positivity y H2)); intro H4; rewrite (Rsqr_sqrt x H1) in H4; + rewrite (Rsqr_sqrt y H2) in H4; assumption. Qed. Lemma sqrt_lt_1 : forall x y:R, 0 <= x -> 0 <= y -> x < y -> sqrt x < sqrt y. -intros x y H1 H2 H3; apply Rsqr_incrst_0; - [ rewrite (Rsqr_sqrt x H1); rewrite (Rsqr_sqrt y H2); assumption - | apply (sqrt_positivity x H1) - | apply (sqrt_positivity y H2) ]. +Proof. + intros x y H1 H2 H3; apply Rsqr_incrst_0; + [ rewrite (Rsqr_sqrt x H1); rewrite (Rsqr_sqrt y H2); assumption + | apply (sqrt_positivity x H1) + | apply (sqrt_positivity y H2) ]. Qed. Lemma sqrt_le_0 : - forall x y:R, 0 <= x -> 0 <= y -> sqrt x <= sqrt y -> x <= y. -intros x y H1 H2 H3; - generalize - (Rsqr_incr_1 (sqrt x) (sqrt y) H3 (sqrt_positivity x H1) - (sqrt_positivity y H2)); intro H4; rewrite (Rsqr_sqrt x H1) in H4; - rewrite (Rsqr_sqrt y H2) in H4; assumption. + forall x y:R, 0 <= x -> 0 <= y -> sqrt x <= sqrt y -> x <= y. +Proof. + intros x y H1 H2 H3; + generalize + (Rsqr_incr_1 (sqrt x) (sqrt y) H3 (sqrt_positivity x H1) + (sqrt_positivity y H2)); intro H4; rewrite (Rsqr_sqrt x H1) in H4; + rewrite (Rsqr_sqrt y H2) in H4; assumption. Qed. Lemma sqrt_le_1 : - forall x y:R, 0 <= x -> 0 <= y -> x <= y -> sqrt x <= sqrt y. -intros x y H1 H2 H3; apply Rsqr_incr_0; - [ rewrite (Rsqr_sqrt x H1); rewrite (Rsqr_sqrt y H2); assumption - | apply (sqrt_positivity x H1) - | apply (sqrt_positivity y H2) ]. + forall x y:R, 0 <= x -> 0 <= y -> x <= y -> sqrt x <= sqrt y. +Proof. + intros x y H1 H2 H3; apply Rsqr_incr_0; + [ rewrite (Rsqr_sqrt x H1); rewrite (Rsqr_sqrt y H2); assumption + | apply (sqrt_positivity x H1) + | apply (sqrt_positivity y H2) ]. Qed. Lemma sqrt_inj : forall x y:R, 0 <= x -> 0 <= y -> sqrt x = sqrt y -> x = y. -intros; cut (Rsqr (sqrt x) = Rsqr (sqrt y)). -intro; rewrite (Rsqr_sqrt x H) in H2; rewrite (Rsqr_sqrt y H0) in H2; - assumption. -rewrite H1; reflexivity. +Proof. + intros; cut (Rsqr (sqrt x) = Rsqr (sqrt y)). + intro; rewrite (Rsqr_sqrt x H) in H2; rewrite (Rsqr_sqrt y H0) in H2; + assumption. + rewrite H1; reflexivity. Qed. Lemma sqrt_less : forall x:R, 0 <= x -> 1 < x -> sqrt x < x. -intros x H1 H2; generalize (sqrt_lt_1 1 x (Rlt_le 0 1 Rlt_0_1) H1 H2); - intro H3; rewrite sqrt_1 in H3; generalize (Rmult_ne (sqrt x)); - intro H4; elim H4; intros H5 H6; rewrite <- H5; pattern x at 2 in |- *; - rewrite <- (sqrt_def x H1); - apply - (Rmult_lt_compat_l (sqrt x) 1 (sqrt x) - (sqrt_lt_R0 x (Rlt_trans 0 1 x Rlt_0_1 H2)) H3). +Proof. + intros x H1 H2; generalize (sqrt_lt_1 1 x (Rlt_le 0 1 Rlt_0_1) H1 H2); + intro H3; rewrite sqrt_1 in H3; generalize (Rmult_ne (sqrt x)); + intro H4; elim H4; intros H5 H6; rewrite <- H5; pattern x at 2 in |- *; + rewrite <- (sqrt_def x H1); + apply + (Rmult_lt_compat_l (sqrt x) 1 (sqrt x) + (sqrt_lt_R0 x (Rlt_trans 0 1 x Rlt_0_1 H2)) H3). Qed. Lemma sqrt_more : forall x:R, 0 < x -> x < 1 -> x < sqrt x. -intros x H1 H2; - generalize (sqrt_lt_1 x 1 (Rlt_le 0 x H1) (Rlt_le 0 1 Rlt_0_1) H2); - intro H3; rewrite sqrt_1 in H3; generalize (Rmult_ne (sqrt x)); - intro H4; elim H4; intros H5 H6; rewrite <- H5; pattern x at 1 in |- *; - rewrite <- (sqrt_def x (Rlt_le 0 x H1)); - apply (Rmult_lt_compat_l (sqrt x) (sqrt x) 1 (sqrt_lt_R0 x H1) H3). +Proof. + intros x H1 H2; + generalize (sqrt_lt_1 x 1 (Rlt_le 0 x H1) (Rlt_le 0 1 Rlt_0_1) H2); + intro H3; rewrite sqrt_1 in H3; generalize (Rmult_ne (sqrt x)); + intro H4; elim H4; intros H5 H6; rewrite <- H5; pattern x at 1 in |- *; + rewrite <- (sqrt_def x (Rlt_le 0 x H1)); + apply (Rmult_lt_compat_l (sqrt x) (sqrt x) 1 (sqrt_lt_R0 x H1) H3). Qed. Lemma sqrt_cauchy : - forall a b c d:R, - a * c + b * d <= sqrt (Rsqr a + Rsqr b) * sqrt (Rsqr c + Rsqr d). -intros a b c d; apply Rsqr_incr_0_var; - [ rewrite Rsqr_mult; repeat rewrite Rsqr_sqrt; unfold Rsqr in |- *; - [ replace ((a * c + b * d) * (a * c + b * d)) with - (a * a * c * c + b * b * d * d + 2 * a * b * c * d); - [ replace ((a * a + b * b) * (c * c + d * d)) with + forall a b c d:R, + a * c + b * d <= sqrt (Rsqr a + Rsqr b) * sqrt (Rsqr c + Rsqr d). +Proof. + intros a b c d; apply Rsqr_incr_0_var; + [ rewrite Rsqr_mult; repeat rewrite Rsqr_sqrt; unfold Rsqr in |- *; + [ replace ((a * c + b * d) * (a * c + b * d)) with + (a * a * c * c + b * b * d * d + 2 * a * b * c * d); + [ replace ((a * a + b * b) * (c * c + d * d)) with (a * a * c * c + b * b * d * d + (a * a * d * d + b * b * c * c)); [ apply Rplus_le_compat_l; - replace (a * a * d * d + b * b * c * c) with - (2 * a * b * c * d + - (a * a * d * d + b * b * c * c - 2 * a * b * c * d)); - [ pattern (2 * a * b * c * d) at 1 in |- *; rewrite <- Rplus_0_r; - apply Rplus_le_compat_l; + replace (a * a * d * d + b * b * c * c) with + (2 * a * b * c * d + + (a * a * d * d + b * b * c * c - 2 * a * b * c * d)); + [ pattern (2 * a * b * c * d) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l; replace (a * a * d * d + b * b * c * c - 2 * a * b * c * d) - with (Rsqr (a * d - b * c)); + with (Rsqr (a * d - b * c)); [ apply Rle_0_sqr | unfold Rsqr in |- *; ring ] - | ring ] + | ring ] + | ring ] | ring ] - | ring ] - | apply - (Rplus_le_le_0_compat (Rsqr c) (Rsqr d) (Rle_0_sqr c) (Rle_0_sqr d)) - | apply - (Rplus_le_le_0_compat (Rsqr a) (Rsqr b) (Rle_0_sqr a) (Rle_0_sqr b)) ] - | apply Rmult_le_pos; apply sqrt_positivity; apply Rplus_le_le_0_compat; - apply Rle_0_sqr ]. + | apply + (Rplus_le_le_0_compat (Rsqr c) (Rsqr d) (Rle_0_sqr c) (Rle_0_sqr d)) + | apply + (Rplus_le_le_0_compat (Rsqr a) (Rsqr b) (Rle_0_sqr a) (Rle_0_sqr b)) ] + | apply Rmult_le_pos; apply sqrt_positivity; apply Rplus_le_le_0_compat; + apply Rle_0_sqr ]. Qed. (************************************************************) -(* Resolution of [a*X^2+b*X+c=0] *) +(** * Resolution of [a*X^2+b*X+c=0] *) (************************************************************) Definition Delta (a:nonzeroreal) (b c:R) : R := Rsqr b - 4 * a * c. @@ -232,168 +255,170 @@ Definition sol_x2 (a:nonzeroreal) (b c:R) : R := (- b - sqrt (Delta a b c)) / (2 * a). Lemma Rsqr_sol_eq_0_1 : - forall (a:nonzeroreal) (b c x:R), - Delta_is_pos a b c -> - x = sol_x1 a b c \/ x = sol_x2 a b c -> a * Rsqr x + b * x + c = 0. -intros; elim H0; intro. -unfold sol_x1 in H1; unfold Delta in H1; rewrite H1; unfold Rdiv in |- *; - repeat rewrite Rsqr_mult; rewrite Rsqr_plus; rewrite <- Rsqr_neg; - rewrite Rsqr_sqrt. -rewrite Rsqr_inv. -unfold Rsqr in |- *; repeat rewrite Rinv_mult_distr. -repeat rewrite Rmult_assoc; rewrite (Rmult_comm a). -repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_r; rewrite Rmult_plus_distr_r. -repeat rewrite Rmult_assoc. -pattern 2 at 2 in |- *; rewrite (Rmult_comm 2). -repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_r. -rewrite - (Rmult_plus_distr_r (- b) (sqrt (b * b - 2 * (2 * (a * c)))) (/ 2 * / a)) - . -rewrite Rmult_plus_distr_l; repeat rewrite Rplus_assoc. -replace - (- b * (sqrt (b * b - 2 * (2 * (a * c))) * (/ 2 * / a)) + - (b * (- b * (/ 2 * / a)) + - (b * (sqrt (b * b - 2 * (2 * (a * c))) * (/ 2 * / a)) + c))) with - (b * (- b * (/ 2 * / a)) + c). -unfold Rminus in |- *; repeat rewrite <- Rplus_assoc. -replace (b * b + b * b) with (2 * (b * b)). -rewrite Rmult_plus_distr_r; repeat rewrite Rmult_assoc. -rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_r. -rewrite Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc; - rewrite (Rmult_comm 2). -repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_r; rewrite (Rmult_comm (/ 2)); repeat rewrite Rmult_assoc; - rewrite (Rmult_comm 2). -repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_r; repeat rewrite Rmult_assoc. -rewrite (Rmult_comm a); rewrite Rmult_assoc. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_r; rewrite <- Rmult_opp_opp. -ring. -apply (cond_nonzero a). -discrR. -discrR. -discrR. -ring. -ring. -discrR. -apply (cond_nonzero a). -discrR. -apply (cond_nonzero a). -apply prod_neq_R0; [ discrR | apply (cond_nonzero a) ]. -apply prod_neq_R0; [ discrR | apply (cond_nonzero a) ]. -apply prod_neq_R0; [ discrR | apply (cond_nonzero a) ]. -assumption. -unfold sol_x2 in H1; unfold Delta in H1; rewrite H1; unfold Rdiv in |- *; - repeat rewrite Rsqr_mult; rewrite Rsqr_minus; rewrite <- Rsqr_neg; - rewrite Rsqr_sqrt. -rewrite Rsqr_inv. -unfold Rsqr in |- *; repeat rewrite Rinv_mult_distr; - repeat rewrite Rmult_assoc. -rewrite (Rmult_comm a); repeat rewrite Rmult_assoc. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_r; unfold Rminus in |- *; rewrite Rmult_plus_distr_r. -rewrite Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc; - pattern 2 at 2 in |- *; rewrite (Rmult_comm 2). -repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_r; - rewrite - (Rmult_plus_distr_r (- b) (- sqrt (b * b + - (2 * (2 * (a * c))))) - (/ 2 * / a)). -rewrite Rmult_plus_distr_l; repeat rewrite Rplus_assoc. -rewrite Ropp_mult_distr_l_reverse; rewrite Ropp_involutive. -replace - (b * (sqrt (b * b + - (2 * (2 * (a * c)))) * (/ 2 * / a)) + - (b * (- b * (/ 2 * / a)) + - (b * (- sqrt (b * b + - (2 * (2 * (a * c)))) * (/ 2 * / a)) + c))) with - (b * (- b * (/ 2 * / a)) + c). -repeat rewrite <- Rplus_assoc; replace (b * b + b * b) with (2 * (b * b)). -rewrite Rmult_plus_distr_r; repeat rewrite Rmult_assoc; - rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; - rewrite <- Rinv_l_sym. -rewrite Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc. -rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_r; rewrite (Rmult_comm (/ 2)); repeat rewrite Rmult_assoc. -rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_r; repeat rewrite Rmult_assoc; rewrite (Rmult_comm a); - rewrite Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_r; rewrite <- Rmult_opp_opp; ring. -apply (cond_nonzero a). -discrR. -discrR. -discrR. -ring. -ring. -discrR. -apply (cond_nonzero a). -discrR. -discrR. -apply (cond_nonzero a). -apply prod_neq_R0; discrR || apply (cond_nonzero a). -apply prod_neq_R0; discrR || apply (cond_nonzero a). -apply prod_neq_R0; discrR || apply (cond_nonzero a). -assumption. + forall (a:nonzeroreal) (b c x:R), + Delta_is_pos a b c -> + x = sol_x1 a b c \/ x = sol_x2 a b c -> a * Rsqr x + b * x + c = 0. +Proof. + intros; elim H0; intro. + unfold sol_x1 in H1; unfold Delta in H1; rewrite H1; unfold Rdiv in |- *; + repeat rewrite Rsqr_mult; rewrite Rsqr_plus; rewrite <- Rsqr_neg; + rewrite Rsqr_sqrt. + rewrite Rsqr_inv. + unfold Rsqr in |- *; repeat rewrite Rinv_mult_distr. + repeat rewrite Rmult_assoc; rewrite (Rmult_comm a). + repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_r; rewrite Rmult_plus_distr_r. + repeat rewrite Rmult_assoc. + pattern 2 at 2 in |- *; rewrite (Rmult_comm 2). + repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_r. + rewrite + (Rmult_plus_distr_r (- b) (sqrt (b * b - 2 * (2 * (a * c)))) (/ 2 * / a)) + . + rewrite Rmult_plus_distr_l; repeat rewrite Rplus_assoc. + replace + (- b * (sqrt (b * b - 2 * (2 * (a * c))) * (/ 2 * / a)) + + (b * (- b * (/ 2 * / a)) + + (b * (sqrt (b * b - 2 * (2 * (a * c))) * (/ 2 * / a)) + c))) with + (b * (- b * (/ 2 * / a)) + c). + unfold Rminus in |- *; repeat rewrite <- Rplus_assoc. + replace (b * b + b * b) with (2 * (b * b)). + rewrite Rmult_plus_distr_r; repeat rewrite Rmult_assoc. + rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_r. + rewrite Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc; + rewrite (Rmult_comm 2). + repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_r; rewrite (Rmult_comm (/ 2)); repeat rewrite Rmult_assoc; + rewrite (Rmult_comm 2). + repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_r; repeat rewrite Rmult_assoc. + rewrite (Rmult_comm a); rewrite Rmult_assoc. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_r; rewrite <- Rmult_opp_opp. + ring. + apply (cond_nonzero a). + discrR. + discrR. + discrR. + ring. + ring. + discrR. + apply (cond_nonzero a). + discrR. + apply (cond_nonzero a). + apply prod_neq_R0; [ discrR | apply (cond_nonzero a) ]. + apply prod_neq_R0; [ discrR | apply (cond_nonzero a) ]. + apply prod_neq_R0; [ discrR | apply (cond_nonzero a) ]. + assumption. + unfold sol_x2 in H1; unfold Delta in H1; rewrite H1; unfold Rdiv in |- *; + repeat rewrite Rsqr_mult; rewrite Rsqr_minus; rewrite <- Rsqr_neg; + rewrite Rsqr_sqrt. + rewrite Rsqr_inv. + unfold Rsqr in |- *; repeat rewrite Rinv_mult_distr; + repeat rewrite Rmult_assoc. + rewrite (Rmult_comm a); repeat rewrite Rmult_assoc. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_r; unfold Rminus in |- *; rewrite Rmult_plus_distr_r. + rewrite Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc; + pattern 2 at 2 in |- *; rewrite (Rmult_comm 2). + repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_r; + rewrite + (Rmult_plus_distr_r (- b) (- sqrt (b * b + - (2 * (2 * (a * c))))) + (/ 2 * / a)). + rewrite Rmult_plus_distr_l; repeat rewrite Rplus_assoc. + rewrite Ropp_mult_distr_l_reverse; rewrite Ropp_involutive. + replace + (b * (sqrt (b * b + - (2 * (2 * (a * c)))) * (/ 2 * / a)) + + (b * (- b * (/ 2 * / a)) + + (b * (- sqrt (b * b + - (2 * (2 * (a * c)))) * (/ 2 * / a)) + c))) with + (b * (- b * (/ 2 * / a)) + c). + repeat rewrite <- Rplus_assoc; replace (b * b + b * b) with (2 * (b * b)). + rewrite Rmult_plus_distr_r; repeat rewrite Rmult_assoc; + rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. + rewrite Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc. + rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_r; rewrite (Rmult_comm (/ 2)); repeat rewrite Rmult_assoc. + rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_r; repeat rewrite Rmult_assoc; rewrite (Rmult_comm a); + rewrite Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_r; rewrite <- Rmult_opp_opp; ring. + apply (cond_nonzero a). + discrR. + discrR. + discrR. + ring. + ring. + discrR. + apply (cond_nonzero a). + discrR. + discrR. + apply (cond_nonzero a). + apply prod_neq_R0; discrR || apply (cond_nonzero a). + apply prod_neq_R0; discrR || apply (cond_nonzero a). + apply prod_neq_R0; discrR || apply (cond_nonzero a). + assumption. Qed. Lemma Rsqr_sol_eq_0_0 : - forall (a:nonzeroreal) (b c x:R), - Delta_is_pos a b c -> - a * Rsqr x + b * x + c = 0 -> x = sol_x1 a b c \/ x = sol_x2 a b c. -intros; rewrite (canonical_Rsqr a b c x) in H0; rewrite Rplus_comm in H0; - generalize - (Rplus_opp_r_uniq ((4 * a * c - Rsqr b) / (4 * a)) - (a * Rsqr (x + b / (2 * a))) H0); cut (Rsqr b - 4 * a * c = Delta a b c). -intro; - replace (- ((4 * a * c - Rsqr b) / (4 * a))) with - ((Rsqr b - 4 * a * c) / (4 * a)). -rewrite H1; intro; - generalize - (Rmult_eq_compat_l (/ a) (a * Rsqr (x + b / (2 * a))) - (Delta a b c / (4 * a)) H2); - replace (/ a * (a * Rsqr (x + b / (2 * a)))) with (Rsqr (x + b / (2 * a))). -replace (/ a * (Delta a b c / (4 * a))) with - (Rsqr (sqrt (Delta a b c) / (2 * a))). -intro; - generalize (Rsqr_eq (x + b / (2 * a)) (sqrt (Delta a b c) / (2 * a)) H3); - intro; elim H4; intro. -left; unfold sol_x1 in |- *; - generalize - (Rplus_eq_compat_l (- (b / (2 * a))) (x + b / (2 * a)) - (sqrt (Delta a b c) / (2 * a)) H5); - replace (- (b / (2 * a)) + (x + b / (2 * a))) with x. -intro; rewrite H6; unfold Rdiv in |- *; ring. -ring. -right; unfold sol_x2 in |- *; - generalize - (Rplus_eq_compat_l (- (b / (2 * a))) (x + b / (2 * a)) - (- (sqrt (Delta a b c) / (2 * a))) H5); - replace (- (b / (2 * a)) + (x + b / (2 * a))) with x. -intro; rewrite H6; unfold Rdiv in |- *; ring. -ring. -rewrite Rsqr_div. -rewrite Rsqr_sqrt. -unfold Rdiv in |- *. -repeat rewrite Rmult_assoc. -rewrite (Rmult_comm (/ a)). -rewrite Rmult_assoc. -rewrite <- Rinv_mult_distr. -replace (2 * (2 * a) * a) with (Rsqr (2 * a)). -reflexivity. -ring_Rsqr. -rewrite <- Rmult_assoc; apply prod_neq_R0; - [ discrR | apply (cond_nonzero a) ]. -apply (cond_nonzero a). -assumption. -apply prod_neq_R0; [ discrR | apply (cond_nonzero a) ]. -rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. -symmetry in |- *; apply Rmult_1_l. -apply (cond_nonzero a). -unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse. -rewrite Ropp_minus_distr. -reflexivity. -reflexivity. + forall (a:nonzeroreal) (b c x:R), + Delta_is_pos a b c -> + a * Rsqr x + b * x + c = 0 -> x = sol_x1 a b c \/ x = sol_x2 a b c. +Proof. + intros; rewrite (canonical_Rsqr a b c x) in H0; rewrite Rplus_comm in H0; + generalize + (Rplus_opp_r_uniq ((4 * a * c - Rsqr b) / (4 * a)) + (a * Rsqr (x + b / (2 * a))) H0); cut (Rsqr b - 4 * a * c = Delta a b c). + intro; + replace (- ((4 * a * c - Rsqr b) / (4 * a))) with + ((Rsqr b - 4 * a * c) / (4 * a)). + rewrite H1; intro; + generalize + (Rmult_eq_compat_l (/ a) (a * Rsqr (x + b / (2 * a))) + (Delta a b c / (4 * a)) H2); + replace (/ a * (a * Rsqr (x + b / (2 * a)))) with (Rsqr (x + b / (2 * a))). + replace (/ a * (Delta a b c / (4 * a))) with + (Rsqr (sqrt (Delta a b c) / (2 * a))). + intro; + generalize (Rsqr_eq (x + b / (2 * a)) (sqrt (Delta a b c) / (2 * a)) H3); + intro; elim H4; intro. + left; unfold sol_x1 in |- *; + generalize + (Rplus_eq_compat_l (- (b / (2 * a))) (x + b / (2 * a)) + (sqrt (Delta a b c) / (2 * a)) H5); + replace (- (b / (2 * a)) + (x + b / (2 * a))) with x. + intro; rewrite H6; unfold Rdiv in |- *; ring. + ring. + right; unfold sol_x2 in |- *; + generalize + (Rplus_eq_compat_l (- (b / (2 * a))) (x + b / (2 * a)) + (- (sqrt (Delta a b c) / (2 * a))) H5); + replace (- (b / (2 * a)) + (x + b / (2 * a))) with x. + intro; rewrite H6; unfold Rdiv in |- *; ring. + ring. + rewrite Rsqr_div. + rewrite Rsqr_sqrt. + unfold Rdiv in |- *. + repeat rewrite Rmult_assoc. + rewrite (Rmult_comm (/ a)). + rewrite Rmult_assoc. + rewrite <- Rinv_mult_distr. + replace (2 * (2 * a) * a) with (Rsqr (2 * a)). + reflexivity. + ring_Rsqr. + rewrite <- Rmult_assoc; apply prod_neq_R0; + [ discrR | apply (cond_nonzero a) ]. + apply (cond_nonzero a). + assumption. + apply prod_neq_R0; [ discrR | apply (cond_nonzero a) ]. + rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. + symmetry in |- *; apply Rmult_1_l. + apply (cond_nonzero a). + unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse. + rewrite Ropp_minus_distr. + reflexivity. + reflexivity. Qed. diff --git a/theories/Reals/Ranalysis.v b/theories/Reals/Ranalysis.v index b885e4ce..d712f74b 100644 --- a/theories/Reals/Ranalysis.v +++ b/theories/Reals/Ranalysis.v @@ -5,8 +5,8 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) - -(*i $Id: Ranalysis.v 5920 2004-07-16 20:01:26Z herbelin $ i*) + +(*i $Id: Ranalysis.v 9319 2006-10-30 12:41:21Z barras $ i*) Require Import Rbase. Require Import Rfunctions. @@ -34,769 +34,768 @@ Axiom AppVar : R. (**********) Ltac intro_hyp_glob trm := match constr:trm with - | (?X1 + ?X2)%F => + | (?X1 + ?X2)%F => match goal with - | |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2 - | |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2 - | _ => idtac + | |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2 + | |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2 + | _ => idtac end - | (?X1 - ?X2)%F => + | (?X1 - ?X2)%F => match goal with - | |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2 - | |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2 - | _ => idtac + | |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2 + | |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2 + | _ => idtac end - | (?X1 * ?X2)%F => + | (?X1 * ?X2)%F => match goal with - | |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2 - | |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2 - | _ => idtac + | |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2 + | |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2 + | _ => idtac end - | (?X1 / ?X2)%F => + | (?X1 / ?X2)%F => let aux := constr:X2 in + match goal with + | _:(forall x0:R, aux x0 <> 0) |- (derivable _) => + intro_hyp_glob X1; intro_hyp_glob X2 + | _:(forall x0:R, aux x0 <> 0) |- (continuity _) => + intro_hyp_glob X1; intro_hyp_glob X2 + | |- (derivable _) => + cut (forall x0:R, aux x0 <> 0); + [ intro; intro_hyp_glob X1; intro_hyp_glob X2 | try assumption ] + | |- (continuity _) => + cut (forall x0:R, aux x0 <> 0); + [ intro; intro_hyp_glob X1; intro_hyp_glob X2 | try assumption ] + | _ => idtac + end + | (comp ?X1 ?X2) => match goal with - | _:(forall x0:R, aux x0 <> 0) |- (derivable _) => - intro_hyp_glob X1; intro_hyp_glob X2 - | _:(forall x0:R, aux x0 <> 0) |- (continuity _) => - intro_hyp_glob X1; intro_hyp_glob X2 - | |- (derivable _) => - cut (forall x0:R, aux x0 <> 0); - [ intro; intro_hyp_glob X1; intro_hyp_glob X2 | try assumption ] - | |- (continuity _) => - cut (forall x0:R, aux x0 <> 0); - [ intro; intro_hyp_glob X1; intro_hyp_glob X2 | try assumption ] - | _ => idtac - end - | (comp ?X1 ?X2) => - match goal with - | |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2 - | |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2 - | _ => idtac + | |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2 + | |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2 + | _ => idtac end - | (- ?X1)%F => + | (- ?X1)%F => match goal with - | |- (derivable _) => intro_hyp_glob X1 - | |- (continuity _) => intro_hyp_glob X1 - | _ => idtac + | |- (derivable _) => intro_hyp_glob X1 + | |- (continuity _) => intro_hyp_glob X1 + | _ => idtac end - | (/ ?X1)%F => + | (/ ?X1)%F => let aux := constr:X1 in - match goal with - | _:(forall x0:R, aux x0 <> 0) |- (derivable _) => - intro_hyp_glob X1 - | _:(forall x0:R, aux x0 <> 0) |- (continuity _) => - intro_hyp_glob X1 - | |- (derivable _) => - cut (forall x0:R, aux x0 <> 0); - [ intro; intro_hyp_glob X1 | try assumption ] - | |- (continuity _) => - cut (forall x0:R, aux x0 <> 0); - [ intro; intro_hyp_glob X1 | try assumption ] - | _ => idtac - end - | cos => idtac - | sin => idtac - | cosh => idtac - | sinh => idtac - | exp => idtac - | Rsqr => idtac - | sqrt => idtac - | id => idtac - | (fct_cte _) => idtac - | (pow_fct _) => idtac - | Rabs => idtac - | ?X1 => + match goal with + | _:(forall x0:R, aux x0 <> 0) |- (derivable _) => + intro_hyp_glob X1 + | _:(forall x0:R, aux x0 <> 0) |- (continuity _) => + intro_hyp_glob X1 + | |- (derivable _) => + cut (forall x0:R, aux x0 <> 0); + [ intro; intro_hyp_glob X1 | try assumption ] + | |- (continuity _) => + cut (forall x0:R, aux x0 <> 0); + [ intro; intro_hyp_glob X1 | try assumption ] + | _ => idtac + end + | cos => idtac + | sin => idtac + | cosh => idtac + | sinh => idtac + | exp => idtac + | Rsqr => idtac + | sqrt => idtac + | id => idtac + | (fct_cte _) => idtac + | (pow_fct _) => idtac + | Rabs => idtac + | ?X1 => let p := constr:X1 in - match goal with - | _:(derivable p) |- _ => idtac - | |- (derivable p) => idtac - | |- (derivable _) => - cut (True -> derivable p); - [ intro HYPPD; cut (derivable p); - [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ] - | idtac ] - | _:(continuity p) |- _ => idtac - | |- (continuity p) => idtac - | |- (continuity _) => - cut (True -> continuity p); - [ intro HYPPD; cut (continuity p); - [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ] - | idtac ] - | _ => idtac - end + match goal with + | _:(derivable p) |- _ => idtac + | |- (derivable p) => idtac + | |- (derivable _) => + cut (True -> derivable p); + [ intro HYPPD; cut (derivable p); + [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ] + | idtac ] + | _:(continuity p) |- _ => idtac + | |- (continuity p) => idtac + | |- (continuity _) => + cut (True -> continuity p); + [ intro HYPPD; cut (continuity p); + [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ] + | idtac ] + | _ => idtac + end end. (**********) Ltac intro_hyp_pt trm pt := match constr:trm with - | (?X1 + ?X2)%F => + | (?X1 + ?X2)%F => match goal with - | |- (derivable_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt - | |- (continuity_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt - | |- (derive_pt _ _ _ = _) => + | |- (derivable_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | |- (continuity_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | |- (derive_pt _ _ _ = _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt - | _ => idtac + | _ => idtac end - | (?X1 - ?X2)%F => + | (?X1 - ?X2)%F => match goal with - | |- (derivable_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt - | |- (continuity_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt - | |- (derive_pt _ _ _ = _) => + | |- (derivable_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | |- (continuity_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | |- (derive_pt _ _ _ = _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt - | _ => idtac + | _ => idtac end - | (?X1 * ?X2)%F => + | (?X1 * ?X2)%F => match goal with - | |- (derivable_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt - | |- (continuity_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt - | |- (derive_pt _ _ _ = _) => + | |- (derivable_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | |- (continuity_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | |- (derive_pt _ _ _ = _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt - | _ => idtac + | _ => idtac end - | (?X1 / ?X2)%F => + | (?X1 / ?X2)%F => let aux := constr:X2 in + match goal with + | _:(aux pt <> 0) |- (derivable_pt _ _) => + intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | _:(aux pt <> 0) |- (continuity_pt _ _) => + intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | _:(aux pt <> 0) |- (derive_pt _ _ _ = _) => + intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | id:(forall x0:R, aux x0 <> 0) |- (derivable_pt _ _) => + generalize (id pt); intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | id:(forall x0:R, aux x0 <> 0) |- (continuity_pt _ _) => + generalize (id pt); intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | id:(forall x0:R, aux x0 <> 0) |- (derive_pt _ _ _ = _) => + generalize (id pt); intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | |- (derivable_pt _ _) => + cut (aux pt <> 0); + [ intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | try assumption ] + | |- (continuity_pt _ _) => + cut (aux pt <> 0); + [ intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | try assumption ] + | |- (derive_pt _ _ _ = _) => + cut (aux pt <> 0); + [ intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | try assumption ] + | _ => idtac + end + | (comp ?X1 ?X2) => match goal with - | _:(aux pt <> 0) |- (derivable_pt _ _) => - intro_hyp_pt X1 pt; intro_hyp_pt X2 pt - | _:(aux pt <> 0) |- (continuity_pt _ _) => - intro_hyp_pt X1 pt; intro_hyp_pt X2 pt - | _:(aux pt <> 0) |- (derive_pt _ _ _ = _) => - intro_hyp_pt X1 pt; intro_hyp_pt X2 pt - | id:(forall x0:R, aux x0 <> 0) |- (derivable_pt _ _) => - generalize (id pt); intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt - | id:(forall x0:R, aux x0 <> 0) |- (continuity_pt _ _) => - generalize (id pt); intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt - | id:(forall x0:R, aux x0 <> 0) |- (derive_pt _ _ _ = _) => - generalize (id pt); intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt - | |- (derivable_pt _ _) => - cut (aux pt <> 0); - [ intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | try assumption ] - | |- (continuity_pt _ _) => - cut (aux pt <> 0); - [ intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | try assumption ] - | |- (derive_pt _ _ _ = _) => - cut (aux pt <> 0); - [ intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | try assumption ] - | _ => idtac - end - | (comp ?X1 ?X2) => - match goal with - | |- (derivable_pt _ _) => + | |- (derivable_pt _ _) => let pt_f1 := eval cbv beta in (X2 pt) in - (intro_hyp_pt X1 pt_f1; intro_hyp_pt X2 pt) - | |- (continuity_pt _ _) => + (intro_hyp_pt X1 pt_f1; intro_hyp_pt X2 pt) + | |- (continuity_pt _ _) => let pt_f1 := eval cbv beta in (X2 pt) in - (intro_hyp_pt X1 pt_f1; intro_hyp_pt X2 pt) - | |- (derive_pt _ _ _ = _) => + (intro_hyp_pt X1 pt_f1; intro_hyp_pt X2 pt) + | |- (derive_pt _ _ _ = _) => let pt_f1 := eval cbv beta in (X2 pt) in - (intro_hyp_pt X1 pt_f1; intro_hyp_pt X2 pt) - | _ => idtac + (intro_hyp_pt X1 pt_f1; intro_hyp_pt X2 pt) + | _ => idtac end - | (- ?X1)%F => + | (- ?X1)%F => match goal with - | |- (derivable_pt _ _) => intro_hyp_pt X1 pt - | |- (continuity_pt _ _) => intro_hyp_pt X1 pt - | |- (derive_pt _ _ _ = _) => intro_hyp_pt X1 pt - | _ => idtac + | |- (derivable_pt _ _) => intro_hyp_pt X1 pt + | |- (continuity_pt _ _) => intro_hyp_pt X1 pt + | |- (derive_pt _ _ _ = _) => intro_hyp_pt X1 pt + | _ => idtac end - | (/ ?X1)%F => + | (/ ?X1)%F => let aux := constr:X1 in + match goal with + | _:(aux pt <> 0) |- (derivable_pt _ _) => + intro_hyp_pt X1 pt + | _:(aux pt <> 0) |- (continuity_pt _ _) => + intro_hyp_pt X1 pt + | _:(aux pt <> 0) |- (derive_pt _ _ _ = _) => + intro_hyp_pt X1 pt + | id:(forall x0:R, aux x0 <> 0) |- (derivable_pt _ _) => + generalize (id pt); intro; intro_hyp_pt X1 pt + | id:(forall x0:R, aux x0 <> 0) |- (continuity_pt _ _) => + generalize (id pt); intro; intro_hyp_pt X1 pt + | id:(forall x0:R, aux x0 <> 0) |- (derive_pt _ _ _ = _) => + generalize (id pt); intro; intro_hyp_pt X1 pt + | |- (derivable_pt _ _) => + cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt | try assumption ] + | |- (continuity_pt _ _) => + cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt | try assumption ] + | |- (derive_pt _ _ _ = _) => + cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt | try assumption ] + | _ => idtac + end + | cos => idtac + | sin => idtac + | cosh => idtac + | sinh => idtac + | exp => idtac + | Rsqr => idtac + | id => idtac + | (fct_cte _) => idtac + | (pow_fct _) => idtac + | sqrt => match goal with - | _:(aux pt <> 0) |- (derivable_pt _ _) => - intro_hyp_pt X1 pt - | _:(aux pt <> 0) |- (continuity_pt _ _) => - intro_hyp_pt X1 pt - | _:(aux pt <> 0) |- (derive_pt _ _ _ = _) => - intro_hyp_pt X1 pt - | id:(forall x0:R, aux x0 <> 0) |- (derivable_pt _ _) => - generalize (id pt); intro; intro_hyp_pt X1 pt - | id:(forall x0:R, aux x0 <> 0) |- (continuity_pt _ _) => - generalize (id pt); intro; intro_hyp_pt X1 pt - | id:(forall x0:R, aux x0 <> 0) |- (derive_pt _ _ _ = _) => - generalize (id pt); intro; intro_hyp_pt X1 pt - | |- (derivable_pt _ _) => - cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt | try assumption ] - | |- (continuity_pt _ _) => - cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt | try assumption ] - | |- (derive_pt _ _ _ = _) => - cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt | try assumption ] - | _ => idtac - end - | cos => idtac - | sin => idtac - | cosh => idtac - | sinh => idtac - | exp => idtac - | Rsqr => idtac - | id => idtac - | (fct_cte _) => idtac - | (pow_fct _) => idtac - | sqrt => - match goal with - | |- (derivable_pt _ _) => cut (0 < pt); [ intro | try assumption ] - | |- (continuity_pt _ _) => + | |- (derivable_pt _ _) => cut (0 < pt); [ intro | try assumption ] + | |- (continuity_pt _ _) => cut (0 <= pt); [ intro | try assumption ] - | |- (derive_pt _ _ _ = _) => + | |- (derive_pt _ _ _ = _) => cut (0 < pt); [ intro | try assumption ] - | _ => idtac + | _ => idtac end - | Rabs => + | Rabs => match goal with - | |- (derivable_pt _ _) => + | |- (derivable_pt _ _) => cut (pt <> 0); [ intro | try assumption ] - | _ => idtac + | _ => idtac end - | ?X1 => + | ?X1 => let p := constr:X1 in - match goal with - | _:(derivable_pt p pt) |- _ => idtac - | |- (derivable_pt p pt) => idtac - | |- (derivable_pt _ _) => - cut (True -> derivable_pt p pt); - [ intro HYPPD; cut (derivable_pt p pt); - [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ] - | idtac ] - | _:(continuity_pt p pt) |- _ => idtac - | |- (continuity_pt p pt) => idtac - | |- (continuity_pt _ _) => - cut (True -> continuity_pt p pt); - [ intro HYPPD; cut (continuity_pt p pt); - [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ] - | idtac ] - | |- (derive_pt _ _ _ = _) => - cut (True -> derivable_pt p pt); - [ intro HYPPD; cut (derivable_pt p pt); - [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ] - | idtac ] - | _ => idtac - end + match goal with + | _:(derivable_pt p pt) |- _ => idtac + | |- (derivable_pt p pt) => idtac + | |- (derivable_pt _ _) => + cut (True -> derivable_pt p pt); + [ intro HYPPD; cut (derivable_pt p pt); + [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ] + | idtac ] + | _:(continuity_pt p pt) |- _ => idtac + | |- (continuity_pt p pt) => idtac + | |- (continuity_pt _ _) => + cut (True -> continuity_pt p pt); + [ intro HYPPD; cut (continuity_pt p pt); + [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ] + | idtac ] + | |- (derive_pt _ _ _ = _) => + cut (True -> derivable_pt p pt); + [ intro HYPPD; cut (derivable_pt p pt); + [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ] + | idtac ] + | _ => idtac + end end. - + (**********) Ltac is_diff_pt := match goal with - | |- (derivable_pt Rsqr _) => + | |- (derivable_pt Rsqr _) => (* fonctions de base *) - apply derivable_pt_Rsqr - | |- (derivable_pt id ?X1) => apply (derivable_pt_id X1) - | |- (derivable_pt (fct_cte _) _) => apply derivable_pt_const - | |- (derivable_pt sin _) => apply derivable_pt_sin - | |- (derivable_pt cos _) => apply derivable_pt_cos - | |- (derivable_pt sinh _) => apply derivable_pt_sinh - | |- (derivable_pt cosh _) => apply derivable_pt_cosh - | |- (derivable_pt exp _) => apply derivable_pt_exp - | |- (derivable_pt (pow_fct _) _) => + apply derivable_pt_Rsqr + | |- (derivable_pt id ?X1) => apply (derivable_pt_id X1) + | |- (derivable_pt (fct_cte _) _) => apply derivable_pt_const + | |- (derivable_pt sin _) => apply derivable_pt_sin + | |- (derivable_pt cos _) => apply derivable_pt_cos + | |- (derivable_pt sinh _) => apply derivable_pt_sinh + | |- (derivable_pt cosh _) => apply derivable_pt_cosh + | |- (derivable_pt exp _) => apply derivable_pt_exp + | |- (derivable_pt (pow_fct _) _) => unfold pow_fct in |- *; apply derivable_pt_pow - | |- (derivable_pt sqrt ?X1) => + | |- (derivable_pt sqrt ?X1) => apply (derivable_pt_sqrt X1); - assumption || - unfold plus_fct, minus_fct, opp_fct, mult_fct, div_fct, inv_fct, - comp, id, fct_cte, pow_fct in |- * - | |- (derivable_pt Rabs ?X1) => + assumption || + unfold plus_fct, minus_fct, opp_fct, mult_fct, div_fct, inv_fct, + comp, id, fct_cte, pow_fct in |- * + | |- (derivable_pt Rabs ?X1) => apply (Rderivable_pt_abs X1); - assumption || - unfold plus_fct, minus_fct, opp_fct, mult_fct, div_fct, inv_fct, - comp, id, fct_cte, pow_fct in |- * + assumption || + unfold plus_fct, minus_fct, opp_fct, mult_fct, div_fct, inv_fct, + comp, id, fct_cte, pow_fct in |- * (* regles de differentiabilite *) (* PLUS *) - | |- (derivable_pt (?X1 + ?X2) ?X3) => + | |- (derivable_pt (?X1 + ?X2) ?X3) => apply (derivable_pt_plus X1 X2 X3); is_diff_pt (* MOINS *) - | |- (derivable_pt (?X1 - ?X2) ?X3) => + | |- (derivable_pt (?X1 - ?X2) ?X3) => apply (derivable_pt_minus X1 X2 X3); is_diff_pt (* OPPOSE *) - | |- (derivable_pt (- ?X1) ?X2) => + | |- (derivable_pt (- ?X1) ?X2) => apply (derivable_pt_opp X1 X2); - is_diff_pt + is_diff_pt (* MULTIPLICATION PAR UN SCALAIRE *) - | |- (derivable_pt (mult_real_fct ?X1 ?X2) ?X3) => + | |- (derivable_pt (mult_real_fct ?X1 ?X2) ?X3) => apply (derivable_pt_scal X2 X1 X3); is_diff_pt (* MULTIPLICATION *) - | |- (derivable_pt (?X1 * ?X2) ?X3) => + | |- (derivable_pt (?X1 * ?X2) ?X3) => apply (derivable_pt_mult X1 X2 X3); is_diff_pt (* DIVISION *) - | |- (derivable_pt (?X1 / ?X2) ?X3) => + | |- (derivable_pt (?X1 / ?X2) ?X3) => apply (derivable_pt_div X1 X2 X3); - [ is_diff_pt - | is_diff_pt - | try - assumption || - unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, - comp, pow_fct, id, fct_cte in |- * ] - | |- (derivable_pt (/ ?X1) ?X2) => + [ is_diff_pt + | is_diff_pt + | try + assumption || + unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, + comp, pow_fct, id, fct_cte in |- * ] + | |- (derivable_pt (/ ?X1) ?X2) => (* INVERSION *) - apply (derivable_pt_inv X1 X2); - [ assumption || - unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, + apply (derivable_pt_inv X1 X2); + [ assumption || + unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, comp, pow_fct, id, fct_cte in |- * - | is_diff_pt ] - | |- (derivable_pt (comp ?X1 ?X2) ?X3) => + | is_diff_pt ] + | |- (derivable_pt (comp ?X1 ?X2) ?X3) => (* COMPOSITION *) - apply (derivable_pt_comp X2 X1 X3); is_diff_pt - | _:(derivable_pt ?X1 ?X2) |- (derivable_pt ?X1 ?X2) => + apply (derivable_pt_comp X2 X1 X3); is_diff_pt + | _:(derivable_pt ?X1 ?X2) |- (derivable_pt ?X1 ?X2) => assumption - | _:(derivable ?X1) |- (derivable_pt ?X1 ?X2) => + | _:(derivable ?X1) |- (derivable_pt ?X1 ?X2) => cut (derivable X1); [ intro HypDDPT; apply HypDDPT | assumption ] - | |- (True -> derivable_pt _ _) => + | |- (True -> derivable_pt _ _) => intro HypTruE; clear HypTruE; is_diff_pt - | _ => + | _ => try - unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id, - fct_cte, comp, pow_fct in |- * + unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id, + fct_cte, comp, pow_fct in |- * end. (**********) Ltac is_diff_glob := match goal with - | |- (derivable Rsqr) => + | |- (derivable Rsqr) => (* fonctions de base *) - apply derivable_Rsqr - | |- (derivable id) => apply derivable_id - | |- (derivable (fct_cte _)) => apply derivable_const - | |- (derivable sin) => apply derivable_sin - | |- (derivable cos) => apply derivable_cos - | |- (derivable cosh) => apply derivable_cosh - | |- (derivable sinh) => apply derivable_sinh - | |- (derivable exp) => apply derivable_exp - | |- (derivable (pow_fct _)) => + apply derivable_Rsqr + | |- (derivable id) => apply derivable_id + | |- (derivable (fct_cte _)) => apply derivable_const + | |- (derivable sin) => apply derivable_sin + | |- (derivable cos) => apply derivable_cos + | |- (derivable cosh) => apply derivable_cosh + | |- (derivable sinh) => apply derivable_sinh + | |- (derivable exp) => apply derivable_exp + | |- (derivable (pow_fct _)) => unfold pow_fct in |- *; - apply derivable_pow + apply derivable_pow (* regles de differentiabilite *) (* PLUS *) - | |- (derivable (?X1 + ?X2)) => + | |- (derivable (?X1 + ?X2)) => apply (derivable_plus X1 X2); is_diff_glob (* MOINS *) - | |- (derivable (?X1 - ?X2)) => + | |- (derivable (?X1 - ?X2)) => apply (derivable_minus X1 X2); is_diff_glob (* OPPOSE *) - | |- (derivable (- ?X1)) => + | |- (derivable (- ?X1)) => apply (derivable_opp X1); - is_diff_glob + is_diff_glob (* MULTIPLICATION PAR UN SCALAIRE *) - | |- (derivable (mult_real_fct ?X1 ?X2)) => + | |- (derivable (mult_real_fct ?X1 ?X2)) => apply (derivable_scal X2 X1); is_diff_glob (* MULTIPLICATION *) - | |- (derivable (?X1 * ?X2)) => + | |- (derivable (?X1 * ?X2)) => apply (derivable_mult X1 X2); is_diff_glob (* DIVISION *) - | |- (derivable (?X1 / ?X2)) => + | |- (derivable (?X1 / ?X2)) => apply (derivable_div X1 X2); - [ is_diff_glob - | is_diff_glob - | try - assumption || - unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, - id, fct_cte, comp, pow_fct in |- * ] - | |- (derivable (/ ?X1)) => + [ is_diff_glob + | is_diff_glob + | try + assumption || + unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, + id, fct_cte, comp, pow_fct in |- * ] + | |- (derivable (/ ?X1)) => (* INVERSION *) - apply (derivable_inv X1); - [ try + apply (derivable_inv X1); + [ try assumption || unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, - id, fct_cte, comp, pow_fct in |- * - | is_diff_glob ] - | |- (derivable (comp sqrt _)) => + id, fct_cte, comp, pow_fct in |- * + | is_diff_glob ] + | |- (derivable (comp sqrt _)) => (* COMPOSITION *) - unfold derivable in |- *; intro; try is_diff_pt - | |- (derivable (comp Rabs _)) => unfold derivable in |- *; intro; try is_diff_pt - | |- (derivable (comp ?X1 ?X2)) => + | |- (derivable (comp Rabs _)) => + unfold derivable in |- *; intro; try is_diff_pt + | |- (derivable (comp ?X1 ?X2)) => apply (derivable_comp X2 X1); is_diff_glob - | _:(derivable ?X1) |- (derivable ?X1) => assumption - | |- (True -> derivable _) => + | _:(derivable ?X1) |- (derivable ?X1) => assumption + | |- (True -> derivable _) => intro HypTruE; clear HypTruE; is_diff_glob - | _ => + | _ => try - unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id, - fct_cte, comp, pow_fct in |- * + unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id, + fct_cte, comp, pow_fct in |- * end. (**********) Ltac is_cont_pt := match goal with - | |- (continuity_pt Rsqr _) => + | |- (continuity_pt Rsqr _) => (* fonctions de base *) - apply derivable_continuous_pt; apply derivable_pt_Rsqr - | |- (continuity_pt id ?X1) => + apply derivable_continuous_pt; apply derivable_pt_Rsqr + | |- (continuity_pt id ?X1) => apply derivable_continuous_pt; apply (derivable_pt_id X1) - | |- (continuity_pt (fct_cte _) _) => + | |- (continuity_pt (fct_cte _) _) => apply derivable_continuous_pt; apply derivable_pt_const - | |- (continuity_pt sin _) => + | |- (continuity_pt sin _) => apply derivable_continuous_pt; apply derivable_pt_sin - | |- (continuity_pt cos _) => + | |- (continuity_pt cos _) => apply derivable_continuous_pt; apply derivable_pt_cos - | |- (continuity_pt sinh _) => + | |- (continuity_pt sinh _) => apply derivable_continuous_pt; apply derivable_pt_sinh - | |- (continuity_pt cosh _) => + | |- (continuity_pt cosh _) => apply derivable_continuous_pt; apply derivable_pt_cosh - | |- (continuity_pt exp _) => + | |- (continuity_pt exp _) => apply derivable_continuous_pt; apply derivable_pt_exp - | |- (continuity_pt (pow_fct _) _) => + | |- (continuity_pt (pow_fct _) _) => unfold pow_fct in |- *; apply derivable_continuous_pt; - apply derivable_pt_pow - | |- (continuity_pt sqrt ?X1) => + apply derivable_pt_pow + | |- (continuity_pt sqrt ?X1) => apply continuity_pt_sqrt; - assumption || - unfold plus_fct, minus_fct, opp_fct, mult_fct, div_fct, inv_fct, - comp, id, fct_cte, pow_fct in |- * - | |- (continuity_pt Rabs ?X1) => + assumption || + unfold plus_fct, minus_fct, opp_fct, mult_fct, div_fct, inv_fct, + comp, id, fct_cte, pow_fct in |- * + | |- (continuity_pt Rabs ?X1) => apply (Rcontinuity_abs X1) (* regles de differentiabilite *) (* PLUS *) - | |- (continuity_pt (?X1 + ?X2) ?X3) => + | |- (continuity_pt (?X1 + ?X2) ?X3) => apply (continuity_pt_plus X1 X2 X3); is_cont_pt (* MOINS *) - | |- (continuity_pt (?X1 - ?X2) ?X3) => + | |- (continuity_pt (?X1 - ?X2) ?X3) => apply (continuity_pt_minus X1 X2 X3); is_cont_pt (* OPPOSE *) - | |- (continuity_pt (- ?X1) ?X2) => + | |- (continuity_pt (- ?X1) ?X2) => apply (continuity_pt_opp X1 X2); - is_cont_pt + is_cont_pt (* MULTIPLICATION PAR UN SCALAIRE *) - | |- (continuity_pt (mult_real_fct ?X1 ?X2) ?X3) => + | |- (continuity_pt (mult_real_fct ?X1 ?X2) ?X3) => apply (continuity_pt_scal X2 X1 X3); is_cont_pt (* MULTIPLICATION *) - | |- (continuity_pt (?X1 * ?X2) ?X3) => + | |- (continuity_pt (?X1 * ?X2) ?X3) => apply (continuity_pt_mult X1 X2 X3); is_cont_pt (* DIVISION *) - | |- (continuity_pt (?X1 / ?X2) ?X3) => + | |- (continuity_pt (?X1 / ?X2) ?X3) => apply (continuity_pt_div X1 X2 X3); - [ is_cont_pt - | is_cont_pt - | try - assumption || - unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, - comp, id, fct_cte, pow_fct in |- * ] - | |- (continuity_pt (/ ?X1) ?X2) => + [ is_cont_pt + | is_cont_pt + | try + assumption || + unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, + comp, id, fct_cte, pow_fct in |- * ] + | |- (continuity_pt (/ ?X1) ?X2) => (* INVERSION *) - apply (continuity_pt_inv X1 X2); - [ is_cont_pt - | assumption || - unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, - comp, id, fct_cte, pow_fct in |- * ] - | |- (continuity_pt (comp ?X1 ?X2) ?X3) => + apply (continuity_pt_inv X1 X2); + [ is_cont_pt + | assumption || + unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, + comp, id, fct_cte, pow_fct in |- * ] + | |- (continuity_pt (comp ?X1 ?X2) ?X3) => (* COMPOSITION *) - apply (continuity_pt_comp X2 X1 X3); is_cont_pt - | _:(continuity_pt ?X1 ?X2) |- (continuity_pt ?X1 ?X2) => + apply (continuity_pt_comp X2 X1 X3); is_cont_pt + | _:(continuity_pt ?X1 ?X2) |- (continuity_pt ?X1 ?X2) => assumption - | _:(continuity ?X1) |- (continuity_pt ?X1 ?X2) => + | _:(continuity ?X1) |- (continuity_pt ?X1 ?X2) => cut (continuity X1); [ intro HypDDPT; apply HypDDPT | assumption ] - | _:(derivable_pt ?X1 ?X2) |- (continuity_pt ?X1 ?X2) => + | _:(derivable_pt ?X1 ?X2) |- (continuity_pt ?X1 ?X2) => apply derivable_continuous_pt; assumption - | _:(derivable ?X1) |- (continuity_pt ?X1 ?X2) => + | _:(derivable ?X1) |- (continuity_pt ?X1 ?X2) => cut (continuity X1); - [ intro HypDDPT; apply HypDDPT - | apply derivable_continuous; assumption ] - | |- (True -> continuity_pt _ _) => + [ intro HypDDPT; apply HypDDPT + | apply derivable_continuous; assumption ] + | |- (True -> continuity_pt _ _) => intro HypTruE; clear HypTruE; is_cont_pt - | _ => + | _ => try - unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id, - fct_cte, comp, pow_fct in |- * + unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id, + fct_cte, comp, pow_fct in |- * end. (**********) Ltac is_cont_glob := match goal with - | |- (continuity Rsqr) => + | |- (continuity Rsqr) => (* fonctions de base *) - apply derivable_continuous; apply derivable_Rsqr - | |- (continuity id) => apply derivable_continuous; apply derivable_id - | |- (continuity (fct_cte _)) => + apply derivable_continuous; apply derivable_Rsqr + | |- (continuity id) => apply derivable_continuous; apply derivable_id + | |- (continuity (fct_cte _)) => apply derivable_continuous; apply derivable_const - | |- (continuity sin) => apply derivable_continuous; apply derivable_sin - | |- (continuity cos) => apply derivable_continuous; apply derivable_cos - | |- (continuity exp) => apply derivable_continuous; apply derivable_exp - | |- (continuity (pow_fct _)) => + | |- (continuity sin) => apply derivable_continuous; apply derivable_sin + | |- (continuity cos) => apply derivable_continuous; apply derivable_cos + | |- (continuity exp) => apply derivable_continuous; apply derivable_exp + | |- (continuity (pow_fct _)) => unfold pow_fct in |- *; apply derivable_continuous; apply derivable_pow - | |- (continuity sinh) => + | |- (continuity sinh) => apply derivable_continuous; apply derivable_sinh - | |- (continuity cosh) => + | |- (continuity cosh) => apply derivable_continuous; apply derivable_cosh - | |- (continuity Rabs) => + | |- (continuity Rabs) => apply Rcontinuity_abs (* regles de continuite *) (* PLUS *) - | |- (continuity (?X1 + ?X2)) => + | |- (continuity (?X1 + ?X2)) => apply (continuity_plus X1 X2); - try is_cont_glob || assumption + try is_cont_glob || assumption (* MOINS *) - | |- (continuity (?X1 - ?X2)) => + | |- (continuity (?X1 - ?X2)) => apply (continuity_minus X1 X2); - try is_cont_glob || assumption + try is_cont_glob || assumption (* OPPOSE *) - | |- (continuity (- ?X1)) => + | |- (continuity (- ?X1)) => apply (continuity_opp X1); try is_cont_glob || assumption (* INVERSE *) - | |- (continuity (/ ?X1)) => + | |- (continuity (/ ?X1)) => apply (continuity_inv X1); - try is_cont_glob || assumption + try is_cont_glob || assumption (* MULTIPLICATION PAR UN SCALAIRE *) - | |- (continuity (mult_real_fct ?X1 ?X2)) => + | |- (continuity (mult_real_fct ?X1 ?X2)) => apply (continuity_scal X2 X1); - try is_cont_glob || assumption + try is_cont_glob || assumption (* MULTIPLICATION *) - | |- (continuity (?X1 * ?X2)) => + | |- (continuity (?X1 * ?X2)) => apply (continuity_mult X1 X2); - try is_cont_glob || assumption + try is_cont_glob || assumption (* DIVISION *) - | |- (continuity (?X1 / ?X2)) => + | |- (continuity (?X1 / ?X2)) => apply (continuity_div X1 X2); - [ try is_cont_glob || assumption - | try is_cont_glob || assumption - | try - assumption || - unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, - id, fct_cte, pow_fct in |- * ] - | |- (continuity (comp sqrt _)) => + [ try is_cont_glob || assumption + | try is_cont_glob || assumption + | try + assumption || + unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, + id, fct_cte, pow_fct in |- * ] + | |- (continuity (comp sqrt _)) => (* COMPOSITION *) - unfold continuity_pt in |- *; intro; try is_cont_pt - | |- (continuity (comp ?X1 ?X2)) => + unfold continuity_pt in |- *; intro; try is_cont_pt + | |- (continuity (comp ?X1 ?X2)) => apply (continuity_comp X2 X1); try is_cont_glob || assumption - | _:(continuity ?X1) |- (continuity ?X1) => assumption - | |- (True -> continuity _) => + | _:(continuity ?X1) |- (continuity ?X1) => assumption + | |- (True -> continuity _) => intro HypTruE; clear HypTruE; is_cont_glob - | _:(derivable ?X1) |- (continuity ?X1) => + | _:(derivable ?X1) |- (continuity ?X1) => apply derivable_continuous; assumption - | _ => + | _ => try - unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id, - fct_cte, comp, pow_fct in |- * + unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id, + fct_cte, comp, pow_fct in |- * end. (**********) Ltac rew_term trm := match constr:trm with - | (?X1 + ?X2) => + | (?X1 + ?X2) => let p1 := rew_term X1 with p2 := rew_term X2 in - match constr:p1 with - | (fct_cte ?X3) => - match constr:p2 with - | (fct_cte ?X4) => constr:(fct_cte (X3 + X4)) + match constr:p1 with + | (fct_cte ?X3) => + match constr:p2 with + | (fct_cte ?X4) => constr:(fct_cte (X3 + X4)) + | _ => constr:(p1 + p2)%F + end | _ => constr:(p1 + p2)%F - end - | _ => constr:(p1 + p2)%F - end - | (?X1 - ?X2) => + end + | (?X1 - ?X2) => let p1 := rew_term X1 with p2 := rew_term X2 in - match constr:p1 with - | (fct_cte ?X3) => - match constr:p2 with - | (fct_cte ?X4) => constr:(fct_cte (X3 - X4)) + match constr:p1 with + | (fct_cte ?X3) => + match constr:p2 with + | (fct_cte ?X4) => constr:(fct_cte (X3 - X4)) + | _ => constr:(p1 - p2)%F + end | _ => constr:(p1 - p2)%F - end - | _ => constr:(p1 - p2)%F - end - | (?X1 / ?X2) => + end + | (?X1 / ?X2) => let p1 := rew_term X1 with p2 := rew_term X2 in - match constr:p1 with - | (fct_cte ?X3) => - match constr:p2 with - | (fct_cte ?X4) => constr:(fct_cte (X3 / X4)) - | _ => constr:(p1 / p2)%F - end - | _ => - match constr:p2 with - | (fct_cte ?X4) => constr:(p1 * fct_cte (/ X4))%F - | _ => constr:(p1 / p2)%F - end - end - | (?X1 * / ?X2) => + match constr:p1 with + | (fct_cte ?X3) => + match constr:p2 with + | (fct_cte ?X4) => constr:(fct_cte (X3 / X4)) + | _ => constr:(p1 / p2)%F + end + | _ => + match constr:p2 with + | (fct_cte ?X4) => constr:(p1 * fct_cte (/ X4))%F + | _ => constr:(p1 / p2)%F + end + end + | (?X1 * / ?X2) => let p1 := rew_term X1 with p2 := rew_term X2 in - match constr:p1 with - | (fct_cte ?X3) => - match constr:p2 with - | (fct_cte ?X4) => constr:(fct_cte (X3 / X4)) - | _ => constr:(p1 / p2)%F - end - | _ => - match constr:p2 with - | (fct_cte ?X4) => constr:(p1 * fct_cte (/ X4))%F - | _ => constr:(p1 / p2)%F - end - end - | (?X1 * ?X2) => + match constr:p1 with + | (fct_cte ?X3) => + match constr:p2 with + | (fct_cte ?X4) => constr:(fct_cte (X3 / X4)) + | _ => constr:(p1 / p2)%F + end + | _ => + match constr:p2 with + | (fct_cte ?X4) => constr:(p1 * fct_cte (/ X4))%F + | _ => constr:(p1 / p2)%F + end + end + | (?X1 * ?X2) => let p1 := rew_term X1 with p2 := rew_term X2 in - match constr:p1 with - | (fct_cte ?X3) => - match constr:p2 with - | (fct_cte ?X4) => constr:(fct_cte (X3 * X4)) + match constr:p1 with + | (fct_cte ?X3) => + match constr:p2 with + | (fct_cte ?X4) => constr:(fct_cte (X3 * X4)) + | _ => constr:(p1 * p2)%F + end | _ => constr:(p1 * p2)%F - end - | _ => constr:(p1 * p2)%F - end - | (- ?X1) => + end + | (- ?X1) => let p := rew_term X1 in - match constr:p with - | (fct_cte ?X2) => constr:(fct_cte (- X2)) - | _ => constr:(- p)%F - end - | (/ ?X1) => + match constr:p with + | (fct_cte ?X2) => constr:(fct_cte (- X2)) + | _ => constr:(- p)%F + end + | (/ ?X1) => let p := rew_term X1 in - match constr:p with - | (fct_cte ?X2) => constr:(fct_cte (/ X2)) - | _ => constr:(/ p)%F - end - | (?X1 AppVar) => constr:X1 - | (?X1 ?X2) => + match constr:p with + | (fct_cte ?X2) => constr:(fct_cte (/ X2)) + | _ => constr:(/ p)%F + end + | (?X1 AppVar) => constr:X1 + | (?X1 ?X2) => let p := rew_term X2 in - match constr:p with - | (fct_cte ?X3) => constr:(fct_cte (X1 X3)) - | _ => constr:(comp X1 p) - end - | AppVar => constr:id - | (AppVar ^ ?X1) => constr:(pow_fct X1) - | (?X1 ^ ?X2) => + match constr:p with + | (fct_cte ?X3) => constr:(fct_cte (X1 X3)) + | _ => constr:(comp X1 p) + end + | AppVar => constr:id + | (AppVar ^ ?X1) => constr:(pow_fct X1) + | (?X1 ^ ?X2) => let p := rew_term X1 in - match constr:p with - | (fct_cte ?X3) => constr:(fct_cte (pow_fct X2 X3)) - | _ => constr:(comp (pow_fct X2) p) - end - | ?X1 => constr:(fct_cte X1) + match constr:p with + | (fct_cte ?X3) => constr:(fct_cte (pow_fct X2 X3)) + | _ => constr:(comp (pow_fct X2) p) + end + | ?X1 => constr:(fct_cte X1) end. (**********) Ltac deriv_proof trm pt := match constr:trm with - | (?X1 + ?X2)%F => + | (?X1 + ?X2)%F => let p1 := deriv_proof X1 pt with p2 := deriv_proof X2 pt in - constr:(derivable_pt_plus X1 X2 pt p1 p2) - | (?X1 - ?X2)%F => + constr:(derivable_pt_plus X1 X2 pt p1 p2) + | (?X1 - ?X2)%F => let p1 := deriv_proof X1 pt with p2 := deriv_proof X2 pt in - constr:(derivable_pt_minus X1 X2 pt p1 p2) - | (?X1 * ?X2)%F => + constr:(derivable_pt_minus X1 X2 pt p1 p2) + | (?X1 * ?X2)%F => let p1 := deriv_proof X1 pt with p2 := deriv_proof X2 pt in - constr:(derivable_pt_mult X1 X2 pt p1 p2) - | (?X1 / ?X2)%F => + constr:(derivable_pt_mult X1 X2 pt p1 p2) + | (?X1 / ?X2)%F => match goal with - | id:(?X2 pt <> 0) |- _ => + | id:(?X2 pt <> 0) |- _ => let p1 := deriv_proof X1 pt with p2 := deriv_proof X2 pt in - constr:(derivable_pt_div X1 X2 pt p1 p2 id) - | _ => constr:False + constr:(derivable_pt_div X1 X2 pt p1 p2 id) + | _ => constr:False end - | (/ ?X1)%F => + | (/ ?X1)%F => match goal with - | id:(?X1 pt <> 0) |- _ => + | id:(?X1 pt <> 0) |- _ => let p1 := deriv_proof X1 pt in - constr:(derivable_pt_inv X1 pt p1 id) - | _ => constr:False + constr:(derivable_pt_inv X1 pt p1 id) + | _ => constr:False end - | (comp ?X1 ?X2) => + | (comp ?X1 ?X2) => let pt_f1 := eval cbv beta in (X2 pt) in - let p1 := deriv_proof X1 pt_f1 with p2 := deriv_proof X2 pt in - constr:(derivable_pt_comp X2 X1 pt p2 p1) - | (- ?X1)%F => + let p1 := deriv_proof X1 pt_f1 with p2 := deriv_proof X2 pt in + constr:(derivable_pt_comp X2 X1 pt p2 p1) + | (- ?X1)%F => let p1 := deriv_proof X1 pt in - constr:(derivable_pt_opp X1 pt p1) - | sin => constr:(derivable_pt_sin pt) - | cos => constr:(derivable_pt_cos pt) - | sinh => constr:(derivable_pt_sinh pt) - | cosh => constr:(derivable_pt_cosh pt) - | exp => constr:(derivable_pt_exp pt) - | id => constr:(derivable_pt_id pt) - | Rsqr => constr:(derivable_pt_Rsqr pt) - | sqrt => + constr:(derivable_pt_opp X1 pt p1) + | sin => constr:(derivable_pt_sin pt) + | cos => constr:(derivable_pt_cos pt) + | sinh => constr:(derivable_pt_sinh pt) + | cosh => constr:(derivable_pt_cosh pt) + | exp => constr:(derivable_pt_exp pt) + | id => constr:(derivable_pt_id pt) + | Rsqr => constr:(derivable_pt_Rsqr pt) + | sqrt => match goal with - | id:(0 < pt) |- _ => constr:(derivable_pt_sqrt pt id) - | _ => constr:False + | id:(0 < pt) |- _ => constr:(derivable_pt_sqrt pt id) + | _ => constr:False end - | (fct_cte ?X1) => constr:(derivable_pt_const X1 pt) - | ?X1 => + | (fct_cte ?X1) => constr:(derivable_pt_const X1 pt) + | ?X1 => let aux := constr:X1 in - match goal with - | id:(derivable_pt aux pt) |- _ => constr:id - | id:(derivable aux) |- _ => constr:(id pt) - | _ => constr:False - end + match goal with + | id:(derivable_pt aux pt) |- _ => constr:id + | id:(derivable aux) |- _ => constr:(id pt) + | _ => constr:False + end end. (**********) Ltac simplify_derive trm pt := match constr:trm with - | (?X1 + ?X2)%F => + | (?X1 + ?X2)%F => try rewrite derive_pt_plus; simplify_derive X1 pt; - simplify_derive X2 pt - | (?X1 - ?X2)%F => + simplify_derive X2 pt + | (?X1 - ?X2)%F => try rewrite derive_pt_minus; simplify_derive X1 pt; - simplify_derive X2 pt - | (?X1 * ?X2)%F => + simplify_derive X2 pt + | (?X1 * ?X2)%F => try rewrite derive_pt_mult; simplify_derive X1 pt; - simplify_derive X2 pt - | (?X1 / ?X2)%F => + simplify_derive X2 pt + | (?X1 / ?X2)%F => try rewrite derive_pt_div; simplify_derive X1 pt; simplify_derive X2 pt - | (comp ?X1 ?X2) => + | (comp ?X1 ?X2) => let pt_f1 := eval cbv beta in (X2 pt) in - (try rewrite derive_pt_comp; simplify_derive X1 pt_f1; - simplify_derive X2 pt) - | (- ?X1)%F => try rewrite derive_pt_opp; simplify_derive X1 pt - | (/ ?X1)%F => + (try rewrite derive_pt_comp; simplify_derive X1 pt_f1; + simplify_derive X2 pt) + | (- ?X1)%F => try rewrite derive_pt_opp; simplify_derive X1 pt + | (/ ?X1)%F => try rewrite derive_pt_inv; simplify_derive X1 pt - | (fct_cte ?X1) => try rewrite derive_pt_const - | id => try rewrite derive_pt_id - | sin => try rewrite derive_pt_sin - | cos => try rewrite derive_pt_cos - | sinh => try rewrite derive_pt_sinh - | cosh => try rewrite derive_pt_cosh - | exp => try rewrite derive_pt_exp - | Rsqr => try rewrite derive_pt_Rsqr - | sqrt => try rewrite derive_pt_sqrt - | ?X1 => + | (fct_cte ?X1) => try rewrite derive_pt_const + | id => try rewrite derive_pt_id + | sin => try rewrite derive_pt_sin + | cos => try rewrite derive_pt_cos + | sinh => try rewrite derive_pt_sinh + | cosh => try rewrite derive_pt_cosh + | exp => try rewrite derive_pt_exp + | Rsqr => try rewrite derive_pt_Rsqr + | sqrt => try rewrite derive_pt_sqrt + | ?X1 => let aux := constr:X1 in - match goal with - | id:(derive_pt aux pt ?X2 = _),H:(derivable aux) |- _ => - try replace (derive_pt aux pt (H pt)) with (derive_pt aux pt X2); - [ rewrite id | apply pr_nu ] - | id:(derive_pt aux pt ?X2 = _),H:(derivable_pt aux pt) |- _ => - try replace (derive_pt aux pt H) with (derive_pt aux pt X2); - [ rewrite id | apply pr_nu ] - | _ => idtac - end - | _ => idtac + match goal with + | id:(derive_pt aux pt ?X2 = _),H:(derivable aux) |- _ => + try replace (derive_pt aux pt (H pt)) with (derive_pt aux pt X2); + [ rewrite id | apply pr_nu ] + | id:(derive_pt aux pt ?X2 = _),H:(derivable_pt aux pt) |- _ => + try replace (derive_pt aux pt H) with (derive_pt aux pt X2); + [ rewrite id | apply pr_nu ] + | _ => idtac + end + | _ => idtac end. (**********) Ltac reg := match goal with - | |- (derivable_pt ?X1 ?X2) => + | |- (derivable_pt ?X1 ?X2) => let trm := eval cbv beta in (X1 AppVar) in - let aux := rew_term trm in - (intro_hyp_pt aux X2; - try (change (derivable_pt aux X2) in |- *; is_diff_pt) || is_diff_pt) - | |- (derivable ?X1) => + let aux := rew_term trm in + (intro_hyp_pt aux X2; + try (change (derivable_pt aux X2) in |- *; is_diff_pt) || is_diff_pt) + | |- (derivable ?X1) => let trm := eval cbv beta in (X1 AppVar) in - let aux := rew_term trm in - (intro_hyp_glob aux; - try (change (derivable aux) in |- *; is_diff_glob) || is_diff_glob) - | |- (continuity ?X1) => + let aux := rew_term trm in + (intro_hyp_glob aux; + try (change (derivable aux) in |- *; is_diff_glob) || is_diff_glob) + | |- (continuity ?X1) => let trm := eval cbv beta in (X1 AppVar) in - let aux := rew_term trm in - (intro_hyp_glob aux; - try (change (continuity aux) in |- *; is_cont_glob) || is_cont_glob) - | |- (continuity_pt ?X1 ?X2) => + let aux := rew_term trm in + (intro_hyp_glob aux; + try (change (continuity aux) in |- *; is_cont_glob) || is_cont_glob) + | |- (continuity_pt ?X1 ?X2) => let trm := eval cbv beta in (X1 AppVar) in - let aux := rew_term trm in - (intro_hyp_pt aux X2; - try (change (continuity_pt aux X2) in |- *; is_cont_pt) || is_cont_pt) - | |- (derive_pt ?X1 ?X2 ?X3 = ?X4) => + let aux := rew_term trm in + (intro_hyp_pt aux X2; + try (change (continuity_pt aux X2) in |- *; is_cont_pt) || is_cont_pt) + | |- (derive_pt ?X1 ?X2 ?X3 = ?X4) => let trm := eval cbv beta in (X1 AppVar) in let aux := rew_term trm in - (intro_hyp_pt aux X2; - let aux2 := deriv_proof aux X2 in - (try - (replace (derive_pt X1 X2 X3) with (derive_pt aux X2 aux2); - [ simplify_derive aux X2; - try - unfold plus_fct, minus_fct, mult_fct, div_fct, id, fct_cte, - inv_fct, opp_fct in |- *; try ring - | try apply pr_nu ]) || is_diff_pt)) - end.
\ No newline at end of file + intro_hyp_pt aux X2; + (let aux2 := deriv_proof aux X2 in + try + (replace (derive_pt X1 X2 X3) with (derive_pt aux X2 aux2); + [ simplify_derive aux X2; + try unfold plus_fct, minus_fct, mult_fct, div_fct, id, fct_cte, + inv_fct, opp_fct in |- *; ring || ring_simplify + | try apply pr_nu ]) || is_diff_pt) + end. diff --git a/theories/Reals/Ranalysis1.v b/theories/Reals/Ranalysis1.v index 0148d0a2..93a66e70 100644 --- a/theories/Reals/Ranalysis1.v +++ b/theories/Reals/Ranalysis1.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Ranalysis1.v 9042 2006-07-11 22:06:48Z herbelin $ i*) +(*i $Id: Ranalysis1.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -15,7 +15,7 @@ Require Export Rderiv. Open Local Scope R_scope. Implicit Type f : R -> R. (****************************************************) -(** Basic operations on functions *) +(** * Basic operations on functions *) (****************************************************) Definition plus_fct f1 f2 (x:R) : R := f1 x + f2 x. Definition opp_fct f (x:R) : R := - f x. @@ -52,14 +52,14 @@ Definition fct_cte (a x:R) : R := a. Definition id (x:R) := x. (****************************************************) -(** Variations of functions *) +(** * Variations of functions *) (****************************************************) Definition increasing f : Prop := forall x y:R, x <= y -> f x <= f y. Definition decreasing f : Prop := forall x y:R, x <= y -> f y <= f x. Definition strict_increasing f : Prop := forall x y:R, x < y -> f x < f y. Definition strict_decreasing f : Prop := forall x y:R, x < y -> f y < f x. Definition constant f : Prop := forall x y:R, f x = f y. - + (**********) Definition no_cond (x:R) : Prop := True. @@ -68,7 +68,7 @@ Definition constant_D_eq f (D:R -> Prop) (c:R) : Prop := forall x:R, D x -> f x = c. (***************************************************) -(** Definition of continuity as a limit *) +(** * Definition of continuity as a limit *) (***************************************************) (**********) @@ -80,173 +80,192 @@ Arguments Scope continuity [Rfun_scope]. (**********) Lemma continuity_pt_plus : - forall f1 f2 (x0:R), - continuity_pt f1 x0 -> continuity_pt f2 x0 -> continuity_pt (f1 + f2) x0. -unfold continuity_pt, plus_fct in |- *; unfold continue_in in |- *; intros; - apply limit_plus; assumption. + forall f1 f2 (x0:R), + continuity_pt f1 x0 -> continuity_pt f2 x0 -> continuity_pt (f1 + f2) x0. +Proof. + unfold continuity_pt, plus_fct in |- *; unfold continue_in in |- *; intros; + apply limit_plus; assumption. Qed. Lemma continuity_pt_opp : - forall f (x0:R), continuity_pt f x0 -> continuity_pt (- f) x0. -unfold continuity_pt, opp_fct in |- *; unfold continue_in in |- *; intros; - apply limit_Ropp; assumption. + forall f (x0:R), continuity_pt f x0 -> continuity_pt (- f) x0. +Proof. + unfold continuity_pt, opp_fct in |- *; unfold continue_in in |- *; intros; + apply limit_Ropp; assumption. Qed. - + Lemma continuity_pt_minus : - forall f1 f2 (x0:R), - continuity_pt f1 x0 -> continuity_pt f2 x0 -> continuity_pt (f1 - f2) x0. -unfold continuity_pt, minus_fct in |- *; unfold continue_in in |- *; intros; - apply limit_minus; assumption. + forall f1 f2 (x0:R), + continuity_pt f1 x0 -> continuity_pt f2 x0 -> continuity_pt (f1 - f2) x0. +Proof. + unfold continuity_pt, minus_fct in |- *; unfold continue_in in |- *; intros; + apply limit_minus; assumption. Qed. Lemma continuity_pt_mult : - forall f1 f2 (x0:R), - continuity_pt f1 x0 -> continuity_pt f2 x0 -> continuity_pt (f1 * f2) x0. -unfold continuity_pt, mult_fct in |- *; unfold continue_in in |- *; intros; - apply limit_mul; assumption. + forall f1 f2 (x0:R), + continuity_pt f1 x0 -> continuity_pt f2 x0 -> continuity_pt (f1 * f2) x0. +Proof. + unfold continuity_pt, mult_fct in |- *; unfold continue_in in |- *; intros; + apply limit_mul; assumption. Qed. Lemma continuity_pt_const : forall f (x0:R), constant f -> continuity_pt f x0. -unfold constant, continuity_pt in |- *; unfold continue_in in |- *; - unfold limit1_in in |- *; unfold limit_in in |- *; - intros; exists 1; split; - [ apply Rlt_0_1 - | intros; generalize (H x x0); intro; rewrite H2; simpl in |- *; - rewrite R_dist_eq; assumption ]. +Proof. + unfold constant, continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + intros; exists 1; split; + [ apply Rlt_0_1 + | intros; generalize (H x x0); intro; rewrite H2; simpl in |- *; + rewrite R_dist_eq; assumption ]. Qed. Lemma continuity_pt_scal : - forall f (a x0:R), - continuity_pt f x0 -> continuity_pt (mult_real_fct a f) x0. -unfold continuity_pt, mult_real_fct in |- *; unfold continue_in in |- *; - intros; apply (limit_mul (fun x:R => a) f (D_x no_cond x0) a (f x0) x0). -unfold limit1_in in |- *; unfold limit_in in |- *; intros; exists 1; split. -apply Rlt_0_1. -intros; rewrite R_dist_eq; assumption. -assumption. + forall f (a x0:R), + continuity_pt f x0 -> continuity_pt (mult_real_fct a f) x0. +Proof. + unfold continuity_pt, mult_real_fct in |- *; unfold continue_in in |- *; + intros; apply (limit_mul (fun x:R => a) f (D_x no_cond x0) a (f x0) x0). + unfold limit1_in in |- *; unfold limit_in in |- *; intros; exists 1; split. + apply Rlt_0_1. + intros; rewrite R_dist_eq; assumption. + assumption. Qed. Lemma continuity_pt_inv : - forall f (x0:R), continuity_pt f x0 -> f x0 <> 0 -> continuity_pt (/ f) x0. -intros. -replace (/ f)%F with (fun x:R => / f x). -unfold continuity_pt in |- *; unfold continue_in in |- *; intros; - apply limit_inv; assumption. -unfold inv_fct in |- *; reflexivity. -Qed. - + forall f (x0:R), continuity_pt f x0 -> f x0 <> 0 -> continuity_pt (/ f) x0. +Proof. + intros. + replace (/ f)%F with (fun x:R => / f x). + unfold continuity_pt in |- *; unfold continue_in in |- *; intros; + apply limit_inv; assumption. + unfold inv_fct in |- *; reflexivity. +Qed. + Lemma div_eq_inv : forall f1 f2, (f1 / f2)%F = (f1 * / f2)%F. -intros; reflexivity. +Proof. + intros; reflexivity. Qed. - + Lemma continuity_pt_div : - forall f1 f2 (x0:R), - continuity_pt f1 x0 -> - continuity_pt f2 x0 -> f2 x0 <> 0 -> continuity_pt (f1 / f2) x0. -intros; rewrite (div_eq_inv f1 f2); apply continuity_pt_mult; - [ assumption | apply continuity_pt_inv; assumption ]. + forall f1 f2 (x0:R), + continuity_pt f1 x0 -> + continuity_pt f2 x0 -> f2 x0 <> 0 -> continuity_pt (f1 / f2) x0. +Proof. + intros; rewrite (div_eq_inv f1 f2); apply continuity_pt_mult; + [ assumption | apply continuity_pt_inv; assumption ]. Qed. Lemma continuity_pt_comp : - forall f1 f2 (x:R), - continuity_pt f1 x -> continuity_pt f2 (f1 x) -> continuity_pt (f2 o f1) x. -unfold continuity_pt in |- *; unfold continue_in in |- *; intros; - unfold comp in |- *. -cut - (limit1_in (fun x0:R => f2 (f1 x0)) - (Dgf (D_x no_cond x) (D_x no_cond (f1 x)) f1) ( - f2 (f1 x)) x -> - limit1_in (fun x0:R => f2 (f1 x0)) (D_x no_cond x) (f2 (f1 x)) x). -intro; apply H1. -eapply limit_comp. -apply H. -apply H0. -unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *; - simpl in |- *; unfold R_dist in |- *; intros. -assert (H3 := H1 eps H2). -elim H3; intros. -exists x0. -split. -elim H4; intros; assumption. -intros; case (Req_dec (f1 x) (f1 x1)); intro. -rewrite H6; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; - assumption. -elim H4; intros; apply H8. -split. -unfold Dgf, D_x, no_cond in |- *. -split. -split. -trivial. -elim H5; unfold D_x, no_cond in |- *; intros. -elim H9; intros; assumption. -split. -trivial. -assumption. -elim H5; intros; assumption. + forall f1 f2 (x:R), + continuity_pt f1 x -> continuity_pt f2 (f1 x) -> continuity_pt (f2 o f1) x. +Proof. + unfold continuity_pt in |- *; unfold continue_in in |- *; intros; + unfold comp in |- *. + cut + (limit1_in (fun x0:R => f2 (f1 x0)) + (Dgf (D_x no_cond x) (D_x no_cond (f1 x)) f1) ( + f2 (f1 x)) x -> + limit1_in (fun x0:R => f2 (f1 x0)) (D_x no_cond x) (f2 (f1 x)) x). + intro; apply H1. + eapply limit_comp. + apply H. + apply H0. + unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *; + simpl in |- *; unfold R_dist in |- *; intros. + assert (H3 := H1 eps H2). + elim H3; intros. + exists x0. + split. + elim H4; intros; assumption. + intros; case (Req_dec (f1 x) (f1 x1)); intro. + rewrite H6; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + assumption. + elim H4; intros; apply H8. + split. + unfold Dgf, D_x, no_cond in |- *. + split. + split. + trivial. + elim H5; unfold D_x, no_cond in |- *; intros. + elim H9; intros; assumption. + split. + trivial. + assumption. + elim H5; intros; assumption. Qed. (**********) Lemma continuity_plus : - forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 + f2). -unfold continuity in |- *; intros; - apply (continuity_pt_plus f1 f2 x (H x) (H0 x)). + forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 + f2). +Proof. + unfold continuity in |- *; intros; + apply (continuity_pt_plus f1 f2 x (H x) (H0 x)). Qed. Lemma continuity_opp : forall f, continuity f -> continuity (- f). -unfold continuity in |- *; intros; apply (continuity_pt_opp f x (H x)). +Proof. + unfold continuity in |- *; intros; apply (continuity_pt_opp f x (H x)). Qed. Lemma continuity_minus : - forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 - f2). -unfold continuity in |- *; intros; - apply (continuity_pt_minus f1 f2 x (H x) (H0 x)). + forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 - f2). +Proof. + unfold continuity in |- *; intros; + apply (continuity_pt_minus f1 f2 x (H x) (H0 x)). Qed. - + Lemma continuity_mult : - forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 * f2). -unfold continuity in |- *; intros; - apply (continuity_pt_mult f1 f2 x (H x) (H0 x)). + forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 * f2). +Proof. + unfold continuity in |- *; intros; + apply (continuity_pt_mult f1 f2 x (H x) (H0 x)). Qed. Lemma continuity_const : forall f, constant f -> continuity f. -unfold continuity in |- *; intros; apply (continuity_pt_const f x H). +Proof. + unfold continuity in |- *; intros; apply (continuity_pt_const f x H). Qed. Lemma continuity_scal : - forall f (a:R), continuity f -> continuity (mult_real_fct a f). -unfold continuity in |- *; intros; apply (continuity_pt_scal f a x (H x)). + forall f (a:R), continuity f -> continuity (mult_real_fct a f). +Proof. + unfold continuity in |- *; intros; apply (continuity_pt_scal f a x (H x)). Qed. - + Lemma continuity_inv : - forall f, continuity f -> (forall x:R, f x <> 0) -> continuity (/ f). -unfold continuity in |- *; intros; apply (continuity_pt_inv f x (H x) (H0 x)). + forall f, continuity f -> (forall x:R, f x <> 0) -> continuity (/ f). +Proof. + unfold continuity in |- *; intros; apply (continuity_pt_inv f x (H x) (H0 x)). Qed. Lemma continuity_div : - forall f1 f2, - continuity f1 -> - continuity f2 -> (forall x:R, f2 x <> 0) -> continuity (f1 / f2). -unfold continuity in |- *; intros; - apply (continuity_pt_div f1 f2 x (H x) (H0 x) (H1 x)). + forall f1 f2, + continuity f1 -> + continuity f2 -> (forall x:R, f2 x <> 0) -> continuity (f1 / f2). +Proof. + unfold continuity in |- *; intros; + apply (continuity_pt_div f1 f2 x (H x) (H0 x) (H1 x)). Qed. - + Lemma continuity_comp : - forall f1 f2, continuity f1 -> continuity f2 -> continuity (f2 o f1). -unfold continuity in |- *; intros. -apply (continuity_pt_comp f1 f2 x (H x) (H0 (f1 x))). + forall f1 f2, continuity f1 -> continuity f2 -> continuity (f2 o f1). +Proof. + unfold continuity in |- *; intros. + apply (continuity_pt_comp f1 f2 x (H x) (H0 (f1 x))). Qed. (*****************************************************) -(** Derivative's definition using Landau's kernel *) +(** * Derivative's definition using Landau's kernel *) (*****************************************************) Definition derivable_pt_lim f (x l:R) : Prop := forall eps:R, 0 < eps -> - exists delta : posreal, + exists delta : posreal, (forall h:R, - h <> 0 -> Rabs h < delta -> Rabs ((f (x + h) - f x) / h - l) < eps). + h <> 0 -> Rabs h < delta -> Rabs ((f (x + h) - f x) / h - l) < eps). Definition derivable_pt_abs f (x l:R) : Prop := derivable_pt_lim f x l. @@ -265,1225 +284,1279 @@ Arguments Scope derive [Rfun_scope _]. Definition antiderivative f (g:R -> R) (a b:R) : Prop := (forall x:R, - a <= x <= b -> exists pr : derivable_pt g x, f x = derive_pt g x pr) /\ + a <= x <= b -> exists pr : derivable_pt g x, f x = derive_pt g x pr) /\ a <= b. -(************************************) -(** Class of differential functions *) -(************************************) +(**************************************) +(** * Class of differential functions *) +(**************************************) Record Differential : Type := mkDifferential {d1 :> R -> R; cond_diff : derivable d1}. - + Record Differential_D2 : Type := mkDifferential_D2 {d2 :> R -> R; - cond_D1 : derivable d2; - cond_D2 : derivable (derive d2 cond_D1)}. + cond_D1 : derivable d2; + cond_D2 : derivable (derive d2 cond_D1)}. (**********) Lemma uniqueness_step1 : - forall f (x l1 l2:R), - limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l1 0 -> - limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l2 0 -> - l1 = l2. -intros; - apply - (single_limit (fun h:R => (f (x + h) - f x) / h) ( - fun h:R => h <> 0) l1 l2 0); try assumption. -unfold adhDa in |- *; intros; exists (alp / 2). -split. -unfold Rdiv in |- *; apply prod_neq_R0. -red in |- *; intro; rewrite H2 in H1; elim (Rlt_irrefl _ H1). -apply Rinv_neq_0_compat; discrR. -unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; - rewrite Rplus_0_r; unfold Rdiv in |- *; rewrite Rabs_mult. -replace (Rabs (/ 2)) with (/ 2). -replace (Rabs alp) with alp. -apply Rmult_lt_reg_l with 2. -prove_sup0. -rewrite (Rmult_comm 2); rewrite Rmult_assoc; rewrite <- Rinv_l_sym; - [ idtac | discrR ]; rewrite Rmult_1_r; rewrite double; - pattern alp at 1 in |- *; replace alp with (alp + 0); - [ idtac | ring ]; apply Rplus_lt_compat_l; assumption. -symmetry in |- *; apply Rabs_right; left; assumption. -symmetry in |- *; apply Rabs_right; left; change (0 < / 2) in |- *; - apply Rinv_0_lt_compat; prove_sup0. + forall f (x l1 l2:R), + limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l1 0 -> + limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l2 0 -> + l1 = l2. +Proof. + intros; + apply + (single_limit (fun h:R => (f (x + h) - f x) / h) ( + fun h:R => h <> 0) l1 l2 0); try assumption. + unfold adhDa in |- *; intros; exists (alp / 2). + split. + unfold Rdiv in |- *; apply prod_neq_R0. + red in |- *; intro; rewrite H2 in H1; elim (Rlt_irrefl _ H1). + apply Rinv_neq_0_compat; discrR. + unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; unfold Rdiv in |- *; rewrite Rabs_mult. + replace (Rabs (/ 2)) with (/ 2). + replace (Rabs alp) with alp. + apply Rmult_lt_reg_l with 2. + prove_sup0. + rewrite (Rmult_comm 2); rewrite Rmult_assoc; rewrite <- Rinv_l_sym; + [ idtac | discrR ]; rewrite Rmult_1_r; rewrite double; + pattern alp at 1 in |- *; replace alp with (alp + 0); + [ idtac | ring ]; apply Rplus_lt_compat_l; assumption. + symmetry in |- *; apply Rabs_right; left; assumption. + symmetry in |- *; apply Rabs_right; left; change (0 < / 2) in |- *; + apply Rinv_0_lt_compat; prove_sup0. Qed. Lemma uniqueness_step2 : - forall f (x l:R), - derivable_pt_lim f x l -> - limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l 0. -unfold derivable_pt_lim in |- *; intros; unfold limit1_in in |- *; - unfold limit_in in |- *; intros. -assert (H1 := H eps H0). -elim H1; intros. -exists (pos x0). -split. -apply (cond_pos x0). -simpl in |- *; unfold R_dist in |- *; intros. -elim H3; intros. -apply H2; - [ assumption - | unfold Rminus in H5; rewrite Ropp_0 in H5; rewrite Rplus_0_r in H5; - assumption ]. + forall f (x l:R), + derivable_pt_lim f x l -> + limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l 0. +Proof. + unfold derivable_pt_lim in |- *; intros; unfold limit1_in in |- *; + unfold limit_in in |- *; intros. + assert (H1 := H eps H0). + elim H1; intros. + exists (pos x0). + split. + apply (cond_pos x0). + simpl in |- *; unfold R_dist in |- *; intros. + elim H3; intros. + apply H2; + [ assumption + | unfold Rminus in H5; rewrite Ropp_0 in H5; rewrite Rplus_0_r in H5; + assumption ]. Qed. Lemma uniqueness_step3 : - forall f (x l:R), - limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l 0 -> - derivable_pt_lim f x l. -unfold limit1_in, derivable_pt_lim in |- *; unfold limit_in in |- *; - unfold dist in |- *; simpl in |- *; intros. -elim (H eps H0). -intros; elim H1; intros. -exists (mkposreal x0 H2). -simpl in |- *; intros; unfold R_dist in H3; apply (H3 h). -split; - [ assumption - | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; assumption ]. + forall f (x l:R), + limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l 0 -> + derivable_pt_lim f x l. +Proof. + unfold limit1_in, derivable_pt_lim in |- *; unfold limit_in in |- *; + unfold dist in |- *; simpl in |- *; intros. + elim (H eps H0). + intros; elim H1; intros. + exists (mkposreal x0 H2). + simpl in |- *; intros; unfold R_dist in H3; apply (H3 h). + split; + [ assumption + | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; assumption ]. Qed. Lemma uniqueness_limite : - forall f (x l1 l2:R), - derivable_pt_lim f x l1 -> derivable_pt_lim f x l2 -> l1 = l2. -intros. -assert (H1 := uniqueness_step2 _ _ _ H). -assert (H2 := uniqueness_step2 _ _ _ H0). -assert (H3 := uniqueness_step1 _ _ _ _ H1 H2). -assumption. + forall f (x l1 l2:R), + derivable_pt_lim f x l1 -> derivable_pt_lim f x l2 -> l1 = l2. +Proof. + intros. + assert (H1 := uniqueness_step2 _ _ _ H). + assert (H2 := uniqueness_step2 _ _ _ H0). + assert (H3 := uniqueness_step1 _ _ _ _ H1 H2). + assumption. Qed. Lemma derive_pt_eq : - forall f (x l:R) (pr:derivable_pt f x), - derive_pt f x pr = l <-> derivable_pt_lim f x l. -intros; split. -intro; assert (H1 := projT2 pr); unfold derive_pt in H; rewrite H in H1; - assumption. -intro; assert (H1 := projT2 pr); unfold derivable_pt_abs in H1. -assert (H2 := uniqueness_limite _ _ _ _ H H1). -unfold derive_pt in |- *; unfold derivable_pt_abs in |- *. -symmetry in |- *; assumption. + forall f (x l:R) (pr:derivable_pt f x), + derive_pt f x pr = l <-> derivable_pt_lim f x l. +Proof. + intros; split. + intro; assert (H1 := projT2 pr); unfold derive_pt in H; rewrite H in H1; + assumption. + intro; assert (H1 := projT2 pr); unfold derivable_pt_abs in H1. + assert (H2 := uniqueness_limite _ _ _ _ H H1). + unfold derive_pt in |- *; unfold derivable_pt_abs in |- *. + symmetry in |- *; assumption. Qed. (**********) Lemma derive_pt_eq_0 : - forall f (x l:R) (pr:derivable_pt f x), - derivable_pt_lim f x l -> derive_pt f x pr = l. -intros; elim (derive_pt_eq f x l pr); intros. -apply (H1 H). + forall f (x l:R) (pr:derivable_pt f x), + derivable_pt_lim f x l -> derive_pt f x pr = l. +Proof. + intros; elim (derive_pt_eq f x l pr); intros. + apply (H1 H). Qed. (**********) Lemma derive_pt_eq_1 : - forall f (x l:R) (pr:derivable_pt f x), - derive_pt f x pr = l -> derivable_pt_lim f x l. -intros; elim (derive_pt_eq f x l pr); intros. -apply (H0 H). + forall f (x l:R) (pr:derivable_pt f x), + derive_pt f x pr = l -> derivable_pt_lim f x l. +Proof. + intros; elim (derive_pt_eq f x l pr); intros. + apply (H0 H). Qed. -(********************************************************************) -(** Equivalence of this definition with the one using limit concept *) -(********************************************************************) +(**********************************************************************) +(** * Equivalence of this definition with the one using limit concept *) +(**********************************************************************) Lemma derive_pt_D_in : - forall f (df:R -> R) (x:R) (pr:derivable_pt f x), - D_in f df no_cond x <-> derive_pt f x pr = df x. -intros; split. -unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *; - simpl in |- *; unfold R_dist in |- *; intros. -apply derive_pt_eq_0. -unfold derivable_pt_lim in |- *. -intros; elim (H eps H0); intros alpha H1; elim H1; intros; - exists (mkposreal alpha H2); intros; generalize (H3 (x + h)); - intro; cut (x + h - x = h); - [ intro; cut (D_x no_cond x (x + h) /\ Rabs (x + h - x) < alpha); - [ intro; generalize (H6 H8); rewrite H7; intro; assumption - | split; - [ unfold D_x in |- *; split; - [ unfold no_cond in |- *; trivial - | apply Rminus_not_eq_right; rewrite H7; assumption ] - | rewrite H7; assumption ] ] - | ring ]. -intro. -assert (H0 := derive_pt_eq_1 f x (df x) pr H). -unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *; - unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; - intros. -elim (H0 eps H1); intros alpha H2; exists (pos alpha); split. -apply (cond_pos alpha). -intros; elim H3; intros; unfold D_x in H4; elim H4; intros; cut (x0 - x <> 0). -intro; generalize (H2 (x0 - x) H8 H5); replace (x + (x0 - x)) with x0. -intro; assumption. -ring. -auto with real. + forall f (df:R -> R) (x:R) (pr:derivable_pt f x), + D_in f df no_cond x <-> derive_pt f x pr = df x. +Proof. + intros; split. + unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros. + apply derive_pt_eq_0. + unfold derivable_pt_lim in |- *. + intros; elim (H eps H0); intros alpha H1; elim H1; intros; + exists (mkposreal alpha H2); intros; generalize (H3 (x + h)); + intro; cut (x + h - x = h); + [ intro; cut (D_x no_cond x (x + h) /\ Rabs (x + h - x) < alpha); + [ intro; generalize (H6 H8); rewrite H7; intro; assumption + | split; + [ unfold D_x in |- *; split; + [ unfold no_cond in |- *; trivial + | apply Rminus_not_eq_right; rewrite H7; assumption ] + | rewrite H7; assumption ] ] + | ring ]. + intro. + assert (H0 := derive_pt_eq_1 f x (df x) pr H). + unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *; + unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; + intros. + elim (H0 eps H1); intros alpha H2; exists (pos alpha); split. + apply (cond_pos alpha). + intros; elim H3; intros; unfold D_x in H4; elim H4; intros; cut (x0 - x <> 0). + intro; generalize (H2 (x0 - x) H8 H5); replace (x + (x0 - x)) with x0. + intro; assumption. + ring. + auto with real. Qed. Lemma derivable_pt_lim_D_in : - forall f (df:R -> R) (x:R), - D_in f df no_cond x <-> derivable_pt_lim f x (df x). -intros; split. -unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *; - simpl in |- *; unfold R_dist in |- *; intros. -unfold derivable_pt_lim in |- *. -intros; elim (H eps H0); intros alpha H1; elim H1; intros; - exists (mkposreal alpha H2); intros; generalize (H3 (x + h)); - intro; cut (x + h - x = h); - [ intro; cut (D_x no_cond x (x + h) /\ Rabs (x + h - x) < alpha); - [ intro; generalize (H6 H8); rewrite H7; intro; assumption - | split; - [ unfold D_x in |- *; split; - [ unfold no_cond in |- *; trivial - | apply Rminus_not_eq_right; rewrite H7; assumption ] - | rewrite H7; assumption ] ] - | ring ]. -intro. -unfold derivable_pt_lim in H. -unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *; - unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; - intros. -elim (H eps H0); intros alpha H2; exists (pos alpha); split. -apply (cond_pos alpha). -intros. -elim H1; intros; unfold D_x in H3; elim H3; intros; cut (x0 - x <> 0). -intro; generalize (H2 (x0 - x) H7 H4); replace (x + (x0 - x)) with x0. -intro; assumption. -ring. -auto with real. + forall f (df:R -> R) (x:R), + D_in f df no_cond x <-> derivable_pt_lim f x (df x). +Proof. + intros; split. + unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros. + unfold derivable_pt_lim in |- *. + intros; elim (H eps H0); intros alpha H1; elim H1; intros; + exists (mkposreal alpha H2); intros; generalize (H3 (x + h)); + intro; cut (x + h - x = h); + [ intro; cut (D_x no_cond x (x + h) /\ Rabs (x + h - x) < alpha); + [ intro; generalize (H6 H8); rewrite H7; intro; assumption + | split; + [ unfold D_x in |- *; split; + [ unfold no_cond in |- *; trivial + | apply Rminus_not_eq_right; rewrite H7; assumption ] + | rewrite H7; assumption ] ] + | ring ]. + intro. + unfold derivable_pt_lim in H. + unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *; + unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; + intros. + elim (H eps H0); intros alpha H2; exists (pos alpha); split. + apply (cond_pos alpha). + intros. + elim H1; intros; unfold D_x in H3; elim H3; intros; cut (x0 - x <> 0). + intro; generalize (H2 (x0 - x) H7 H4); replace (x + (x0 - x)) with x0. + intro; assumption. + ring. + auto with real. Qed. (***********************************) -(** derivability -> continuity *) +(** * derivability -> continuity *) (***********************************) (**********) Lemma derivable_derive : - forall f (x:R) (pr:derivable_pt f x), exists l : R, derive_pt f x pr = l. -intros; exists (projT1 pr). -unfold derive_pt in |- *; reflexivity. + forall f (x:R) (pr:derivable_pt f x), exists l : R, derive_pt f x pr = l. +Proof. + intros; exists (projT1 pr). + unfold derive_pt in |- *; reflexivity. Qed. Theorem derivable_continuous_pt : - forall f (x:R), derivable_pt f x -> continuity_pt f x. -intros f x X. -generalize (derivable_derive f x X); intro. -elim H; intros l H1. -cut (l = fct_cte l x). -intro. -rewrite H0 in H1. -generalize (derive_pt_D_in f (fct_cte l) x); intro. -elim (H2 X); intros. -generalize (H4 H1); intro. -unfold continuity_pt in |- *. -apply (cont_deriv f (fct_cte l) no_cond x H5). -unfold fct_cte in |- *; reflexivity. + forall f (x:R), derivable_pt f x -> continuity_pt f x. +Proof. + intros f x X. + generalize (derivable_derive f x X); intro. + elim H; intros l H1. + cut (l = fct_cte l x). + intro. + rewrite H0 in H1. + generalize (derive_pt_D_in f (fct_cte l) x); intro. + elim (H2 X); intros. + generalize (H4 H1); intro. + unfold continuity_pt in |- *. + apply (cont_deriv f (fct_cte l) no_cond x H5). + unfold fct_cte in |- *; reflexivity. Qed. Theorem derivable_continuous : forall f, derivable f -> continuity f. -unfold derivable, continuity in |- *; intros f X x. -apply (derivable_continuous_pt f x (X x)). +Proof. + unfold derivable, continuity in |- *; intros f X x. + apply (derivable_continuous_pt f x (X x)). Qed. (****************************************************************) -(** Main rules *) +(** * Main rules *) (****************************************************************) Lemma derivable_pt_lim_plus : - forall f1 f2 (x l1 l2:R), - derivable_pt_lim f1 x l1 -> - derivable_pt_lim f2 x l2 -> derivable_pt_lim (f1 + f2) x (l1 + l2). -intros. -apply uniqueness_step3. -assert (H1 := uniqueness_step2 _ _ _ H). -assert (H2 := uniqueness_step2 _ _ _ H0). -unfold plus_fct in |- *. -cut - (forall h:R, - (f1 (x + h) + f2 (x + h) - (f1 x + f2 x)) / h = - (f1 (x + h) - f1 x) / h + (f2 (x + h) - f2 x) / h). -intro. -generalize - (limit_plus (fun h':R => (f1 (x + h') - f1 x) / h') - (fun h':R => (f2 (x + h') - f2 x) / h') (fun h:R => h <> 0) l1 l2 0 H1 H2). -unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *; - simpl in |- *; unfold R_dist in |- *; intros. -elim (H4 eps H5); intros. -exists x0. -elim H6; intros. -split. -assumption. -intros; rewrite H3; apply H8; assumption. -intro; unfold Rdiv in |- *; ring. + forall f1 f2 (x l1 l2:R), + derivable_pt_lim f1 x l1 -> + derivable_pt_lim f2 x l2 -> derivable_pt_lim (f1 + f2) x (l1 + l2). + intros. + apply uniqueness_step3. + assert (H1 := uniqueness_step2 _ _ _ H). + assert (H2 := uniqueness_step2 _ _ _ H0). + unfold plus_fct in |- *. + cut + (forall h:R, + (f1 (x + h) + f2 (x + h) - (f1 x + f2 x)) / h = + (f1 (x + h) - f1 x) / h + (f2 (x + h) - f2 x) / h). + intro. + generalize + (limit_plus (fun h':R => (f1 (x + h') - f1 x) / h') + (fun h':R => (f2 (x + h') - f2 x) / h') (fun h:R => h <> 0) l1 l2 0 H1 H2). + unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *; + simpl in |- *; unfold R_dist in |- *; intros. + elim (H4 eps H5); intros. + exists x0. + elim H6; intros. + split. + assumption. + intros; rewrite H3; apply H8; assumption. + intro; unfold Rdiv in |- *; ring. Qed. Lemma derivable_pt_lim_opp : - forall f (x l:R), derivable_pt_lim f x l -> derivable_pt_lim (- f) x (- l). -intros. -apply uniqueness_step3. -assert (H1 := uniqueness_step2 _ _ _ H). -unfold opp_fct in |- *. -cut (forall h:R, (- f (x + h) - - f x) / h = - ((f (x + h) - f x) / h)). -intro. -generalize - (limit_Ropp (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l 0 H1). -unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *; - simpl in |- *; unfold R_dist in |- *; intros. -elim (H2 eps H3); intros. -exists x0. -elim H4; intros. -split. -assumption. -intros; rewrite H0; apply H6; assumption. -intro; unfold Rdiv in |- *; ring. + forall f (x l:R), derivable_pt_lim f x l -> derivable_pt_lim (- f) x (- l). +Proof. + intros. + apply uniqueness_step3. + assert (H1 := uniqueness_step2 _ _ _ H). + unfold opp_fct in |- *. + cut (forall h:R, (- f (x + h) - - f x) / h = - ((f (x + h) - f x) / h)). + intro. + generalize + (limit_Ropp (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l 0 H1). + unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *; + simpl in |- *; unfold R_dist in |- *; intros. + elim (H2 eps H3); intros. + exists x0. + elim H4; intros. + split. + assumption. + intros; rewrite H0; apply H6; assumption. + intro; unfold Rdiv in |- *; ring. Qed. Lemma derivable_pt_lim_minus : - forall f1 f2 (x l1 l2:R), - derivable_pt_lim f1 x l1 -> - derivable_pt_lim f2 x l2 -> derivable_pt_lim (f1 - f2) x (l1 - l2). -intros. -apply uniqueness_step3. -assert (H1 := uniqueness_step2 _ _ _ H). -assert (H2 := uniqueness_step2 _ _ _ H0). -unfold minus_fct in |- *. -cut - (forall h:R, - (f1 (x + h) - f1 x) / h - (f2 (x + h) - f2 x) / h = - (f1 (x + h) - f2 (x + h) - (f1 x - f2 x)) / h). -intro. -generalize - (limit_minus (fun h':R => (f1 (x + h') - f1 x) / h') - (fun h':R => (f2 (x + h') - f2 x) / h') (fun h:R => h <> 0) l1 l2 0 H1 H2). -unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *; - simpl in |- *; unfold R_dist in |- *; intros. -elim (H4 eps H5); intros. -exists x0. -elim H6; intros. -split. -assumption. -intros; rewrite <- H3; apply H8; assumption. -intro; unfold Rdiv in |- *; ring. + forall f1 f2 (x l1 l2:R), + derivable_pt_lim f1 x l1 -> + derivable_pt_lim f2 x l2 -> derivable_pt_lim (f1 - f2) x (l1 - l2). +Proof. + intros. + apply uniqueness_step3. + assert (H1 := uniqueness_step2 _ _ _ H). + assert (H2 := uniqueness_step2 _ _ _ H0). + unfold minus_fct in |- *. + cut + (forall h:R, + (f1 (x + h) - f1 x) / h - (f2 (x + h) - f2 x) / h = + (f1 (x + h) - f2 (x + h) - (f1 x - f2 x)) / h). + intro. + generalize + (limit_minus (fun h':R => (f1 (x + h') - f1 x) / h') + (fun h':R => (f2 (x + h') - f2 x) / h') (fun h:R => h <> 0) l1 l2 0 H1 H2). + unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *; + simpl in |- *; unfold R_dist in |- *; intros. + elim (H4 eps H5); intros. + exists x0. + elim H6; intros. + split. + assumption. + intros; rewrite <- H3; apply H8; assumption. + intro; unfold Rdiv in |- *; ring. Qed. Lemma derivable_pt_lim_mult : - forall f1 f2 (x l1 l2:R), - derivable_pt_lim f1 x l1 -> - derivable_pt_lim f2 x l2 -> - derivable_pt_lim (f1 * f2) x (l1 * f2 x + f1 x * l2). -intros. -assert (H1 := derivable_pt_lim_D_in f1 (fun y:R => l1) x). -elim H1; intros. -assert (H4 := H3 H). -assert (H5 := derivable_pt_lim_D_in f2 (fun y:R => l2) x). -elim H5; intros. -assert (H8 := H7 H0). -clear H1 H2 H3 H5 H6 H7. -assert - (H1 := - derivable_pt_lim_D_in (f1 * f2)%F (fun y:R => l1 * f2 x + f1 x * l2) x). -elim H1; intros. -clear H1 H3. -apply H2. -unfold mult_fct in |- *. -apply (Dmult no_cond (fun y:R => l1) (fun y:R => l2) f1 f2 x); assumption. + forall f1 f2 (x l1 l2:R), + derivable_pt_lim f1 x l1 -> + derivable_pt_lim f2 x l2 -> + derivable_pt_lim (f1 * f2) x (l1 * f2 x + f1 x * l2). +Proof. + intros. + assert (H1 := derivable_pt_lim_D_in f1 (fun y:R => l1) x). + elim H1; intros. + assert (H4 := H3 H). + assert (H5 := derivable_pt_lim_D_in f2 (fun y:R => l2) x). + elim H5; intros. + assert (H8 := H7 H0). + clear H1 H2 H3 H5 H6 H7. + assert + (H1 := + derivable_pt_lim_D_in (f1 * f2)%F (fun y:R => l1 * f2 x + f1 x * l2) x). + elim H1; intros. + clear H1 H3. + apply H2. + unfold mult_fct in |- *. + apply (Dmult no_cond (fun y:R => l1) (fun y:R => l2) f1 f2 x); assumption. Qed. Lemma derivable_pt_lim_const : forall a x:R, derivable_pt_lim (fct_cte a) x 0. -intros; unfold fct_cte, derivable_pt_lim in |- *. -intros; exists (mkposreal 1 Rlt_0_1); intros; unfold Rminus in |- *; - rewrite Rplus_opp_r; unfold Rdiv in |- *; rewrite Rmult_0_l; - rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. +Proof. + intros; unfold fct_cte, derivable_pt_lim in |- *. + intros; exists (mkposreal 1 Rlt_0_1); intros; unfold Rminus in |- *; + rewrite Rplus_opp_r; unfold Rdiv in |- *; rewrite Rmult_0_l; + rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. Qed. Lemma derivable_pt_lim_scal : - forall f (a x l:R), - derivable_pt_lim f x l -> derivable_pt_lim (mult_real_fct a f) x (a * l). -intros. -assert (H0 := derivable_pt_lim_const a x). -replace (mult_real_fct a f) with (fct_cte a * f)%F. -replace (a * l) with (0 * f x + a * l); [ idtac | ring ]. -apply (derivable_pt_lim_mult (fct_cte a) f x 0 l); assumption. -unfold mult_real_fct, mult_fct, fct_cte in |- *; reflexivity. + forall f (a x l:R), + derivable_pt_lim f x l -> derivable_pt_lim (mult_real_fct a f) x (a * l). +Proof. + intros. + assert (H0 := derivable_pt_lim_const a x). + replace (mult_real_fct a f) with (fct_cte a * f)%F. + replace (a * l) with (0 * f x + a * l); [ idtac | ring ]. + apply (derivable_pt_lim_mult (fct_cte a) f x 0 l); assumption. + unfold mult_real_fct, mult_fct, fct_cte in |- *; reflexivity. Qed. Lemma derivable_pt_lim_id : forall x:R, derivable_pt_lim id x 1. -intro; unfold derivable_pt_lim in |- *. -intros eps Heps; exists (mkposreal eps Heps); intros h H1 H2; - unfold id in |- *; replace ((x + h - x) / h - 1) with 0. -rewrite Rabs_R0; apply Rle_lt_trans with (Rabs h). -apply Rabs_pos. -assumption. -unfold Rminus in |- *; rewrite Rplus_assoc; rewrite (Rplus_comm x); - rewrite Rplus_assoc. -rewrite Rplus_opp_l; rewrite Rplus_0_r; unfold Rdiv in |- *; - rewrite <- Rinv_r_sym. -symmetry in |- *; apply Rplus_opp_r. -assumption. +Proof. + intro; unfold derivable_pt_lim in |- *. + intros eps Heps; exists (mkposreal eps Heps); intros h H1 H2; + unfold id in |- *; replace ((x + h - x) / h - 1) with 0. + rewrite Rabs_R0; apply Rle_lt_trans with (Rabs h). + apply Rabs_pos. + assumption. + unfold Rminus in |- *; rewrite Rplus_assoc; rewrite (Rplus_comm x); + rewrite Rplus_assoc. + rewrite Rplus_opp_l; rewrite Rplus_0_r; unfold Rdiv in |- *; + rewrite <- Rinv_r_sym. + symmetry in |- *; apply Rplus_opp_r. + assumption. Qed. Lemma derivable_pt_lim_Rsqr : forall x:R, derivable_pt_lim Rsqr x (2 * x). -intro; unfold derivable_pt_lim in |- *. -unfold Rsqr in |- *; intros eps Heps; exists (mkposreal eps Heps); - intros h H1 H2; replace (((x + h) * (x + h) - x * x) / h - 2 * x) with h. -assumption. -replace ((x + h) * (x + h) - x * x) with (2 * x * h + h * h); - [ idtac | ring ]. -unfold Rdiv in |- *; rewrite Rmult_plus_distr_r. -repeat rewrite Rmult_assoc. -repeat rewrite <- Rinv_r_sym; [ idtac | assumption ]. -ring. +Proof. + intro; unfold derivable_pt_lim in |- *. + unfold Rsqr in |- *; intros eps Heps; exists (mkposreal eps Heps); + intros h H1 H2; replace (((x + h) * (x + h) - x * x) / h - 2 * x) with h. + assumption. + replace ((x + h) * (x + h) - x * x) with (2 * x * h + h * h); + [ idtac | ring ]. + unfold Rdiv in |- *; rewrite Rmult_plus_distr_r. + repeat rewrite Rmult_assoc. + repeat rewrite <- Rinv_r_sym; [ idtac | assumption ]. + ring. Qed. Lemma derivable_pt_lim_comp : - forall f1 f2 (x l1 l2:R), - derivable_pt_lim f1 x l1 -> - derivable_pt_lim f2 (f1 x) l2 -> derivable_pt_lim (f2 o f1) x (l2 * l1). -intros; assert (H1 := derivable_pt_lim_D_in f1 (fun y:R => l1) x). -elim H1; intros. -assert (H4 := H3 H). -assert (H5 := derivable_pt_lim_D_in f2 (fun y:R => l2) (f1 x)). -elim H5; intros. -assert (H8 := H7 H0). -clear H1 H2 H3 H5 H6 H7. -assert (H1 := derivable_pt_lim_D_in (f2 o f1)%F (fun y:R => l2 * l1) x). -elim H1; intros. -clear H1 H3; apply H2. -unfold comp in |- *; - cut - (D_in (fun x0:R => f2 (f1 x0)) (fun y:R => l2 * l1) - (Dgf no_cond no_cond f1) x -> - D_in (fun x0:R => f2 (f1 x0)) (fun y:R => l2 * l1) no_cond x). -intro; apply H1. -rewrite Rmult_comm; - apply (Dcomp no_cond no_cond (fun y:R => l1) (fun y:R => l2) f1 f2 x); - assumption. -unfold Dgf, D_in, no_cond in |- *; unfold limit1_in in |- *; - unfold limit_in in |- *; unfold dist in |- *; simpl in |- *; - unfold R_dist in |- *; intros. -elim (H1 eps H3); intros. -exists x0; intros; split. -elim H5; intros; assumption. -intros; elim H5; intros; apply H9; split. -unfold D_x in |- *; split. -split; trivial. -elim H6; intros; unfold D_x in H10; elim H10; intros; assumption. -elim H6; intros; assumption. + forall f1 f2 (x l1 l2:R), + derivable_pt_lim f1 x l1 -> + derivable_pt_lim f2 (f1 x) l2 -> derivable_pt_lim (f2 o f1) x (l2 * l1). +Proof. + intros; assert (H1 := derivable_pt_lim_D_in f1 (fun y:R => l1) x). + elim H1; intros. + assert (H4 := H3 H). + assert (H5 := derivable_pt_lim_D_in f2 (fun y:R => l2) (f1 x)). + elim H5; intros. + assert (H8 := H7 H0). + clear H1 H2 H3 H5 H6 H7. + assert (H1 := derivable_pt_lim_D_in (f2 o f1)%F (fun y:R => l2 * l1) x). + elim H1; intros. + clear H1 H3; apply H2. + unfold comp in |- *; + cut + (D_in (fun x0:R => f2 (f1 x0)) (fun y:R => l2 * l1) + (Dgf no_cond no_cond f1) x -> + D_in (fun x0:R => f2 (f1 x0)) (fun y:R => l2 * l1) no_cond x). + intro; apply H1. + rewrite Rmult_comm; + apply (Dcomp no_cond no_cond (fun y:R => l1) (fun y:R => l2) f1 f2 x); + assumption. + unfold Dgf, D_in, no_cond in |- *; unfold limit1_in in |- *; + unfold limit_in in |- *; unfold dist in |- *; simpl in |- *; + unfold R_dist in |- *; intros. + elim (H1 eps H3); intros. + exists x0; intros; split. + elim H5; intros; assumption. + intros; elim H5; intros; apply H9; split. + unfold D_x in |- *; split. + split; trivial. + elim H6; intros; unfold D_x in H10; elim H10; intros; assumption. + elim H6; intros; assumption. Qed. Lemma derivable_pt_plus : - forall f1 f2 (x:R), - derivable_pt f1 x -> derivable_pt f2 x -> derivable_pt (f1 + f2) x. -unfold derivable_pt in |- *; intros f1 f2 x X X0. -elim X; intros. -elim X0; intros. -apply existT with (x0 + x1). -apply derivable_pt_lim_plus; assumption. + forall f1 f2 (x:R), + derivable_pt f1 x -> derivable_pt f2 x -> derivable_pt (f1 + f2) x. +Proof. + unfold derivable_pt in |- *; intros f1 f2 x X X0. + elim X; intros. + elim X0; intros. + apply existT with (x0 + x1). + apply derivable_pt_lim_plus; assumption. Qed. Lemma derivable_pt_opp : - forall f (x:R), derivable_pt f x -> derivable_pt (- f) x. -unfold derivable_pt in |- *; intros f x X. -elim X; intros. -apply existT with (- x0). -apply derivable_pt_lim_opp; assumption. + forall f (x:R), derivable_pt f x -> derivable_pt (- f) x. +Proof. + unfold derivable_pt in |- *; intros f x X. + elim X; intros. + apply existT with (- x0). + apply derivable_pt_lim_opp; assumption. Qed. Lemma derivable_pt_minus : - forall f1 f2 (x:R), - derivable_pt f1 x -> derivable_pt f2 x -> derivable_pt (f1 - f2) x. -unfold derivable_pt in |- *; intros f1 f2 x X X0. -elim X; intros. -elim X0; intros. -apply existT with (x0 - x1). -apply derivable_pt_lim_minus; assumption. + forall f1 f2 (x:R), + derivable_pt f1 x -> derivable_pt f2 x -> derivable_pt (f1 - f2) x. +Proof. + unfold derivable_pt in |- *; intros f1 f2 x X X0. + elim X; intros. + elim X0; intros. + apply existT with (x0 - x1). + apply derivable_pt_lim_minus; assumption. Qed. Lemma derivable_pt_mult : - forall f1 f2 (x:R), - derivable_pt f1 x -> derivable_pt f2 x -> derivable_pt (f1 * f2) x. -unfold derivable_pt in |- *; intros f1 f2 x X X0. -elim X; intros. -elim X0; intros. -apply existT with (x0 * f2 x + f1 x * x1). -apply derivable_pt_lim_mult; assumption. + forall f1 f2 (x:R), + derivable_pt f1 x -> derivable_pt f2 x -> derivable_pt (f1 * f2) x. +Proof. + unfold derivable_pt in |- *; intros f1 f2 x X X0. + elim X; intros. + elim X0; intros. + apply existT with (x0 * f2 x + f1 x * x1). + apply derivable_pt_lim_mult; assumption. Qed. Lemma derivable_pt_const : forall a x:R, derivable_pt (fct_cte a) x. -intros; unfold derivable_pt in |- *. -apply existT with 0. -apply derivable_pt_lim_const. +Proof. + intros; unfold derivable_pt in |- *. + apply existT with 0. + apply derivable_pt_lim_const. Qed. Lemma derivable_pt_scal : - forall f (a x:R), derivable_pt f x -> derivable_pt (mult_real_fct a f) x. -unfold derivable_pt in |- *; intros f1 a x X. -elim X; intros. -apply existT with (a * x0). -apply derivable_pt_lim_scal; assumption. + forall f (a x:R), derivable_pt f x -> derivable_pt (mult_real_fct a f) x. +Proof. + unfold derivable_pt in |- *; intros f1 a x X. + elim X; intros. + apply existT with (a * x0). + apply derivable_pt_lim_scal; assumption. Qed. Lemma derivable_pt_id : forall x:R, derivable_pt id x. -unfold derivable_pt in |- *; intro. -exists 1. -apply derivable_pt_lim_id. +Proof. + unfold derivable_pt in |- *; intro. + exists 1. + apply derivable_pt_lim_id. Qed. Lemma derivable_pt_Rsqr : forall x:R, derivable_pt Rsqr x. -unfold derivable_pt in |- *; intro; apply existT with (2 * x). -apply derivable_pt_lim_Rsqr. +Proof. + unfold derivable_pt in |- *; intro; apply existT with (2 * x). + apply derivable_pt_lim_Rsqr. Qed. Lemma derivable_pt_comp : - forall f1 f2 (x:R), - derivable_pt f1 x -> derivable_pt f2 (f1 x) -> derivable_pt (f2 o f1) x. -unfold derivable_pt in |- *; intros f1 f2 x X X0. -elim X; intros. -elim X0; intros. -apply existT with (x1 * x0). -apply derivable_pt_lim_comp; assumption. + forall f1 f2 (x:R), + derivable_pt f1 x -> derivable_pt f2 (f1 x) -> derivable_pt (f2 o f1) x. +Proof. + unfold derivable_pt in |- *; intros f1 f2 x X X0. + elim X; intros. + elim X0; intros. + apply existT with (x1 * x0). + apply derivable_pt_lim_comp; assumption. Qed. Lemma derivable_plus : - forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 + f2). -unfold derivable in |- *; intros f1 f2 X X0 x. -apply (derivable_pt_plus _ _ x (X _) (X0 _)). + forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 + f2). +Proof. + unfold derivable in |- *; intros f1 f2 X X0 x. + apply (derivable_pt_plus _ _ x (X _) (X0 _)). Qed. Lemma derivable_opp : forall f, derivable f -> derivable (- f). -unfold derivable in |- *; intros f X x. -apply (derivable_pt_opp _ x (X _)). +Proof. + unfold derivable in |- *; intros f X x. + apply (derivable_pt_opp _ x (X _)). Qed. Lemma derivable_minus : - forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 - f2). -unfold derivable in |- *; intros f1 f2 X X0 x. -apply (derivable_pt_minus _ _ x (X _) (X0 _)). + forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 - f2). +Proof. + unfold derivable in |- *; intros f1 f2 X X0 x. + apply (derivable_pt_minus _ _ x (X _) (X0 _)). Qed. Lemma derivable_mult : - forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 * f2). -unfold derivable in |- *; intros f1 f2 X X0 x. -apply (derivable_pt_mult _ _ x (X _) (X0 _)). + forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 * f2). +Proof. + unfold derivable in |- *; intros f1 f2 X X0 x. + apply (derivable_pt_mult _ _ x (X _) (X0 _)). Qed. Lemma derivable_const : forall a:R, derivable (fct_cte a). -unfold derivable in |- *; intros. -apply derivable_pt_const. +Proof. + unfold derivable in |- *; intros. + apply derivable_pt_const. Qed. Lemma derivable_scal : - forall f (a:R), derivable f -> derivable (mult_real_fct a f). -unfold derivable in |- *; intros f a X x. -apply (derivable_pt_scal _ a x (X _)). + forall f (a:R), derivable f -> derivable (mult_real_fct a f). +Proof. + unfold derivable in |- *; intros f a X x. + apply (derivable_pt_scal _ a x (X _)). Qed. Lemma derivable_id : derivable id. -unfold derivable in |- *; intro; apply derivable_pt_id. +Proof. + unfold derivable in |- *; intro; apply derivable_pt_id. Qed. Lemma derivable_Rsqr : derivable Rsqr. -unfold derivable in |- *; intro; apply derivable_pt_Rsqr. +Proof. + unfold derivable in |- *; intro; apply derivable_pt_Rsqr. Qed. Lemma derivable_comp : - forall f1 f2, derivable f1 -> derivable f2 -> derivable (f2 o f1). -unfold derivable in |- *; intros f1 f2 X X0 x. -apply (derivable_pt_comp _ _ x (X _) (X0 _)). + forall f1 f2, derivable f1 -> derivable f2 -> derivable (f2 o f1). +Proof. + unfold derivable in |- *; intros f1 f2 X X0 x. + apply (derivable_pt_comp _ _ x (X _) (X0 _)). Qed. Lemma derive_pt_plus : - forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 x), - derive_pt (f1 + f2) x (derivable_pt_plus _ _ _ pr1 pr2) = - derive_pt f1 x pr1 + derive_pt f2 x pr2. -intros. -assert (H := derivable_derive f1 x pr1). -assert (H0 := derivable_derive f2 x pr2). -assert - (H1 := derivable_derive (f1 + f2)%F x (derivable_pt_plus _ _ _ pr1 pr2)). -elim H; clear H; intros l1 H. -elim H0; clear H0; intros l2 H0. -elim H1; clear H1; intros l H1. -rewrite H; rewrite H0; apply derive_pt_eq_0. -assert (H3 := projT2 pr1). -unfold derive_pt in H; rewrite H in H3. -assert (H4 := projT2 pr2). -unfold derive_pt in H0; rewrite H0 in H4. -apply derivable_pt_lim_plus; assumption. + forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 x), + derive_pt (f1 + f2) x (derivable_pt_plus _ _ _ pr1 pr2) = + derive_pt f1 x pr1 + derive_pt f2 x pr2. +Proof. + intros. + assert (H := derivable_derive f1 x pr1). + assert (H0 := derivable_derive f2 x pr2). + assert + (H1 := derivable_derive (f1 + f2)%F x (derivable_pt_plus _ _ _ pr1 pr2)). + elim H; clear H; intros l1 H. + elim H0; clear H0; intros l2 H0. + elim H1; clear H1; intros l H1. + rewrite H; rewrite H0; apply derive_pt_eq_0. + assert (H3 := projT2 pr1). + unfold derive_pt in H; rewrite H in H3. + assert (H4 := projT2 pr2). + unfold derive_pt in H0; rewrite H0 in H4. + apply derivable_pt_lim_plus; assumption. Qed. Lemma derive_pt_opp : - forall f (x:R) (pr1:derivable_pt f x), - derive_pt (- f) x (derivable_pt_opp _ _ pr1) = - derive_pt f x pr1. -intros. -assert (H := derivable_derive f x pr1). -assert (H0 := derivable_derive (- f)%F x (derivable_pt_opp _ _ pr1)). -elim H; clear H; intros l1 H. -elim H0; clear H0; intros l2 H0. -rewrite H; apply derive_pt_eq_0. -assert (H3 := projT2 pr1). -unfold derive_pt in H; rewrite H in H3. -apply derivable_pt_lim_opp; assumption. + forall f (x:R) (pr1:derivable_pt f x), + derive_pt (- f) x (derivable_pt_opp _ _ pr1) = - derive_pt f x pr1. +Proof. + intros. + assert (H := derivable_derive f x pr1). + assert (H0 := derivable_derive (- f)%F x (derivable_pt_opp _ _ pr1)). + elim H; clear H; intros l1 H. + elim H0; clear H0; intros l2 H0. + rewrite H; apply derive_pt_eq_0. + assert (H3 := projT2 pr1). + unfold derive_pt in H; rewrite H in H3. + apply derivable_pt_lim_opp; assumption. Qed. Lemma derive_pt_minus : - forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 x), - derive_pt (f1 - f2) x (derivable_pt_minus _ _ _ pr1 pr2) = - derive_pt f1 x pr1 - derive_pt f2 x pr2. -intros. -assert (H := derivable_derive f1 x pr1). -assert (H0 := derivable_derive f2 x pr2). -assert - (H1 := derivable_derive (f1 - f2)%F x (derivable_pt_minus _ _ _ pr1 pr2)). -elim H; clear H; intros l1 H. -elim H0; clear H0; intros l2 H0. -elim H1; clear H1; intros l H1. -rewrite H; rewrite H0; apply derive_pt_eq_0. -assert (H3 := projT2 pr1). -unfold derive_pt in H; rewrite H in H3. -assert (H4 := projT2 pr2). -unfold derive_pt in H0; rewrite H0 in H4. -apply derivable_pt_lim_minus; assumption. + forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 x), + derive_pt (f1 - f2) x (derivable_pt_minus _ _ _ pr1 pr2) = + derive_pt f1 x pr1 - derive_pt f2 x pr2. +Proof. + intros. + assert (H := derivable_derive f1 x pr1). + assert (H0 := derivable_derive f2 x pr2). + assert + (H1 := derivable_derive (f1 - f2)%F x (derivable_pt_minus _ _ _ pr1 pr2)). + elim H; clear H; intros l1 H. + elim H0; clear H0; intros l2 H0. + elim H1; clear H1; intros l H1. + rewrite H; rewrite H0; apply derive_pt_eq_0. + assert (H3 := projT2 pr1). + unfold derive_pt in H; rewrite H in H3. + assert (H4 := projT2 pr2). + unfold derive_pt in H0; rewrite H0 in H4. + apply derivable_pt_lim_minus; assumption. Qed. Lemma derive_pt_mult : - forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 x), - derive_pt (f1 * f2) x (derivable_pt_mult _ _ _ pr1 pr2) = - derive_pt f1 x pr1 * f2 x + f1 x * derive_pt f2 x pr2. -intros. -assert (H := derivable_derive f1 x pr1). -assert (H0 := derivable_derive f2 x pr2). -assert - (H1 := derivable_derive (f1 * f2)%F x (derivable_pt_mult _ _ _ pr1 pr2)). -elim H; clear H; intros l1 H. -elim H0; clear H0; intros l2 H0. -elim H1; clear H1; intros l H1. -rewrite H; rewrite H0; apply derive_pt_eq_0. -assert (H3 := projT2 pr1). -unfold derive_pt in H; rewrite H in H3. -assert (H4 := projT2 pr2). -unfold derive_pt in H0; rewrite H0 in H4. -apply derivable_pt_lim_mult; assumption. + forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 x), + derive_pt (f1 * f2) x (derivable_pt_mult _ _ _ pr1 pr2) = + derive_pt f1 x pr1 * f2 x + f1 x * derive_pt f2 x pr2. +Proof. + intros. + assert (H := derivable_derive f1 x pr1). + assert (H0 := derivable_derive f2 x pr2). + assert + (H1 := derivable_derive (f1 * f2)%F x (derivable_pt_mult _ _ _ pr1 pr2)). + elim H; clear H; intros l1 H. + elim H0; clear H0; intros l2 H0. + elim H1; clear H1; intros l H1. + rewrite H; rewrite H0; apply derive_pt_eq_0. + assert (H3 := projT2 pr1). + unfold derive_pt in H; rewrite H in H3. + assert (H4 := projT2 pr2). + unfold derive_pt in H0; rewrite H0 in H4. + apply derivable_pt_lim_mult; assumption. Qed. Lemma derive_pt_const : - forall a x:R, derive_pt (fct_cte a) x (derivable_pt_const a x) = 0. -intros. -apply derive_pt_eq_0. -apply derivable_pt_lim_const. + forall a x:R, derive_pt (fct_cte a) x (derivable_pt_const a x) = 0. +Proof. + intros. + apply derive_pt_eq_0. + apply derivable_pt_lim_const. Qed. Lemma derive_pt_scal : - forall f (a x:R) (pr:derivable_pt f x), - derive_pt (mult_real_fct a f) x (derivable_pt_scal _ _ _ pr) = - a * derive_pt f x pr. -intros. -assert (H := derivable_derive f x pr). -assert - (H0 := derivable_derive (mult_real_fct a f) x (derivable_pt_scal _ _ _ pr)). -elim H; clear H; intros l1 H. -elim H0; clear H0; intros l2 H0. -rewrite H; apply derive_pt_eq_0. -assert (H3 := projT2 pr). -unfold derive_pt in H; rewrite H in H3. -apply derivable_pt_lim_scal; assumption. + forall f (a x:R) (pr:derivable_pt f x), + derive_pt (mult_real_fct a f) x (derivable_pt_scal _ _ _ pr) = + a * derive_pt f x pr. +Proof. + intros. + assert (H := derivable_derive f x pr). + assert + (H0 := derivable_derive (mult_real_fct a f) x (derivable_pt_scal _ _ _ pr)). + elim H; clear H; intros l1 H. + elim H0; clear H0; intros l2 H0. + rewrite H; apply derive_pt_eq_0. + assert (H3 := projT2 pr). + unfold derive_pt in H; rewrite H in H3. + apply derivable_pt_lim_scal; assumption. Qed. Lemma derive_pt_id : forall x:R, derive_pt id x (derivable_pt_id _) = 1. -intros. -apply derive_pt_eq_0. -apply derivable_pt_lim_id. +Proof. + intros. + apply derive_pt_eq_0. + apply derivable_pt_lim_id. Qed. Lemma derive_pt_Rsqr : - forall x:R, derive_pt Rsqr x (derivable_pt_Rsqr _) = 2 * x. -intros. -apply derive_pt_eq_0. -apply derivable_pt_lim_Rsqr. + forall x:R, derive_pt Rsqr x (derivable_pt_Rsqr _) = 2 * x. +Proof. + intros. + apply derive_pt_eq_0. + apply derivable_pt_lim_Rsqr. Qed. Lemma derive_pt_comp : - forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 (f1 x)), - derive_pt (f2 o f1) x (derivable_pt_comp _ _ _ pr1 pr2) = - derive_pt f2 (f1 x) pr2 * derive_pt f1 x pr1. -intros. -assert (H := derivable_derive f1 x pr1). -assert (H0 := derivable_derive f2 (f1 x) pr2). -assert - (H1 := derivable_derive (f2 o f1)%F x (derivable_pt_comp _ _ _ pr1 pr2)). -elim H; clear H; intros l1 H. -elim H0; clear H0; intros l2 H0. -elim H1; clear H1; intros l H1. -rewrite H; rewrite H0; apply derive_pt_eq_0. -assert (H3 := projT2 pr1). -unfold derive_pt in H; rewrite H in H3. -assert (H4 := projT2 pr2). -unfold derive_pt in H0; rewrite H0 in H4. -apply derivable_pt_lim_comp; assumption. + forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 (f1 x)), + derive_pt (f2 o f1) x (derivable_pt_comp _ _ _ pr1 pr2) = + derive_pt f2 (f1 x) pr2 * derive_pt f1 x pr1. +Proof. + intros. + assert (H := derivable_derive f1 x pr1). + assert (H0 := derivable_derive f2 (f1 x) pr2). + assert + (H1 := derivable_derive (f2 o f1)%F x (derivable_pt_comp _ _ _ pr1 pr2)). + elim H; clear H; intros l1 H. + elim H0; clear H0; intros l2 H0. + elim H1; clear H1; intros l H1. + rewrite H; rewrite H0; apply derive_pt_eq_0. + assert (H3 := projT2 pr1). + unfold derive_pt in H; rewrite H in H3. + assert (H4 := projT2 pr2). + unfold derive_pt in H0; rewrite H0 in H4. + apply derivable_pt_lim_comp; assumption. Qed. (* Pow *) Definition pow_fct (n:nat) (y:R) : R := y ^ n. Lemma derivable_pt_lim_pow_pos : - forall (x:R) (n:nat), - (0 < n)%nat -> derivable_pt_lim (fun y:R => y ^ n) x (INR n * x ^ pred n). -intros. -induction n as [| n Hrecn]. -elim (lt_irrefl _ H). -cut (n = 0%nat \/ (0 < n)%nat). -intro; elim H0; intro. -rewrite H1; simpl in |- *. -replace (fun y:R => y * 1) with (id * fct_cte 1)%F. -replace (1 * 1) with (1 * fct_cte 1 x + id x * 0). -apply derivable_pt_lim_mult. -apply derivable_pt_lim_id. -apply derivable_pt_lim_const. -unfold fct_cte, id in |- *; ring. -reflexivity. -replace (fun y:R => y ^ S n) with (fun y:R => y * y ^ n). -replace (pred (S n)) with n; [ idtac | reflexivity ]. -replace (fun y:R => y * y ^ n) with (id * (fun y:R => y ^ n))%F. -set (f := fun y:R => y ^ n). -replace (INR (S n) * x ^ n) with (1 * f x + id x * (INR n * x ^ pred n)). -apply derivable_pt_lim_mult. -apply derivable_pt_lim_id. -unfold f in |- *; apply Hrecn; assumption. -unfold f in |- *. -pattern n at 1 5 in |- *; replace n with (S (pred n)). -unfold id in |- *; rewrite S_INR; simpl in |- *. -ring. -symmetry in |- *; apply S_pred with 0%nat; assumption. -unfold mult_fct, id in |- *; reflexivity. -reflexivity. -inversion H. -left; reflexivity. -right. -apply lt_le_trans with 1%nat. -apply lt_O_Sn. -assumption. + forall (x:R) (n:nat), + (0 < n)%nat -> derivable_pt_lim (fun y:R => y ^ n) x (INR n * x ^ pred n). +Proof. + intros. + induction n as [| n Hrecn]. + elim (lt_irrefl _ H). + cut (n = 0%nat \/ (0 < n)%nat). + intro; elim H0; intro. + rewrite H1; simpl in |- *. + replace (fun y:R => y * 1) with (id * fct_cte 1)%F. + replace (1 * 1) with (1 * fct_cte 1 x + id x * 0). + apply derivable_pt_lim_mult. + apply derivable_pt_lim_id. + apply derivable_pt_lim_const. + unfold fct_cte, id in |- *; ring. + reflexivity. + replace (fun y:R => y ^ S n) with (fun y:R => y * y ^ n). + replace (pred (S n)) with n; [ idtac | reflexivity ]. + replace (fun y:R => y * y ^ n) with (id * (fun y:R => y ^ n))%F. + set (f := fun y:R => y ^ n). + replace (INR (S n) * x ^ n) with (1 * f x + id x * (INR n * x ^ pred n)). + apply derivable_pt_lim_mult. + apply derivable_pt_lim_id. + unfold f in |- *; apply Hrecn; assumption. + unfold f in |- *. + pattern n at 1 5 in |- *; replace n with (S (pred n)). + unfold id in |- *; rewrite S_INR; simpl in |- *. + ring. + symmetry in |- *; apply S_pred with 0%nat; assumption. + unfold mult_fct, id in |- *; reflexivity. + reflexivity. + inversion H. + left; reflexivity. + right. + apply lt_le_trans with 1%nat. + apply lt_O_Sn. + assumption. Qed. Lemma derivable_pt_lim_pow : - forall (x:R) (n:nat), - derivable_pt_lim (fun y:R => y ^ n) x (INR n * x ^ pred n). -intros. -induction n as [| n Hrecn]. -simpl in |- *. -rewrite Rmult_0_l. -replace (fun _:R => 1) with (fct_cte 1); - [ apply derivable_pt_lim_const | reflexivity ]. -apply derivable_pt_lim_pow_pos. -apply lt_O_Sn. + forall (x:R) (n:nat), + derivable_pt_lim (fun y:R => y ^ n) x (INR n * x ^ pred n). +Proof. + intros. + induction n as [| n Hrecn]. + simpl in |- *. + rewrite Rmult_0_l. + replace (fun _:R => 1) with (fct_cte 1); + [ apply derivable_pt_lim_const | reflexivity ]. + apply derivable_pt_lim_pow_pos. + apply lt_O_Sn. Qed. Lemma derivable_pt_pow : - forall (n:nat) (x:R), derivable_pt (fun y:R => y ^ n) x. -intros; unfold derivable_pt in |- *. -apply existT with (INR n * x ^ pred n). -apply derivable_pt_lim_pow. + forall (n:nat) (x:R), derivable_pt (fun y:R => y ^ n) x. +Proof. + intros; unfold derivable_pt in |- *. + apply existT with (INR n * x ^ pred n). + apply derivable_pt_lim_pow. Qed. Lemma derivable_pow : forall n:nat, derivable (fun y:R => y ^ n). -intro; unfold derivable in |- *; intro; apply derivable_pt_pow. +Proof. + intro; unfold derivable in |- *; intro; apply derivable_pt_pow. Qed. Lemma derive_pt_pow : - forall (n:nat) (x:R), - derive_pt (fun y:R => y ^ n) x (derivable_pt_pow n x) = INR n * x ^ pred n. -intros; apply derive_pt_eq_0. -apply derivable_pt_lim_pow. + forall (n:nat) (x:R), + derive_pt (fun y:R => y ^ n) x (derivable_pt_pow n x) = INR n * x ^ pred n. +Proof. + intros; apply derive_pt_eq_0. + apply derivable_pt_lim_pow. Qed. Lemma pr_nu : - forall f (x:R) (pr1 pr2:derivable_pt f x), - derive_pt f x pr1 = derive_pt f x pr2. -intros. -unfold derivable_pt in pr1. -unfold derivable_pt in pr2. -elim pr1; intros. -elim pr2; intros. -unfold derivable_pt_abs in p. -unfold derivable_pt_abs in p0. -simpl in |- *. -apply (uniqueness_limite f x x0 x1 p p0). + forall f (x:R) (pr1 pr2:derivable_pt f x), + derive_pt f x pr1 = derive_pt f x pr2. +Proof. + intros. + unfold derivable_pt in pr1. + unfold derivable_pt in pr2. + elim pr1; intros. + elim pr2; intros. + unfold derivable_pt_abs in p. + unfold derivable_pt_abs in p0. + simpl in |- *. + apply (uniqueness_limite f x x0 x1 p p0). Qed. (************************************************************) -(** Local extremum's condition *) +(** * Local extremum's condition *) (************************************************************) Theorem deriv_maximum : - forall f (a b c:R) (pr:derivable_pt f c), - a < c -> - c < b -> - (forall x:R, a < x -> x < b -> f x <= f c) -> derive_pt f c pr = 0. -intros; case (Rtotal_order 0 (derive_pt f c pr)); intro. -assert (H3 := derivable_derive f c pr). -elim H3; intros l H4; rewrite H4 in H2. -assert (H5 := derive_pt_eq_1 f c l pr H4). -cut (0 < l / 2); - [ intro - | unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. -elim (H5 (l / 2) H6); intros delta H7. -cut (0 < (b - c) / 2). -intro; cut (Rmin (delta / 2) ((b - c) / 2) <> 0). -intro; cut (Rabs (Rmin (delta / 2) ((b - c) / 2)) < delta). -intro. -assert (H11 := H7 (Rmin (delta / 2) ((b - c) / 2)) H9 H10). -cut (0 < Rmin (delta / 2) ((b - c) / 2)). -intro; cut (a < c + Rmin (delta / 2) ((b - c) / 2)). -intro; cut (c + Rmin (delta / 2) ((b - c) / 2) < b). -intro; assert (H15 := H1 (c + Rmin (delta / 2) ((b - c) / 2)) H13 H14). -cut - ((f (c + Rmin (delta / 2) ((b - c) / 2)) - f c) / - Rmin (delta / 2) ((b - c) / 2) <= 0). -intro; cut (- l < 0). -intro; unfold Rminus in H11. -cut - ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / - Rmin (delta / 2) ((b + - c) / 2) + - l < 0). -intro; - cut - (Rabs - ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / - Rmin (delta / 2) ((b + - c) / 2) + - l) < l / 2). -unfold Rabs in |- *; - case - (Rcase_abs - ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / - Rmin (delta / 2) ((b + - c) / 2) + - l)); intro. -replace - (- - ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / - Rmin (delta / 2) ((b + - c) / 2) + - l)) with - (l + - - - ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / - Rmin (delta / 2) ((b + - c) / 2))). -intro; - generalize - (Rplus_lt_compat_l (- l) - (l + - - + forall f (a b c:R) (pr:derivable_pt f c), + a < c -> + c < b -> + (forall x:R, a < x -> x < b -> f x <= f c) -> derive_pt f c pr = 0. +Proof. + intros; case (Rtotal_order 0 (derive_pt f c pr)); intro. + assert (H3 := derivable_derive f c pr). + elim H3; intros l H4; rewrite H4 in H2. + assert (H5 := derive_pt_eq_1 f c l pr H4). + cut (0 < l / 2); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. + elim (H5 (l / 2) H6); intros delta H7. + cut (0 < (b - c) / 2). + intro; cut (Rmin (delta / 2) ((b - c) / 2) <> 0). + intro; cut (Rabs (Rmin (delta / 2) ((b - c) / 2)) < delta). + intro. + assert (H11 := H7 (Rmin (delta / 2) ((b - c) / 2)) H9 H10). + cut (0 < Rmin (delta / 2) ((b - c) / 2)). + intro; cut (a < c + Rmin (delta / 2) ((b - c) / 2)). + intro; cut (c + Rmin (delta / 2) ((b - c) / 2) < b). + intro; assert (H15 := H1 (c + Rmin (delta / 2) ((b - c) / 2)) H13 H14). + cut + ((f (c + Rmin (delta / 2) ((b - c) / 2)) - f c) / + Rmin (delta / 2) ((b - c) / 2) <= 0). + intro; cut (- l < 0). + intro; unfold Rminus in H11. + cut + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2) + - l < 0). + intro; + cut + (Rabs + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2) + - l) < l / 2). + unfold Rabs in |- *; + case + (Rcase_abs ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / - Rmin (delta / 2) ((b + - c) / 2))) (l / 2) H19); - repeat rewrite <- Rplus_assoc; rewrite Rplus_opp_l; - rewrite Rplus_0_l; replace (- l + l / 2) with (- (l / 2)). -intro; - generalize - (Ropp_lt_gt_contravar - (- + Rmin (delta / 2) ((b + - c) / 2) + - l)); intro. + replace + (- + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2) + - l)) with + (l + + - + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2))). + intro; + generalize + (Rplus_lt_compat_l (- l) + (l + + - + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2))) (l / 2) H19); + repeat rewrite <- Rplus_assoc; rewrite Rplus_opp_l; + rewrite Rplus_0_l; replace (- l + l / 2) with (- (l / 2)). + intro; + generalize + (Ropp_lt_gt_contravar + (- + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2))) (- (l / 2)) H20); + repeat rewrite Ropp_involutive; intro; + generalize + (Rlt_trans 0 (l / 2) + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2)) H6 H21); intro; + elim + (Rlt_irrefl 0 + (Rlt_le_trans 0 + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / + Rmin (delta / 2) ((b + - c) / 2)) 0 H22 H16)). + pattern l at 2 in |- *; rewrite double_var. + ring. + ring. + intro. + assert + (H20 := + Rge_le ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / - Rmin (delta / 2) ((b + - c) / 2))) (- (l / 2)) H20); - repeat rewrite Ropp_involutive; intro; - generalize - (Rlt_trans 0 (l / 2) - ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / - Rmin (delta / 2) ((b + - c) / 2)) H6 H21); intro; - elim - (Rlt_irrefl 0 - (Rlt_le_trans 0 - ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / - Rmin (delta / 2) ((b + - c) / 2)) 0 H22 H16)). -pattern l at 2 in |- *; rewrite double_var. -ring. -ring. -intro. -assert - (H20 := - Rge_le + Rmin (delta / 2) ((b + - c) / 2) + - l) 0 r). + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H20 H18)). + assumption. + rewrite <- Ropp_0; + replace ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / - Rmin (delta / 2) ((b + - c) / 2) + - l) 0 r). -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H20 H18)). -assumption. -rewrite <- Ropp_0; - replace - ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / - Rmin (delta / 2) ((b + - c) / 2) + - l) with + Rmin (delta / 2) ((b + - c) / 2) + - l) with + (- + (l + + - + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) - f c) / + Rmin (delta / 2) ((b + - c) / 2)))). + apply Ropp_gt_lt_contravar; + change + (0 < + l + + - + ((f (c + Rmin (delta / 2) ((b + - c) / 2)) - f c) / + Rmin (delta / 2) ((b + - c) / 2))) in |- *; apply Rplus_lt_le_0_compat; + [ assumption + | rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; assumption ]. + unfold Rminus; ring. + rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption. + replace + ((f (c + Rmin (delta / 2) ((b - c) / 2)) - f c) / + Rmin (delta / 2) ((b - c) / 2)) with (- - (l + - - - ((f (c + Rmin (delta / 2) ((b + - c) / 2)) - f c) / - Rmin (delta / 2) ((b + - c) / 2)))). -apply Ropp_gt_lt_contravar; - change - (0 < - l + - - - ((f (c + Rmin (delta / 2) ((b + - c) / 2)) - f c) / - Rmin (delta / 2) ((b + - c) / 2))) in |- *; apply Rplus_lt_le_0_compat; - [ assumption - | rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; assumption ]. -ring. -rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption. -replace - ((f (c + Rmin (delta / 2) ((b - c) / 2)) - f c) / - Rmin (delta / 2) ((b - c) / 2)) with - (- - ((f c - f (c + Rmin (delta / 2) ((b - c) / 2))) / - Rmin (delta / 2) ((b - c) / 2))). -rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; - unfold Rdiv in |- *; apply Rmult_le_pos; - [ generalize - (Rplus_le_compat_r (- f (c + Rmin (delta * / 2) ((b - c) * / 2))) - (f (c + Rmin (delta * / 2) ((b - c) * / 2))) ( - f c) H15); rewrite Rplus_opp_r; intro; assumption - | left; apply Rinv_0_lt_compat; assumption ]. -unfold Rdiv in |- *. -rewrite <- Ropp_mult_distr_l_reverse. -repeat rewrite <- (Rmult_comm (/ Rmin (delta * / 2) ((b - c) * / 2))). -apply Rmult_eq_reg_l with (Rmin (delta * / 2) ((b - c) * / 2)). -repeat rewrite <- Rmult_assoc. -rewrite <- Rinv_r_sym. -repeat rewrite Rmult_1_l. -ring. -red in |- *; intro. -unfold Rdiv in H12; rewrite H16 in H12; elim (Rlt_irrefl 0 H12). -red in |- *; intro. -unfold Rdiv in H12; rewrite H16 in H12; elim (Rlt_irrefl 0 H12). -assert (H14 := Rmin_r (delta / 2) ((b - c) / 2)). -assert - (H15 := - Rplus_le_compat_l c (Rmin (delta / 2) ((b - c) / 2)) ((b - c) / 2) H14). -apply Rle_lt_trans with (c + (b - c) / 2). -assumption. -apply Rmult_lt_reg_l with 2. -prove_sup0. -replace (2 * (c + (b - c) / 2)) with (c + b). -replace (2 * b) with (b + b). -apply Rplus_lt_compat_r; assumption. -ring. -unfold Rdiv in |- *; rewrite Rmult_plus_distr_l. -repeat rewrite (Rmult_comm 2). -rewrite Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_r. -ring. -discrR. -apply Rlt_trans with c. -assumption. -pattern c at 1 in |- *; rewrite <- (Rplus_0_r c); apply Rplus_lt_compat_l; - assumption. -cut (0 < delta / 2). -intro; - apply - (Rmin_stable_in_posreal (mkposreal (delta / 2) H12) - (mkposreal ((b - c) / 2) H8)). -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. -unfold Rabs in |- *; case (Rcase_abs (Rmin (delta / 2) ((b - c) / 2))). -intro. -cut (0 < delta / 2). -intro. -generalize - (Rmin_stable_in_posreal (mkposreal (delta / 2) H10) - (mkposreal ((b - c) / 2) H8)); simpl in |- *; intro; - elim (Rlt_irrefl 0 (Rlt_trans 0 (Rmin (delta / 2) ((b - c) / 2)) 0 H11 r)). -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. -intro; apply Rle_lt_trans with (delta / 2). -apply Rmin_l. -unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2. -prove_sup0. -rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. -rewrite Rmult_1_l. -replace (2 * delta) with (delta + delta). -pattern delta at 2 in |- *; rewrite <- (Rplus_0_r delta); - apply Rplus_lt_compat_l. -rewrite Rplus_0_r; apply (cond_pos delta). -symmetry in |- *; apply double. -discrR. -cut (0 < delta / 2). -intro; - generalize - (Rmin_stable_in_posreal (mkposreal (delta / 2) H9) - (mkposreal ((b - c) / 2) H8)); simpl in |- *; - intro; red in |- *; intro; rewrite H11 in H10; elim (Rlt_irrefl 0 H10). -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. -unfold Rdiv in |- *; apply Rmult_lt_0_compat. -generalize (Rplus_lt_compat_r (- c) c b H0); rewrite Rplus_opp_r; intro; - assumption. -apply Rinv_0_lt_compat; prove_sup0. -elim H2; intro. -symmetry in |- *; assumption. -generalize (derivable_derive f c pr); intro; elim H4; intros l H5. -rewrite H5 in H3; generalize (derive_pt_eq_1 f c l pr H5); intro; - cut (0 < - (l / 2)). -intro; elim (H6 (- (l / 2)) H7); intros delta H9. -cut (0 < (c - a) / 2). -intro; cut (Rmax (- (delta / 2)) ((a - c) / 2) < 0). -intro; cut (Rmax (- (delta / 2)) ((a - c) / 2) <> 0). -intro; cut (Rabs (Rmax (- (delta / 2)) ((a - c) / 2)) < delta). -intro; generalize (H9 (Rmax (- (delta / 2)) ((a - c) / 2)) H11 H12); intro; - cut (a < c + Rmax (- (delta / 2)) ((a - c) / 2)). -cut (c + Rmax (- (delta / 2)) ((a - c) / 2) < b). -intros; generalize (H1 (c + Rmax (- (delta / 2)) ((a - c) / 2)) H15 H14); - intro; - cut - (0 <= - (f (c + Rmax (- (delta / 2)) ((a - c) / 2)) - f c) / - Rmax (- (delta / 2)) ((a - c) / 2)). -intro; cut (0 < - l). -intro; unfold Rminus in H13; - cut - (0 < - (f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / - Rmax (- (delta / 2)) ((a + - c) / 2) + - l). -intro; - cut - (Rabs - ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / - Rmax (- (delta / 2)) ((a + - c) / 2) + - l) < - - (l / 2)). -unfold Rabs in |- *; - case - (Rcase_abs - ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / - Rmax (- (delta / 2)) ((a + - c) / 2) + - l)). -intro; - elim - (Rlt_irrefl 0 - (Rlt_trans 0 + ((f c - f (c + Rmin (delta / 2) ((b - c) / 2))) / + Rmin (delta / 2) ((b - c) / 2))). + rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; + unfold Rdiv in |- *; apply Rmult_le_pos; + [ generalize + (Rplus_le_compat_r (- f (c + Rmin (delta * / 2) ((b - c) * / 2))) + (f (c + Rmin (delta * / 2) ((b - c) * / 2))) ( + f c) H15); rewrite Rplus_opp_r; intro; assumption + | left; apply Rinv_0_lt_compat; assumption ]. + unfold Rdiv in |- *. + rewrite <- Ropp_mult_distr_l_reverse. + repeat rewrite <- (Rmult_comm (/ Rmin (delta * / 2) ((b - c) * / 2))). + apply Rmult_eq_reg_l with (Rmin (delta * / 2) ((b - c) * / 2)). + repeat rewrite <- Rmult_assoc. + rewrite <- Rinv_r_sym. + repeat rewrite Rmult_1_l. + ring. + red in |- *; intro. + unfold Rdiv in H12; rewrite H16 in H12; elim (Rlt_irrefl 0 H12). + red in |- *; intro. + unfold Rdiv in H12; rewrite H16 in H12; elim (Rlt_irrefl 0 H12). + assert (H14 := Rmin_r (delta / 2) ((b - c) / 2)). + assert + (H15 := + Rplus_le_compat_l c (Rmin (delta / 2) ((b - c) / 2)) ((b - c) / 2) H14). + apply Rle_lt_trans with (c + (b - c) / 2). + assumption. + apply Rmult_lt_reg_l with 2. + prove_sup0. + replace (2 * (c + (b - c) / 2)) with (c + b). + replace (2 * b) with (b + b). + apply Rplus_lt_compat_r; assumption. + ring. + unfold Rdiv in |- *; rewrite Rmult_plus_distr_l. + repeat rewrite (Rmult_comm 2). + rewrite Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_r. + ring. + discrR. + apply Rlt_trans with c. + assumption. + pattern c at 1 in |- *; rewrite <- (Rplus_0_r c); apply Rplus_lt_compat_l; + assumption. + cut (0 < delta / 2). + intro; + apply + (Rmin_stable_in_posreal (mkposreal (delta / 2) H12) + (mkposreal ((b - c) / 2) H8)). + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. + unfold Rabs in |- *; case (Rcase_abs (Rmin (delta / 2) ((b - c) / 2))). + intro. + cut (0 < delta / 2). + intro. + generalize + (Rmin_stable_in_posreal (mkposreal (delta / 2) H10) + (mkposreal ((b - c) / 2) H8)); simpl in |- *; intro; + elim (Rlt_irrefl 0 (Rlt_trans 0 (Rmin (delta / 2) ((b - c) / 2)) 0 H11 r)). + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. + intro; apply Rle_lt_trans with (delta / 2). + apply Rmin_l. + unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2. + prove_sup0. + rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. + rewrite Rmult_1_l. + replace (2 * delta) with (delta + delta). + pattern delta at 2 in |- *; rewrite <- (Rplus_0_r delta); + apply Rplus_lt_compat_l. + rewrite Rplus_0_r; apply (cond_pos delta). + symmetry in |- *; apply double. + discrR. + cut (0 < delta / 2). + intro; + generalize + (Rmin_stable_in_posreal (mkposreal (delta / 2) H9) + (mkposreal ((b - c) / 2) H8)); simpl in |- *; + intro; red in |- *; intro; rewrite H11 in H10; elim (Rlt_irrefl 0 H10). + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. + unfold Rdiv in |- *; apply Rmult_lt_0_compat. + generalize (Rplus_lt_compat_r (- c) c b H0); rewrite Rplus_opp_r; intro; + assumption. + apply Rinv_0_lt_compat; prove_sup0. + elim H2; intro. + symmetry in |- *; assumption. + generalize (derivable_derive f c pr); intro; elim H4; intros l H5. + rewrite H5 in H3; generalize (derive_pt_eq_1 f c l pr H5); intro; + cut (0 < - (l / 2)). + intro; elim (H6 (- (l / 2)) H7); intros delta H9. + cut (0 < (c - a) / 2). + intro; cut (Rmax (- (delta / 2)) ((a - c) / 2) < 0). + intro; cut (Rmax (- (delta / 2)) ((a - c) / 2) <> 0). + intro; cut (Rabs (Rmax (- (delta / 2)) ((a - c) / 2)) < delta). + intro; generalize (H9 (Rmax (- (delta / 2)) ((a - c) / 2)) H11 H12); intro; + cut (a < c + Rmax (- (delta / 2)) ((a - c) / 2)). + cut (c + Rmax (- (delta / 2)) ((a - c) / 2) < b). + intros; generalize (H1 (c + Rmax (- (delta / 2)) ((a - c) / 2)) H15 H14); + intro; + cut + (0 <= + (f (c + Rmax (- (delta / 2)) ((a - c) / 2)) - f c) / + Rmax (- (delta / 2)) ((a - c) / 2)). + intro; cut (0 < - l). + intro; unfold Rminus in H13; + cut + (0 < + (f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / + Rmax (- (delta / 2)) ((a + - c) / 2) + - l). + intro; + cut + (Rabs + ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / + Rmax (- (delta / 2)) ((a + - c) / 2) + - l) < + - (l / 2)). + unfold Rabs in |- *; + case + (Rcase_abs + ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / + Rmax (- (delta / 2)) ((a + - c) / 2) + - l)). + intro; + elim + (Rlt_irrefl 0 + (Rlt_trans 0 + ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / + Rmax (- (delta / 2)) ((a + - c) / 2) + - l) 0 H19 r)). + intros; + generalize + (Rplus_lt_compat_r l + ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / + Rmax (- (delta / 2)) ((a + - c) / 2) + - l) ( + - (l / 2)) H20); repeat rewrite Rplus_assoc; rewrite Rplus_opp_l; + rewrite Rplus_0_r; replace (- (l / 2) + l) with (l / 2). + cut (l / 2 < 0). + intros; + generalize + (Rlt_trans ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / - Rmax (- (delta / 2)) ((a + - c) / 2) + - l) 0 H19 r)). -intros; - generalize - (Rplus_lt_compat_r l - ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / - Rmax (- (delta / 2)) ((a + - c) / 2) + - l) ( - - (l / 2)) H20); repeat rewrite Rplus_assoc; rewrite Rplus_opp_l; - rewrite Rplus_0_r; replace (- (l / 2) + l) with (l / 2). -cut (l / 2 < 0). -intros; - generalize - (Rlt_trans - ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / - Rmax (- (delta / 2)) ((a + - c) / 2)) (l / 2) 0 H22 H21); - intro; - elim - (Rlt_irrefl 0 - (Rle_lt_trans 0 - ((f (c + Rmax (- (delta / 2)) ((a - c) / 2)) - f c) / - Rmax (- (delta / 2)) ((a - c) / 2)) 0 H17 H23)). -rewrite <- (Ropp_involutive (l / 2)); rewrite <- Ropp_0; - apply Ropp_lt_gt_contravar; assumption. -pattern l at 3 in |- *; rewrite double_var. -ring. -assumption. -apply Rplus_le_lt_0_compat; assumption. -rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption. -unfold Rdiv in |- *; - replace - ((f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)) - f c) * - / Rmax (- (delta * / 2)) ((a - c) * / 2)) with - (- (f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)) - f c) * - / - Rmax (- (delta * / 2)) ((a - c) * / 2)). -apply Rmult_le_pos. -generalize - (Rplus_le_compat_l (- f (c + Rmax (- (delta * / 2)) ((a - c) * / 2))) - (f (c + Rmax (- (delta * / 2)) ((a - c) * / 2))) ( - f c) H16); rewrite Rplus_opp_l; - replace (- (f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)) - f c)) with - (- f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)) + f c). -intro; assumption. -ring. -left; apply Rinv_0_lt_compat; rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; - assumption. -unfold Rdiv in |- *. -rewrite <- Ropp_inv_permute. -rewrite Rmult_opp_opp. -reflexivity. -unfold Rdiv in H11; assumption. -generalize (Rplus_lt_compat_l c (Rmax (- (delta / 2)) ((a - c) / 2)) 0 H10); - rewrite Rplus_0_r; intro; apply Rlt_trans with c; - assumption. -generalize (RmaxLess2 (- (delta / 2)) ((a - c) / 2)); intro; - generalize - (Rplus_le_compat_l c ((a - c) / 2) (Rmax (- (delta / 2)) ((a - c) / 2)) H14); - intro; apply Rlt_le_trans with (c + (a - c) / 2). -apply Rmult_lt_reg_l with 2. -prove_sup0. -replace (2 * (c + (a - c) / 2)) with (a + c). -rewrite double. -apply Rplus_lt_compat_l; assumption. -ring. -rewrite <- Rplus_assoc. -rewrite <- double_var. -ring. -assumption. -unfold Rabs in |- *; case (Rcase_abs (Rmax (- (delta / 2)) ((a - c) / 2))). -intro; generalize (RmaxLess1 (- (delta / 2)) ((a - c) / 2)); intro; - generalize - (Ropp_le_ge_contravar (- (delta / 2)) (Rmax (- (delta / 2)) ((a - c) / 2)) - H12); rewrite Ropp_involutive; intro; - generalize (Rge_le (delta / 2) (- Rmax (- (delta / 2)) ((a - c) / 2)) H13); - intro; apply Rle_lt_trans with (delta / 2). -assumption. -apply Rmult_lt_reg_l with 2. -prove_sup0. -unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym. -rewrite Rmult_1_l; rewrite double. -pattern delta at 2 in |- *; rewrite <- (Rplus_0_r delta); - apply Rplus_lt_compat_l; rewrite Rplus_0_r; apply (cond_pos delta). -discrR. -cut (- (delta / 2) < 0). -cut ((a - c) / 2 < 0). -intros; - generalize - (Rmax_stable_in_negreal (mknegreal (- (delta / 2)) H13) - (mknegreal ((a - c) / 2) H12)); simpl in |- *; - intro; generalize (Rge_le (Rmax (- (delta / 2)) ((a - c) / 2)) 0 r); - intro; - elim - (Rlt_irrefl 0 - (Rle_lt_trans 0 (Rmax (- (delta / 2)) ((a - c) / 2)) 0 H15 H14)). -rewrite <- Ropp_0; rewrite <- (Ropp_involutive ((a - c) / 2)); - apply Ropp_lt_gt_contravar; replace (- ((a - c) / 2)) with ((c - a) / 2). -assumption. -unfold Rdiv in |- *. -rewrite <- Ropp_mult_distr_l_reverse. -rewrite (Ropp_minus_distr a c). -reflexivity. -rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; unfold Rdiv in |- *; - apply Rmult_lt_0_compat; - [ apply (cond_pos delta) - | assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ] ]. -red in |- *; intro; rewrite H11 in H10; elim (Rlt_irrefl 0 H10). -cut ((a - c) / 2 < 0). -intro; cut (- (delta / 2) < 0). -intro; - apply - (Rmax_stable_in_negreal (mknegreal (- (delta / 2)) H11) - (mknegreal ((a - c) / 2) H10)). -rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; unfold Rdiv in |- *; - apply Rmult_lt_0_compat; - [ apply (cond_pos delta) - | assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ] ]. -rewrite <- Ropp_0; rewrite <- (Ropp_involutive ((a - c) / 2)); - apply Ropp_lt_gt_contravar; replace (- ((a - c) / 2)) with ((c - a) / 2). -assumption. -unfold Rdiv in |- *. -rewrite <- Ropp_mult_distr_l_reverse. -rewrite (Ropp_minus_distr a c). -reflexivity. -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ generalize (Rplus_lt_compat_r (- a) a c H); rewrite Rplus_opp_r; intro; - assumption - | assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ] ]. -replace (- (l / 2)) with (- l / 2). -unfold Rdiv in |- *; apply Rmult_lt_0_compat. -rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption. -assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ]. -unfold Rdiv in |- *; apply Ropp_mult_distr_l_reverse. + Rmax (- (delta / 2)) ((a + - c) / 2)) (l / 2) 0 H22 H21); + intro; + elim + (Rlt_irrefl 0 + (Rle_lt_trans 0 + ((f (c + Rmax (- (delta / 2)) ((a - c) / 2)) - f c) / + Rmax (- (delta / 2)) ((a - c) / 2)) 0 H17 H23)). + rewrite <- (Ropp_involutive (l / 2)); rewrite <- Ropp_0; + apply Ropp_lt_gt_contravar; assumption. + pattern l at 3 in |- *; rewrite double_var. + ring. + assumption. + apply Rplus_le_lt_0_compat; assumption. + rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption. + unfold Rdiv in |- *; + replace + ((f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)) - f c) * + / Rmax (- (delta * / 2)) ((a - c) * / 2)) with + (- (f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)) - f c) * + / - Rmax (- (delta * / 2)) ((a - c) * / 2)). + apply Rmult_le_pos. + generalize + (Rplus_le_compat_l (- f (c + Rmax (- (delta * / 2)) ((a - c) * / 2))) + (f (c + Rmax (- (delta * / 2)) ((a - c) * / 2))) ( + f c) H16); rewrite Rplus_opp_l; + replace (- (f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)) - f c)) with + (- f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)) + f c). + intro; assumption. + ring. + left; apply Rinv_0_lt_compat; rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; + assumption. + unfold Rdiv in |- *. + rewrite <- Ropp_inv_permute. + rewrite Rmult_opp_opp. + reflexivity. + unfold Rdiv in H11; assumption. + generalize (Rplus_lt_compat_l c (Rmax (- (delta / 2)) ((a - c) / 2)) 0 H10); + rewrite Rplus_0_r; intro; apply Rlt_trans with c; + assumption. + generalize (RmaxLess2 (- (delta / 2)) ((a - c) / 2)); intro; + generalize + (Rplus_le_compat_l c ((a - c) / 2) (Rmax (- (delta / 2)) ((a - c) / 2)) H14); + intro; apply Rlt_le_trans with (c + (a - c) / 2). + apply Rmult_lt_reg_l with 2. + prove_sup0. + replace (2 * (c + (a - c) / 2)) with (a + c). + rewrite double. + apply Rplus_lt_compat_l; assumption. + field; discrR. + assumption. + unfold Rabs in |- *; case (Rcase_abs (Rmax (- (delta / 2)) ((a - c) / 2))). + intro; generalize (RmaxLess1 (- (delta / 2)) ((a - c) / 2)); intro; + generalize + (Ropp_le_ge_contravar (- (delta / 2)) (Rmax (- (delta / 2)) ((a - c) / 2)) + H12); rewrite Ropp_involutive; intro; + generalize (Rge_le (delta / 2) (- Rmax (- (delta / 2)) ((a - c) / 2)) H13); + intro; apply Rle_lt_trans with (delta / 2). + assumption. + apply Rmult_lt_reg_l with 2. + prove_sup0. + unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. + rewrite Rmult_1_l; rewrite double. + pattern delta at 2 in |- *; rewrite <- (Rplus_0_r delta); + apply Rplus_lt_compat_l; rewrite Rplus_0_r; apply (cond_pos delta). + discrR. + cut (- (delta / 2) < 0). + cut ((a - c) / 2 < 0). + intros; + generalize + (Rmax_stable_in_negreal (mknegreal (- (delta / 2)) H13) + (mknegreal ((a - c) / 2) H12)); simpl in |- *; + intro; generalize (Rge_le (Rmax (- (delta / 2)) ((a - c) / 2)) 0 r); + intro; + elim + (Rlt_irrefl 0 + (Rle_lt_trans 0 (Rmax (- (delta / 2)) ((a - c) / 2)) 0 H15 H14)). + rewrite <- Ropp_0; rewrite <- (Ropp_involutive ((a - c) / 2)); + apply Ropp_lt_gt_contravar; replace (- ((a - c) / 2)) with ((c - a) / 2). + assumption. + unfold Rdiv in |- *. + rewrite <- Ropp_mult_distr_l_reverse. + rewrite (Ropp_minus_distr a c). + reflexivity. + rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; unfold Rdiv in |- *; + apply Rmult_lt_0_compat; + [ apply (cond_pos delta) + | assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ] ]. + red in |- *; intro; rewrite H11 in H10; elim (Rlt_irrefl 0 H10). + cut ((a - c) / 2 < 0). + intro; cut (- (delta / 2) < 0). + intro; + apply + (Rmax_stable_in_negreal (mknegreal (- (delta / 2)) H11) + (mknegreal ((a - c) / 2) H10)). + rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; unfold Rdiv in |- *; + apply Rmult_lt_0_compat; + [ apply (cond_pos delta) + | assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ] ]. + rewrite <- Ropp_0; rewrite <- (Ropp_involutive ((a - c) / 2)); + apply Ropp_lt_gt_contravar; replace (- ((a - c) / 2)) with ((c - a) / 2). + assumption. + unfold Rdiv in |- *. + rewrite <- Ropp_mult_distr_l_reverse. + rewrite (Ropp_minus_distr a c). + reflexivity. + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ generalize (Rplus_lt_compat_r (- a) a c H); rewrite Rplus_opp_r; intro; + assumption + | assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ] ]. + replace (- (l / 2)) with (- l / 2). + unfold Rdiv in |- *; apply Rmult_lt_0_compat. + rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption. + assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ]. + unfold Rdiv in |- *; apply Ropp_mult_distr_l_reverse. Qed. Theorem deriv_minimum : - forall f (a b c:R) (pr:derivable_pt f c), - a < c -> - c < b -> - (forall x:R, a < x -> x < b -> f c <= f x) -> derive_pt f c pr = 0. -intros. -rewrite <- (Ropp_involutive (derive_pt f c pr)). -apply Ropp_eq_0_compat. -rewrite <- (derive_pt_opp f c pr). -cut (forall x:R, a < x -> x < b -> (- f)%F x <= (- f)%F c). -intro. -apply (deriv_maximum (- f)%F a b c (derivable_pt_opp _ _ pr) H H0 H2). -intros; unfold opp_fct in |- *; apply Ropp_ge_le_contravar; apply Rle_ge. -apply (H1 x H2 H3). -Qed. - + forall f (a b c:R) (pr:derivable_pt f c), + a < c -> + c < b -> + (forall x:R, a < x -> x < b -> f c <= f x) -> derive_pt f c pr = 0. +Proof. + intros. + rewrite <- (Ropp_involutive (derive_pt f c pr)). + apply Ropp_eq_0_compat. + rewrite <- (derive_pt_opp f c pr). + cut (forall x:R, a < x -> x < b -> (- f)%F x <= (- f)%F c). + intro. + apply (deriv_maximum (- f)%F a b c (derivable_pt_opp _ _ pr) H H0 H2). + intros; unfold opp_fct in |- *; apply Ropp_ge_le_contravar; apply Rle_ge. + apply (H1 x H2 H3). +Qed. + Theorem deriv_constant2 : - forall f (a b c:R) (pr:derivable_pt f c), - a < c -> - c < b -> (forall x:R, a < x -> x < b -> f x = f c) -> derive_pt f c pr = 0. -intros. -eapply deriv_maximum with a b; try assumption. -intros; right; apply (H1 x H2 H3). + forall f (a b c:R) (pr:derivable_pt f c), + a < c -> + c < b -> (forall x:R, a < x -> x < b -> f x = f c) -> derive_pt f c pr = 0. +Proof. + intros. + eapply deriv_maximum with a b; try assumption. + intros; right; apply (H1 x H2 H3). Qed. (**********) Lemma nonneg_derivative_0 : - forall f (pr:derivable f), - increasing f -> forall x:R, 0 <= derive_pt f x (pr x). -intros; unfold increasing in H. -assert (H0 := derivable_derive f x (pr x)). -elim H0; intros l H1. -rewrite H1; case (Rtotal_order 0 l); intro. -left; assumption. -elim H2; intro. -right; assumption. -assert (H4 := derive_pt_eq_1 f x l (pr x) H1). -cut (0 < - (l / 2)). -intro; elim (H4 (- (l / 2)) H5); intros delta H6. -cut (delta / 2 <> 0 /\ 0 < delta / 2 /\ Rabs (delta / 2) < delta). -intro; decompose [and] H7; intros; generalize (H6 (delta / 2) H8 H11); - cut (0 <= (f (x + delta / 2) - f x) / (delta / 2)). -intro; cut (0 <= (f (x + delta / 2) - f x) / (delta / 2) - l). -intro; unfold Rabs in |- *; - case (Rcase_abs ((f (x + delta / 2) - f x) / (delta / 2) - l)). -intro; - elim - (Rlt_irrefl 0 - (Rle_lt_trans 0 ((f (x + delta / 2) - f x) / (delta / 2) - l) 0 H12 r)). -intros; - generalize - (Rplus_lt_compat_r l ((f (x + delta / 2) - f x) / (delta / 2) - l) - (- (l / 2)) H13); unfold Rminus in |- *; - replace (- (l / 2) + l) with (l / 2). -rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; intro; - generalize - (Rle_lt_trans 0 ((f (x + delta / 2) - f x) / (delta / 2)) (l / 2) H9 H14); - intro; cut (l / 2 < 0). -intro; elim (Rlt_irrefl 0 (Rlt_trans 0 (l / 2) 0 H15 H16)). -rewrite <- Ropp_0 in H5; - generalize (Ropp_lt_gt_contravar (-0) (- (l / 2)) H5); - repeat rewrite Ropp_involutive; intro; assumption. -pattern l at 3 in |- *; rewrite double_var. -ring. -unfold Rminus in |- *; apply Rplus_le_le_0_compat. -unfold Rdiv in |- *; apply Rmult_le_pos. -cut (x <= x + delta * / 2). -intro; generalize (H x (x + delta * / 2) H12); intro; - generalize (Rplus_le_compat_l (- f x) (f x) (f (x + delta * / 2)) H13); - rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption. -pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; - left; assumption. -left; apply Rinv_0_lt_compat; assumption. -left; rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption. -unfold Rdiv in |- *; apply Rmult_le_pos. -cut (x <= x + delta * / 2). -intro; generalize (H x (x + delta * / 2) H9); intro; - generalize (Rplus_le_compat_l (- f x) (f x) (f (x + delta * / 2)) H12); - rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption. -pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; - left; assumption. -left; apply Rinv_0_lt_compat; assumption. -split. -unfold Rdiv in |- *; apply prod_neq_R0. -generalize (cond_pos delta); intro; red in |- *; intro H9; rewrite H9 in H7; - elim (Rlt_irrefl 0 H7). -apply Rinv_neq_0_compat; discrR. -split. -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. -replace (Rabs (delta / 2)) with (delta / 2). -unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2. -prove_sup0. -rewrite (Rmult_comm 2). -rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]. -rewrite Rmult_1_r. -rewrite double. -pattern (pos delta) at 1 in |- *; rewrite <- Rplus_0_r. -apply Rplus_lt_compat_l; apply (cond_pos delta). -symmetry in |- *; apply Rabs_right. -left; change (0 < delta / 2) in |- *; unfold Rdiv in |- *; - apply Rmult_lt_0_compat; - [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. -unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse; - apply Rmult_lt_0_compat. -apply Rplus_lt_reg_r with l. -unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rplus_0_r; assumption. -apply Rinv_0_lt_compat; prove_sup0. + forall f (pr:derivable f), + increasing f -> forall x:R, 0 <= derive_pt f x (pr x). +Proof. + intros; unfold increasing in H. + assert (H0 := derivable_derive f x (pr x)). + elim H0; intros l H1. + rewrite H1; case (Rtotal_order 0 l); intro. + left; assumption. + elim H2; intro. + right; assumption. + assert (H4 := derive_pt_eq_1 f x l (pr x) H1). + cut (0 < - (l / 2)). + intro; elim (H4 (- (l / 2)) H5); intros delta H6. + cut (delta / 2 <> 0 /\ 0 < delta / 2 /\ Rabs (delta / 2) < delta). + intro; decompose [and] H7; intros; generalize (H6 (delta / 2) H8 H11); + cut (0 <= (f (x + delta / 2) - f x) / (delta / 2)). + intro; cut (0 <= (f (x + delta / 2) - f x) / (delta / 2) - l). + intro; unfold Rabs in |- *; + case (Rcase_abs ((f (x + delta / 2) - f x) / (delta / 2) - l)). + intro; + elim + (Rlt_irrefl 0 + (Rle_lt_trans 0 ((f (x + delta / 2) - f x) / (delta / 2) - l) 0 H12 r)). + intros; + generalize + (Rplus_lt_compat_r l ((f (x + delta / 2) - f x) / (delta / 2) - l) + (- (l / 2)) H13); unfold Rminus in |- *; + replace (- (l / 2) + l) with (l / 2). + rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; intro; + generalize + (Rle_lt_trans 0 ((f (x + delta / 2) - f x) / (delta / 2)) (l / 2) H9 H14); + intro; cut (l / 2 < 0). + intro; elim (Rlt_irrefl 0 (Rlt_trans 0 (l / 2) 0 H15 H16)). + rewrite <- Ropp_0 in H5; + generalize (Ropp_lt_gt_contravar (-0) (- (l / 2)) H5); + repeat rewrite Ropp_involutive; intro; assumption. + pattern l at 3 in |- *; rewrite double_var. + ring. + unfold Rminus in |- *; apply Rplus_le_le_0_compat. + unfold Rdiv in |- *; apply Rmult_le_pos. + cut (x <= x + delta * / 2). + intro; generalize (H x (x + delta * / 2) H12); intro; + generalize (Rplus_le_compat_l (- f x) (f x) (f (x + delta * / 2)) H13); + rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption. + pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; + left; assumption. + left; apply Rinv_0_lt_compat; assumption. + left; rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption. + unfold Rdiv in |- *; apply Rmult_le_pos. + cut (x <= x + delta * / 2). + intro; generalize (H x (x + delta * / 2) H9); intro; + generalize (Rplus_le_compat_l (- f x) (f x) (f (x + delta * / 2)) H12); + rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption. + pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; + left; assumption. + left; apply Rinv_0_lt_compat; assumption. + split. + unfold Rdiv in |- *; apply prod_neq_R0. + generalize (cond_pos delta); intro; red in |- *; intro H9; rewrite H9 in H7; + elim (Rlt_irrefl 0 H7). + apply Rinv_neq_0_compat; discrR. + split. + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. + replace (Rabs (delta / 2)) with (delta / 2). + unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2. + prove_sup0. + rewrite (Rmult_comm 2). + rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]. + rewrite Rmult_1_r. + rewrite double. + pattern (pos delta) at 1 in |- *; rewrite <- Rplus_0_r. + apply Rplus_lt_compat_l; apply (cond_pos delta). + symmetry in |- *; apply Rabs_right. + left; change (0 < delta / 2) in |- *; unfold Rdiv in |- *; + apply Rmult_lt_0_compat; + [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. + unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse; + apply Rmult_lt_0_compat. + apply Rplus_lt_reg_r with l. + unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rplus_0_r; assumption. + apply Rinv_0_lt_compat; prove_sup0. Qed. diff --git a/theories/Reals/Ranalysis2.v b/theories/Reals/Ranalysis2.v index 0627e22c..fb89da67 100644 --- a/theories/Reals/Ranalysis2.v +++ b/theories/Reals/Ranalysis2.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Ranalysis2.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Ranalysis2.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -14,437 +14,450 @@ Require Import Ranalysis1. Open Local Scope R_scope. (**********) Lemma formule : - forall (x h l1 l2:R) (f1 f2:R -> R), - h <> 0 -> - f2 x <> 0 -> - f2 (x + h) <> 0 -> - (f1 (x + h) / f2 (x + h) - f1 x / f2 x) / h - - (l1 * f2 x - l2 * f1 x) / Rsqr (f2 x) = - / f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1) + - l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h)) - - f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2) + - l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x). -intros; unfold Rdiv, Rminus, Rsqr in |- *. -repeat rewrite Rmult_plus_distr_r; repeat rewrite Rmult_plus_distr_l; - repeat rewrite Rinv_mult_distr; try assumption. -replace (l1 * f2 x * (/ f2 x * / f2 x)) with (l1 * / f2 x * (f2 x * / f2 x)); - [ idtac | ring ]. -replace (l1 * (/ f2 x * / f2 (x + h)) * f2 x) with - (l1 * / f2 (x + h) * (f2 x * / f2 x)); [ idtac | ring ]. -replace (l1 * (/ f2 x * / f2 (x + h)) * - f2 (x + h)) with - (- (l1 * / f2 x * (f2 (x + h) * / f2 (x + h)))); [ idtac | ring ]. -replace (f1 x * (/ f2 x * / f2 (x + h)) * (f2 (x + h) * / h)) with - (f1 x * / f2 x * / h * (f2 (x + h) * / f2 (x + h))); - [ idtac | ring ]. -replace (f1 x * (/ f2 x * / f2 (x + h)) * (- f2 x * / h)) with - (- (f1 x * / f2 (x + h) * / h * (f2 x * / f2 x))); - [ idtac | ring ]. -replace (l2 * f1 x * (/ f2 x * / f2 x * / f2 (x + h)) * f2 (x + h)) with - (l2 * f1 x * / f2 x * / f2 x * (f2 (x + h) * / f2 (x + h))); - [ idtac | ring ]. -replace (l2 * f1 x * (/ f2 x * / f2 x * / f2 (x + h)) * - f2 x) with - (- (l2 * f1 x * / f2 x * / f2 (x + h) * (f2 x * / f2 x))); - [ idtac | ring ]. -repeat rewrite <- Rinv_r_sym; try assumption || ring. -apply prod_neq_R0; assumption. + forall (x h l1 l2:R) (f1 f2:R -> R), + h <> 0 -> + f2 x <> 0 -> + f2 (x + h) <> 0 -> + (f1 (x + h) / f2 (x + h) - f1 x / f2 x) / h - + (l1 * f2 x - l2 * f1 x) / Rsqr (f2 x) = + / f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1) + + l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h)) - + f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2) + + l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x). +Proof. + intros; unfold Rdiv, Rminus, Rsqr in |- *. + repeat rewrite Rmult_plus_distr_r; repeat rewrite Rmult_plus_distr_l; + repeat rewrite Rinv_mult_distr; try assumption. + replace (l1 * f2 x * (/ f2 x * / f2 x)) with (l1 * / f2 x * (f2 x * / f2 x)); + [ idtac | ring ]. + replace (l1 * (/ f2 x * / f2 (x + h)) * f2 x) with + (l1 * / f2 (x + h) * (f2 x * / f2 x)); [ idtac | ring ]. + replace (l1 * (/ f2 x * / f2 (x + h)) * - f2 (x + h)) with + (- (l1 * / f2 x * (f2 (x + h) * / f2 (x + h)))); [ idtac | ring ]. + replace (f1 x * (/ f2 x * / f2 (x + h)) * (f2 (x + h) * / h)) with + (f1 x * / f2 x * / h * (f2 (x + h) * / f2 (x + h))); + [ idtac | ring ]. + replace (f1 x * (/ f2 x * / f2 (x + h)) * (- f2 x * / h)) with + (- (f1 x * / f2 (x + h) * / h * (f2 x * / f2 x))); + [ idtac | ring ]. + replace (l2 * f1 x * (/ f2 x * / f2 x * / f2 (x + h)) * f2 (x + h)) with + (l2 * f1 x * / f2 x * / f2 x * (f2 (x + h) * / f2 (x + h))); + [ idtac | ring ]. + replace (l2 * f1 x * (/ f2 x * / f2 x * / f2 (x + h)) * - f2 x) with + (- (l2 * f1 x * / f2 x * / f2 (x + h) * (f2 x * / f2 x))); + [ idtac | ring ]. + repeat rewrite <- Rinv_r_sym; try assumption || ring. + apply prod_neq_R0; assumption. Qed. Lemma Rmin_pos : forall x y:R, 0 < x -> 0 < y -> 0 < Rmin x y. -intros; unfold Rmin in |- *. -case (Rle_dec x y); intro; assumption. +Proof. + intros; unfold Rmin in |- *. + case (Rle_dec x y); intro; assumption. Qed. Lemma maj_term1 : - forall (x h eps l1 alp_f2:R) (eps_f2 alp_f1d:posreal) - (f1 f2:R -> R), - 0 < eps -> - f2 x <> 0 -> - f2 (x + h) <> 0 -> - (forall h:R, + forall (x h eps l1 alp_f2:R) (eps_f2 alp_f1d:posreal) + (f1 f2:R -> R), + 0 < eps -> + f2 x <> 0 -> + f2 (x + h) <> 0 -> + (forall h:R, h <> 0 -> Rabs h < alp_f1d -> Rabs ((f1 (x + h) - f1 x) / h - l1) < Rabs (eps * f2 x / 8)) -> - (forall a:R, + (forall a:R, Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)) -> - h <> 0 -> - Rabs h < alp_f1d -> - Rabs h < Rmin eps_f2 alp_f2 -> - Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) < eps / 4. -intros. -assert (H7 := H3 h H6). -assert (H8 := H2 h H4 H5). -apply Rle_lt_trans with - (2 / Rabs (f2 x) * Rabs ((f1 (x + h) - f1 x) / h - l1)). -rewrite Rabs_mult. -apply Rmult_le_compat_r. -apply Rabs_pos. -rewrite Rabs_Rinv; [ left; exact H7 | assumption ]. -apply Rlt_le_trans with (2 / Rabs (f2 x) * Rabs (eps * f2 x / 8)). -apply Rmult_lt_compat_l. -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ prove_sup0 | apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption ]. -exact H8. -right; unfold Rdiv in |- *. -repeat rewrite Rabs_mult. -rewrite Rabs_Rinv; discrR. -replace (Rabs 8) with 8. -replace 8 with 8; [ idtac | ring ]. -rewrite Rinv_mult_distr; [ idtac | discrR | discrR ]. -replace (2 * / Rabs (f2 x) * (Rabs eps * Rabs (f2 x) * (/ 2 * / 4))) with - (Rabs eps * / 4 * (2 * / 2) * (Rabs (f2 x) * / Rabs (f2 x))); - [ idtac | ring ]. -replace (Rabs eps) with eps. -repeat rewrite <- Rinv_r_sym; try discrR || (apply Rabs_no_R0; assumption). -ring. -symmetry in |- *; apply Rabs_right; left; assumption. -symmetry in |- *; apply Rabs_right; left; prove_sup. + h <> 0 -> + Rabs h < alp_f1d -> + Rabs h < Rmin eps_f2 alp_f2 -> + Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) < eps / 4. +Proof. + intros. + assert (H7 := H3 h H6). + assert (H8 := H2 h H4 H5). + apply Rle_lt_trans with + (2 / Rabs (f2 x) * Rabs ((f1 (x + h) - f1 x) / h - l1)). + rewrite Rabs_mult. + apply Rmult_le_compat_r. + apply Rabs_pos. + rewrite Rabs_Rinv; [ left; exact H7 | assumption ]. + apply Rlt_le_trans with (2 / Rabs (f2 x) * Rabs (eps * f2 x / 8)). + apply Rmult_lt_compat_l. + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ prove_sup0 | apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption ]. + exact H8. + right; unfold Rdiv in |- *. + repeat rewrite Rabs_mult. + rewrite Rabs_Rinv; discrR. + replace (Rabs 8) with 8. + replace 8 with 8; [ idtac | ring ]. + rewrite Rinv_mult_distr; [ idtac | discrR | discrR ]. + replace (2 * / Rabs (f2 x) * (Rabs eps * Rabs (f2 x) * (/ 2 * / 4))) with + (Rabs eps * / 4 * (2 * / 2) * (Rabs (f2 x) * / Rabs (f2 x))); + [ idtac | ring ]. + replace (Rabs eps) with eps. + repeat rewrite <- Rinv_r_sym; try discrR || (apply Rabs_no_R0; assumption). + ring. + symmetry in |- *; apply Rabs_right; left; assumption. + symmetry in |- *; apply Rabs_right; left; prove_sup. Qed. Lemma maj_term2 : - forall (x h eps l1 alp_f2 alp_f2t2:R) (eps_f2:posreal) - (f2:R -> R), - 0 < eps -> - f2 x <> 0 -> - f2 (x + h) <> 0 -> - (forall a:R, + forall (x h eps l1 alp_f2 alp_f2t2:R) (eps_f2:posreal) + (f2:R -> R), + 0 < eps -> + f2 x <> 0 -> + f2 (x + h) <> 0 -> + (forall a:R, Rabs a < alp_f2t2 -> Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (8 * l1))) -> - (forall a:R, + (forall a:R, Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)) -> - h <> 0 -> - Rabs h < alp_f2t2 -> - Rabs h < Rmin eps_f2 alp_f2 -> - l1 <> 0 -> Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) < eps / 4. -intros. -assert (H8 := H3 h H6). -assert (H9 := H2 h H5). -apply Rle_lt_trans with - (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (eps * Rsqr (f2 x) / (8 * l1))). -rewrite Rabs_mult; apply Rmult_le_compat_l. -apply Rabs_pos. -rewrite <- (Rabs_Ropp (f2 x - f2 (x + h))); rewrite Ropp_minus_distr. -left; apply H9. -apply Rlt_le_trans with - (Rabs (2 * (l1 / (f2 x * f2 x))) * Rabs (eps * Rsqr (f2 x) / (8 * l1))). -apply Rmult_lt_compat_r. -apply Rabs_pos_lt. -unfold Rdiv in |- *; unfold Rsqr in |- *; repeat apply prod_neq_R0; - try assumption || discrR. -red in |- *; intro H10; rewrite H10 in H; elim (Rlt_irrefl _ H). -apply Rinv_neq_0_compat; apply prod_neq_R0; try assumption || discrR. -unfold Rdiv in |- *. -repeat rewrite Rinv_mult_distr; try assumption. -repeat rewrite Rabs_mult. -replace (Rabs 2) with 2. -rewrite (Rmult_comm 2). -replace (Rabs l1 * (Rabs (/ f2 x) * Rabs (/ f2 x)) * 2) with - (Rabs l1 * (Rabs (/ f2 x) * (Rabs (/ f2 x) * 2))); - [ idtac | ring ]. -repeat apply Rmult_lt_compat_l. -apply Rabs_pos_lt; assumption. -apply Rabs_pos_lt; apply Rinv_neq_0_compat; assumption. -repeat rewrite Rabs_Rinv; try assumption. -rewrite <- (Rmult_comm 2). -unfold Rdiv in H8; exact H8. -symmetry in |- *; apply Rabs_right; left; prove_sup0. -right. -unfold Rsqr, Rdiv in |- *. -do 1 rewrite Rinv_mult_distr; try assumption || discrR. -do 1 rewrite Rinv_mult_distr; try assumption || discrR. -repeat rewrite Rabs_mult. -repeat rewrite Rabs_Rinv; try assumption || discrR. -replace (Rabs eps) with eps. -replace (Rabs 8) with 8. -replace (Rabs 2) with 2. -replace 8 with (4 * 2); [ idtac | ring ]. -rewrite Rinv_mult_distr; discrR. -replace - (2 * (Rabs l1 * (/ Rabs (f2 x) * / Rabs (f2 x))) * - (eps * (Rabs (f2 x) * Rabs (f2 x)) * (/ 4 * / 2 * / Rabs l1))) with - (eps * / 4 * (Rabs l1 * / Rabs l1) * (Rabs (f2 x) * / Rabs (f2 x)) * - (Rabs (f2 x) * / Rabs (f2 x)) * (2 * / 2)); [ idtac | ring ]. -repeat rewrite <- Rinv_r_sym; try (apply Rabs_no_R0; assumption) || discrR. -ring. -symmetry in |- *; apply Rabs_right; left; prove_sup0. -symmetry in |- *; apply Rabs_right; left; prove_sup. -symmetry in |- *; apply Rabs_right; left; assumption. + h <> 0 -> + Rabs h < alp_f2t2 -> + Rabs h < Rmin eps_f2 alp_f2 -> + l1 <> 0 -> Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) < eps / 4. +Proof. + intros. + assert (H8 := H3 h H6). + assert (H9 := H2 h H5). + apply Rle_lt_trans with + (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (eps * Rsqr (f2 x) / (8 * l1))). + rewrite Rabs_mult; apply Rmult_le_compat_l. + apply Rabs_pos. + rewrite <- (Rabs_Ropp (f2 x - f2 (x + h))); rewrite Ropp_minus_distr. + left; apply H9. + apply Rlt_le_trans with + (Rabs (2 * (l1 / (f2 x * f2 x))) * Rabs (eps * Rsqr (f2 x) / (8 * l1))). + apply Rmult_lt_compat_r. + apply Rabs_pos_lt. + unfold Rdiv in |- *; unfold Rsqr in |- *; repeat apply prod_neq_R0; + try assumption || discrR. + red in |- *; intro H10; rewrite H10 in H; elim (Rlt_irrefl _ H). + apply Rinv_neq_0_compat; apply prod_neq_R0; try assumption || discrR. + unfold Rdiv in |- *. + repeat rewrite Rinv_mult_distr; try assumption. + repeat rewrite Rabs_mult. + replace (Rabs 2) with 2. + rewrite (Rmult_comm 2). + replace (Rabs l1 * (Rabs (/ f2 x) * Rabs (/ f2 x)) * 2) with + (Rabs l1 * (Rabs (/ f2 x) * (Rabs (/ f2 x) * 2))); + [ idtac | ring ]. + repeat apply Rmult_lt_compat_l. + apply Rabs_pos_lt; assumption. + apply Rabs_pos_lt; apply Rinv_neq_0_compat; assumption. + repeat rewrite Rabs_Rinv; try assumption. + rewrite <- (Rmult_comm 2). + unfold Rdiv in H8; exact H8. + symmetry in |- *; apply Rabs_right; left; prove_sup0. + right. + unfold Rsqr, Rdiv in |- *. + do 1 rewrite Rinv_mult_distr; try assumption || discrR. + do 1 rewrite Rinv_mult_distr; try assumption || discrR. + repeat rewrite Rabs_mult. + repeat rewrite Rabs_Rinv; try assumption || discrR. + replace (Rabs eps) with eps. + replace (Rabs 8) with 8. + replace (Rabs 2) with 2. + replace 8 with (4 * 2); [ idtac | ring ]. + rewrite Rinv_mult_distr; discrR. + replace + (2 * (Rabs l1 * (/ Rabs (f2 x) * / Rabs (f2 x))) * + (eps * (Rabs (f2 x) * Rabs (f2 x)) * (/ 4 * / 2 * / Rabs l1))) with + (eps * / 4 * (Rabs l1 * / Rabs l1) * (Rabs (f2 x) * / Rabs (f2 x)) * + (Rabs (f2 x) * / Rabs (f2 x)) * (2 * / 2)); [ idtac | ring ]. + repeat rewrite <- Rinv_r_sym; try (apply Rabs_no_R0; assumption) || discrR. + ring. + symmetry in |- *; apply Rabs_right; left; prove_sup0. + symmetry in |- *; apply Rabs_right; left; prove_sup. + symmetry in |- *; apply Rabs_right; left; assumption. Qed. Lemma maj_term3 : - forall (x h eps l2 alp_f2:R) (eps_f2 alp_f2d:posreal) - (f1 f2:R -> R), - 0 < eps -> - f2 x <> 0 -> - f2 (x + h) <> 0 -> - (forall h:R, + forall (x h eps l2 alp_f2:R) (eps_f2 alp_f2d:posreal) + (f1 f2:R -> R), + 0 < eps -> + f2 x <> 0 -> + f2 (x + h) <> 0 -> + (forall h:R, h <> 0 -> Rabs h < alp_f2d -> Rabs ((f2 (x + h) - f2 x) / h - l2) < Rabs (Rsqr (f2 x) * eps / (8 * f1 x))) -> - (forall a:R, + (forall a:R, Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)) -> - h <> 0 -> - Rabs h < alp_f2d -> - Rabs h < Rmin eps_f2 alp_f2 -> - f1 x <> 0 -> - Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) < - eps / 4. -intros. -assert (H8 := H2 h H4 H5). -assert (H9 := H3 h H6). -apply Rle_lt_trans with - (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs (Rsqr (f2 x) * eps / (8 * f1 x))). -rewrite Rabs_mult. -apply Rmult_le_compat_l. -apply Rabs_pos. -left; apply H8. -apply Rlt_le_trans with - (Rabs (2 * (f1 x / (f2 x * f2 x))) * Rabs (Rsqr (f2 x) * eps / (8 * f1 x))). -apply Rmult_lt_compat_r. -apply Rabs_pos_lt. -unfold Rdiv in |- *; unfold Rsqr in |- *; repeat apply prod_neq_R0; - try assumption. -red in |- *; intro H10; rewrite H10 in H; elim (Rlt_irrefl _ H). -apply Rinv_neq_0_compat; apply prod_neq_R0; discrR || assumption. -unfold Rdiv in |- *. -repeat rewrite Rinv_mult_distr; try assumption. -repeat rewrite Rabs_mult. -replace (Rabs 2) with 2. -rewrite (Rmult_comm 2). -replace (Rabs (f1 x) * (Rabs (/ f2 x) * Rabs (/ f2 x)) * 2) with - (Rabs (f1 x) * (Rabs (/ f2 x) * (Rabs (/ f2 x) * 2))); - [ idtac | ring ]. -repeat apply Rmult_lt_compat_l. -apply Rabs_pos_lt; assumption. -apply Rabs_pos_lt; apply Rinv_neq_0_compat; assumption. -repeat rewrite Rabs_Rinv; assumption || idtac. -rewrite <- (Rmult_comm 2). -unfold Rdiv in H9; exact H9. -symmetry in |- *; apply Rabs_right; left; prove_sup0. -right. -unfold Rsqr, Rdiv in |- *. -rewrite Rinv_mult_distr; try assumption || discrR. -rewrite Rinv_mult_distr; try assumption || discrR. -repeat rewrite Rabs_mult. -repeat rewrite Rabs_Rinv; try assumption || discrR. -replace (Rabs eps) with eps. -replace (Rabs 8) with 8. -replace (Rabs 2) with 2. -replace 8 with (4 * 2); [ idtac | ring ]. -rewrite Rinv_mult_distr; discrR. -replace - (2 * (Rabs (f1 x) * (/ Rabs (f2 x) * / Rabs (f2 x))) * - (Rabs (f2 x) * Rabs (f2 x) * eps * (/ 4 * / 2 * / Rabs (f1 x)))) with - (eps * / 4 * (Rabs (f2 x) * / Rabs (f2 x)) * (Rabs (f2 x) * / Rabs (f2 x)) * - (Rabs (f1 x) * / Rabs (f1 x)) * (2 * / 2)); [ idtac | ring ]. -repeat rewrite <- Rinv_r_sym; try discrR || (apply Rabs_no_R0; assumption). -ring. -symmetry in |- *; apply Rabs_right; left; prove_sup0. -symmetry in |- *; apply Rabs_right; left; prove_sup. -symmetry in |- *; apply Rabs_right; left; assumption. + h <> 0 -> + Rabs h < alp_f2d -> + Rabs h < Rmin eps_f2 alp_f2 -> + f1 x <> 0 -> + Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) < + eps / 4. +Proof. + intros. + assert (H8 := H2 h H4 H5). + assert (H9 := H3 h H6). + apply Rle_lt_trans with + (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs (Rsqr (f2 x) * eps / (8 * f1 x))). + rewrite Rabs_mult. + apply Rmult_le_compat_l. + apply Rabs_pos. + left; apply H8. + apply Rlt_le_trans with + (Rabs (2 * (f1 x / (f2 x * f2 x))) * Rabs (Rsqr (f2 x) * eps / (8 * f1 x))). + apply Rmult_lt_compat_r. + apply Rabs_pos_lt. + unfold Rdiv in |- *; unfold Rsqr in |- *; repeat apply prod_neq_R0; + try assumption. + red in |- *; intro H10; rewrite H10 in H; elim (Rlt_irrefl _ H). + apply Rinv_neq_0_compat; apply prod_neq_R0; discrR || assumption. + unfold Rdiv in |- *. + repeat rewrite Rinv_mult_distr; try assumption. + repeat rewrite Rabs_mult. + replace (Rabs 2) with 2. + rewrite (Rmult_comm 2). + replace (Rabs (f1 x) * (Rabs (/ f2 x) * Rabs (/ f2 x)) * 2) with + (Rabs (f1 x) * (Rabs (/ f2 x) * (Rabs (/ f2 x) * 2))); + [ idtac | ring ]. + repeat apply Rmult_lt_compat_l. + apply Rabs_pos_lt; assumption. + apply Rabs_pos_lt; apply Rinv_neq_0_compat; assumption. + repeat rewrite Rabs_Rinv; assumption || idtac. + rewrite <- (Rmult_comm 2). + unfold Rdiv in H9; exact H9. + symmetry in |- *; apply Rabs_right; left; prove_sup0. + right. + unfold Rsqr, Rdiv in |- *. + rewrite Rinv_mult_distr; try assumption || discrR. + rewrite Rinv_mult_distr; try assumption || discrR. + repeat rewrite Rabs_mult. + repeat rewrite Rabs_Rinv; try assumption || discrR. + replace (Rabs eps) with eps. + replace (Rabs 8) with 8. + replace (Rabs 2) with 2. + replace 8 with (4 * 2); [ idtac | ring ]. + rewrite Rinv_mult_distr; discrR. + replace + (2 * (Rabs (f1 x) * (/ Rabs (f2 x) * / Rabs (f2 x))) * + (Rabs (f2 x) * Rabs (f2 x) * eps * (/ 4 * / 2 * / Rabs (f1 x)))) with + (eps * / 4 * (Rabs (f2 x) * / Rabs (f2 x)) * (Rabs (f2 x) * / Rabs (f2 x)) * + (Rabs (f1 x) * / Rabs (f1 x)) * (2 * / 2)); [ idtac | ring ]. + repeat rewrite <- Rinv_r_sym; try discrR || (apply Rabs_no_R0; assumption). + ring. + symmetry in |- *; apply Rabs_right; left; prove_sup0. + symmetry in |- *; apply Rabs_right; left; prove_sup. + symmetry in |- *; apply Rabs_right; left; assumption. Qed. Lemma maj_term4 : - forall (x h eps l2 alp_f2 alp_f2c:R) (eps_f2:posreal) - (f1 f2:R -> R), - 0 < eps -> - f2 x <> 0 -> - f2 (x + h) <> 0 -> - (forall a:R, + forall (x h eps l2 alp_f2 alp_f2c:R) (eps_f2:posreal) + (f1 f2:R -> R), + 0 < eps -> + f2 x <> 0 -> + f2 (x + h) <> 0 -> + (forall a:R, Rabs a < alp_f2c -> Rabs (f2 (x + a) - f2 x) < Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))) -> - (forall a:R, + (forall a:R, Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)) -> - h <> 0 -> - Rabs h < alp_f2c -> - Rabs h < Rmin eps_f2 alp_f2 -> - f1 x <> 0 -> - l2 <> 0 -> - Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x)) < - eps / 4. -intros. -assert (H9 := H2 h H5). -assert (H10 := H3 h H6). -apply Rle_lt_trans with - (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * - Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))). -rewrite Rabs_mult. -apply Rmult_le_compat_l. -apply Rabs_pos. -left; apply H9. -apply Rlt_le_trans with - (Rabs (2 * l2 * (f1 x / (Rsqr (f2 x) * f2 x))) * - Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))). -apply Rmult_lt_compat_r. -apply Rabs_pos_lt. -unfold Rdiv in |- *; unfold Rsqr in |- *; repeat apply prod_neq_R0; - assumption || idtac. -red in |- *; intro H11; rewrite H11 in H; elim (Rlt_irrefl _ H). -apply Rinv_neq_0_compat; apply prod_neq_R0. -apply prod_neq_R0. -discrR. -assumption. -assumption. -unfold Rdiv in |- *. -repeat rewrite Rinv_mult_distr; - try assumption || (unfold Rsqr in |- *; apply prod_neq_R0; assumption). -repeat rewrite Rabs_mult. -replace (Rabs 2) with 2. -replace - (2 * Rabs l2 * (Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * Rabs (/ f2 x)))) with - (Rabs l2 * (Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * (Rabs (/ f2 x) * 2)))); - [ idtac | ring ]. -replace - (Rabs l2 * Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * Rabs (/ f2 (x + h)))) with - (Rabs l2 * (Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * Rabs (/ f2 (x + h))))); - [ idtac | ring ]. -repeat apply Rmult_lt_compat_l. -apply Rabs_pos_lt; assumption. -apply Rabs_pos_lt; assumption. -apply Rabs_pos_lt; apply Rinv_neq_0_compat; unfold Rsqr in |- *; - apply prod_neq_R0; assumption. -repeat rewrite Rabs_Rinv; [ idtac | assumption | assumption ]. -rewrite <- (Rmult_comm 2). -unfold Rdiv in H10; exact H10. -symmetry in |- *; apply Rabs_right; left; prove_sup0. -right; unfold Rsqr, Rdiv in |- *. -rewrite Rinv_mult_distr; try assumption || discrR. -rewrite Rinv_mult_distr; try assumption || discrR. -rewrite Rinv_mult_distr; try assumption || discrR. -rewrite Rinv_mult_distr; try assumption || discrR. -repeat rewrite Rabs_mult. -repeat rewrite Rabs_Rinv; try assumption || discrR. -replace (Rabs eps) with eps. -replace (Rabs 8) with 8. -replace (Rabs 2) with 2. -replace 8 with (4 * 2); [ idtac | ring ]. -rewrite Rinv_mult_distr; discrR. -replace - (2 * Rabs l2 * - (Rabs (f1 x) * (/ Rabs (f2 x) * / Rabs (f2 x) * / Rabs (f2 x))) * - (Rabs (f2 x) * Rabs (f2 x) * Rabs (f2 x) * eps * - (/ 4 * / 2 * / Rabs (f1 x) * / Rabs l2))) with - (eps * / 4 * (Rabs l2 * / Rabs l2) * (Rabs (f1 x) * / Rabs (f1 x)) * - (Rabs (f2 x) * / Rabs (f2 x)) * (Rabs (f2 x) * / Rabs (f2 x)) * - (Rabs (f2 x) * / Rabs (f2 x)) * (2 * / 2)); [ idtac | ring ]. -repeat rewrite <- Rinv_r_sym; try discrR || (apply Rabs_no_R0; assumption). -ring. -symmetry in |- *; apply Rabs_right; left; prove_sup0. -symmetry in |- *; apply Rabs_right; left; prove_sup. -symmetry in |- *; apply Rabs_right; left; assumption. -apply prod_neq_R0; assumption || discrR. -apply prod_neq_R0; assumption. + h <> 0 -> + Rabs h < alp_f2c -> + Rabs h < Rmin eps_f2 alp_f2 -> + f1 x <> 0 -> + l2 <> 0 -> + Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x)) < + eps / 4. +Proof. + intros. + assert (H9 := H2 h H5). + assert (H10 := H3 h H6). + apply Rle_lt_trans with + (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * + Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))). + rewrite Rabs_mult. + apply Rmult_le_compat_l. + apply Rabs_pos. + left; apply H9. + apply Rlt_le_trans with + (Rabs (2 * l2 * (f1 x / (Rsqr (f2 x) * f2 x))) * + Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))). + apply Rmult_lt_compat_r. + apply Rabs_pos_lt. + unfold Rdiv in |- *; unfold Rsqr in |- *; repeat apply prod_neq_R0; + assumption || idtac. + red in |- *; intro H11; rewrite H11 in H; elim (Rlt_irrefl _ H). + apply Rinv_neq_0_compat; apply prod_neq_R0. + apply prod_neq_R0. + discrR. + assumption. + assumption. + unfold Rdiv in |- *. + repeat rewrite Rinv_mult_distr; + try assumption || (unfold Rsqr in |- *; apply prod_neq_R0; assumption). + repeat rewrite Rabs_mult. + replace (Rabs 2) with 2. + replace + (2 * Rabs l2 * (Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * Rabs (/ f2 x)))) with + (Rabs l2 * (Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * (Rabs (/ f2 x) * 2)))); + [ idtac | ring ]. + replace + (Rabs l2 * Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * Rabs (/ f2 (x + h)))) with + (Rabs l2 * (Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * Rabs (/ f2 (x + h))))); + [ idtac | ring ]. + repeat apply Rmult_lt_compat_l. + apply Rabs_pos_lt; assumption. + apply Rabs_pos_lt; assumption. + apply Rabs_pos_lt; apply Rinv_neq_0_compat; unfold Rsqr in |- *; + apply prod_neq_R0; assumption. + repeat rewrite Rabs_Rinv; [ idtac | assumption | assumption ]. + rewrite <- (Rmult_comm 2). + unfold Rdiv in H10; exact H10. + symmetry in |- *; apply Rabs_right; left; prove_sup0. + right; unfold Rsqr, Rdiv in |- *. + rewrite Rinv_mult_distr; try assumption || discrR. + rewrite Rinv_mult_distr; try assumption || discrR. + rewrite Rinv_mult_distr; try assumption || discrR. + rewrite Rinv_mult_distr; try assumption || discrR. + repeat rewrite Rabs_mult. + repeat rewrite Rabs_Rinv; try assumption || discrR. + replace (Rabs eps) with eps. + replace (Rabs 8) with 8. + replace (Rabs 2) with 2. + replace 8 with (4 * 2); [ idtac | ring ]. + rewrite Rinv_mult_distr; discrR. + replace + (2 * Rabs l2 * + (Rabs (f1 x) * (/ Rabs (f2 x) * / Rabs (f2 x) * / Rabs (f2 x))) * + (Rabs (f2 x) * Rabs (f2 x) * Rabs (f2 x) * eps * + (/ 4 * / 2 * / Rabs (f1 x) * / Rabs l2))) with + (eps * / 4 * (Rabs l2 * / Rabs l2) * (Rabs (f1 x) * / Rabs (f1 x)) * + (Rabs (f2 x) * / Rabs (f2 x)) * (Rabs (f2 x) * / Rabs (f2 x)) * + (Rabs (f2 x) * / Rabs (f2 x)) * (2 * / 2)); [ idtac | ring ]. + repeat rewrite <- Rinv_r_sym; try discrR || (apply Rabs_no_R0; assumption). + ring. + symmetry in |- *; apply Rabs_right; left; prove_sup0. + symmetry in |- *; apply Rabs_right; left; prove_sup. + symmetry in |- *; apply Rabs_right; left; assumption. + apply prod_neq_R0; assumption || discrR. + apply prod_neq_R0; assumption. Qed. Lemma D_x_no_cond : forall x a:R, a <> 0 -> D_x no_cond x (x + a). -intros. -unfold D_x, no_cond in |- *. -split. -trivial. -apply Rminus_not_eq. -unfold Rminus in |- *. -rewrite Ropp_plus_distr. -rewrite <- Rplus_assoc. -rewrite Rplus_opp_r. -rewrite Rplus_0_l. -apply Ropp_neq_0_compat; assumption. +Proof. + intros. + unfold D_x, no_cond in |- *. + split. + trivial. + apply Rminus_not_eq. + unfold Rminus in |- *. + rewrite Ropp_plus_distr. + rewrite <- Rplus_assoc. + rewrite Rplus_opp_r. + rewrite Rplus_0_l. + apply Ropp_neq_0_compat; assumption. Qed. Lemma Rabs_4 : - forall a b c d:R, Rabs (a + b + c + d) <= Rabs a + Rabs b + Rabs c + Rabs d. -intros. -apply Rle_trans with (Rabs (a + b) + Rabs (c + d)). -replace (a + b + c + d) with (a + b + (c + d)); [ apply Rabs_triang | ring ]. -apply Rle_trans with (Rabs a + Rabs b + Rabs (c + d)). -apply Rplus_le_compat_r. -apply Rabs_triang. -repeat rewrite Rplus_assoc; repeat apply Rplus_le_compat_l. -apply Rabs_triang. + forall a b c d:R, Rabs (a + b + c + d) <= Rabs a + Rabs b + Rabs c + Rabs d. +Proof. + intros. + apply Rle_trans with (Rabs (a + b) + Rabs (c + d)). + replace (a + b + c + d) with (a + b + (c + d)); [ apply Rabs_triang | ring ]. + apply Rle_trans with (Rabs a + Rabs b + Rabs (c + d)). + apply Rplus_le_compat_r. + apply Rabs_triang. + repeat rewrite Rplus_assoc; repeat apply Rplus_le_compat_l. + apply Rabs_triang. Qed. Lemma Rlt_4 : - forall a b c d e f g h:R, - a < b -> c < d -> e < f -> g < h -> a + c + e + g < b + d + f + h. -intros; apply Rlt_trans with (b + c + e + g). -repeat apply Rplus_lt_compat_r; assumption. -repeat rewrite Rplus_assoc; apply Rplus_lt_compat_l. -apply Rlt_trans with (d + e + g). -rewrite Rplus_assoc; apply Rplus_lt_compat_r; assumption. -rewrite Rplus_assoc; apply Rplus_lt_compat_l; apply Rlt_trans with (f + g). -apply Rplus_lt_compat_r; assumption. -apply Rplus_lt_compat_l; assumption. + forall a b c d e f g h:R, + a < b -> c < d -> e < f -> g < h -> a + c + e + g < b + d + f + h. +Proof. + intros; apply Rlt_trans with (b + c + e + g). + repeat apply Rplus_lt_compat_r; assumption. + repeat rewrite Rplus_assoc; apply Rplus_lt_compat_l. + apply Rlt_trans with (d + e + g). + rewrite Rplus_assoc; apply Rplus_lt_compat_r; assumption. + rewrite Rplus_assoc; apply Rplus_lt_compat_l; apply Rlt_trans with (f + g). + apply Rplus_lt_compat_r; assumption. + apply Rplus_lt_compat_l; assumption. Qed. Lemma Rmin_2 : forall a b c:R, a < b -> a < c -> a < Rmin b c. -intros; unfold Rmin in |- *; case (Rle_dec b c); intro; assumption. +Proof. + intros; unfold Rmin in |- *; case (Rle_dec b c); intro; assumption. Qed. Lemma quadruple : forall x:R, 4 * x = x + x + x + x. -intro; ring. +Proof. + intro; ring. Qed. Lemma quadruple_var : forall x:R, x = x / 4 + x / 4 + x / 4 + x / 4. -intro; rewrite <- quadruple. -unfold Rdiv in |- *; rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m; discrR. -reflexivity. +Proof. + intro; rewrite <- quadruple. + unfold Rdiv in |- *; rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m; discrR. + reflexivity. Qed. (**********) Lemma continuous_neq_0 : - forall (f:R -> R) (x0:R), - continuity_pt f x0 -> - f x0 <> 0 -> + forall (f:R -> R) (x0:R), + continuity_pt f x0 -> + f x0 <> 0 -> exists eps : posreal, (forall h:R, Rabs h < eps -> f (x0 + h) <> 0). -intros; unfold continuity_pt in H; unfold continue_in in H; - unfold limit1_in in H; unfold limit_in in H; elim (H (Rabs (f x0 / 2))). -intros; elim H1; intros. -exists (mkposreal x H2). -intros; assert (H5 := H3 (x0 + h)). -cut - (dist R_met (x0 + h) x0 < x -> - dist R_met (f (x0 + h)) (f x0) < Rabs (f x0 / 2)). -unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; - replace (x0 + h - x0) with h. -intros; assert (H7 := H6 H4). -red in |- *; intro. -rewrite H8 in H7; unfold Rminus in H7; rewrite Rplus_0_l in H7; - rewrite Rabs_Ropp in H7; unfold Rdiv in H7; rewrite Rabs_mult in H7; - pattern (Rabs (f x0)) at 1 in H7; rewrite <- Rmult_1_r in H7. -cut (0 < Rabs (f x0)). -intro; assert (H10 := Rmult_lt_reg_l _ _ _ H9 H7). -cut (Rabs (/ 2) = / 2). -assert (Hyp : 0 < 2). -prove_sup0. -intro; rewrite H11 in H10; assert (H12 := Rmult_lt_compat_l 2 _ _ Hyp H10); - rewrite Rmult_1_r in H12; rewrite <- Rinv_r_sym in H12; - [ idtac | discrR ]. -cut (IZR 1 < IZR 2). -unfold IZR in |- *; unfold INR, nat_of_P in |- *; simpl in |- *; intro; - elim (Rlt_irrefl 1 (Rlt_trans _ _ _ H13 H12)). -apply IZR_lt; omega. -unfold Rabs in |- *; case (Rcase_abs (/ 2)); intro. -assert (Hyp : 0 < 2). -prove_sup0. -assert (H11 := Rmult_lt_compat_l 2 _ _ Hyp r); rewrite Rmult_0_r in H11; - rewrite <- Rinv_r_sym in H11; [ idtac | discrR ]. -elim (Rlt_irrefl 0 (Rlt_trans _ _ _ Rlt_0_1 H11)). -reflexivity. -apply (Rabs_pos_lt _ H0). -ring. -assert (H6 := Req_dec x0 (x0 + h)); elim H6; intro. -intro; rewrite <- H7; unfold dist, R_met in |- *; unfold R_dist in |- *; - unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; - apply Rabs_pos_lt. -unfold Rdiv in |- *; apply prod_neq_R0; - [ assumption | apply Rinv_neq_0_compat; discrR ]. -intro; apply H5. -split. -unfold D_x, no_cond in |- *. -split; trivial || assumption. -assumption. -change (0 < Rabs (f x0 / 2)) in |- *. -apply Rabs_pos_lt; unfold Rdiv in |- *; apply prod_neq_R0. -assumption. -apply Rinv_neq_0_compat; discrR. -Qed.
\ No newline at end of file +Proof. + intros; unfold continuity_pt in H; unfold continue_in in H; + unfold limit1_in in H; unfold limit_in in H; elim (H (Rabs (f x0 / 2))). + intros; elim H1; intros. + exists (mkposreal x H2). + intros; assert (H5 := H3 (x0 + h)). + cut + (dist R_met (x0 + h) x0 < x -> + dist R_met (f (x0 + h)) (f x0) < Rabs (f x0 / 2)). + unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; + replace (x0 + h - x0) with h. + intros; assert (H7 := H6 H4). + red in |- *; intro. + rewrite H8 in H7; unfold Rminus in H7; rewrite Rplus_0_l in H7; + rewrite Rabs_Ropp in H7; unfold Rdiv in H7; rewrite Rabs_mult in H7; + pattern (Rabs (f x0)) at 1 in H7; rewrite <- Rmult_1_r in H7. + cut (0 < Rabs (f x0)). + intro; assert (H10 := Rmult_lt_reg_l _ _ _ H9 H7). + cut (Rabs (/ 2) = / 2). + assert (Hyp : 0 < 2). + prove_sup0. + intro; rewrite H11 in H10; assert (H12 := Rmult_lt_compat_l 2 _ _ Hyp H10); + rewrite Rmult_1_r in H12; rewrite <- Rinv_r_sym in H12; + [ idtac | discrR ]. + cut (IZR 1 < IZR 2). + unfold IZR in |- *; unfold INR, nat_of_P in |- *; simpl in |- *; intro; + elim (Rlt_irrefl 1 (Rlt_trans _ _ _ H13 H12)). + apply IZR_lt; omega. + unfold Rabs in |- *; case (Rcase_abs (/ 2)); intro. + assert (Hyp : 0 < 2). + prove_sup0. + assert (H11 := Rmult_lt_compat_l 2 _ _ Hyp r); rewrite Rmult_0_r in H11; + rewrite <- Rinv_r_sym in H11; [ idtac | discrR ]. + elim (Rlt_irrefl 0 (Rlt_trans _ _ _ Rlt_0_1 H11)). + reflexivity. + apply (Rabs_pos_lt _ H0). + ring. + assert (H6 := Req_dec x0 (x0 + h)); elim H6; intro. + intro; rewrite <- H7; unfold dist, R_met in |- *; unfold R_dist in |- *; + unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + apply Rabs_pos_lt. + unfold Rdiv in |- *; apply prod_neq_R0; + [ assumption | apply Rinv_neq_0_compat; discrR ]. + intro; apply H5. + split. + unfold D_x, no_cond in |- *. + split; trivial || assumption. + assumption. + change (0 < Rabs (f x0 / 2)) in |- *. + apply Rabs_pos_lt; unfold Rdiv in |- *; apply prod_neq_R0. + assumption. + apply Rinv_neq_0_compat; discrR. +Qed. diff --git a/theories/Reals/Ranalysis3.v b/theories/Reals/Ranalysis3.v index 663ccb07..f50aa2ad 100644 --- a/theories/Reals/Ranalysis3.v +++ b/theories/Reals/Ranalysis3.v @@ -6,788 +6,792 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Ranalysis3.v 8670 2006-03-28 22:16:14Z herbelin $ i*) +(*i $Id: Ranalysis3.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. Require Import Ranalysis1. Require Import Ranalysis2. Open Local Scope R_scope. -(* Division *) +(** Division *) Theorem derivable_pt_lim_div : - forall (f1 f2:R -> R) (x l1 l2:R), - derivable_pt_lim f1 x l1 -> - derivable_pt_lim f2 x l2 -> - f2 x <> 0 -> - derivable_pt_lim (f1 / f2) x ((l1 * f2 x - l2 * f1 x) / Rsqr (f2 x)). -intros f1 f2 x l1 l2 H H0 H1. -cut (derivable_pt f2 x); - [ intro X | unfold derivable_pt in |- *; apply existT with l2; exact H0 ]. -assert (H2 := continuous_neq_0 _ _ (derivable_continuous_pt _ _ X) H1). -elim H2; clear H2; intros eps_f2 H2. -unfold div_fct in |- *. -assert (H3 := derivable_continuous_pt _ _ X). -unfold continuity_pt in H3; unfold continue_in in H3; unfold limit1_in in H3; - unfold limit_in in H3; unfold dist in H3. -simpl in H3; unfold R_dist in H3. -elim (H3 (Rabs (f2 x) / 2)); - [ idtac - | unfold Rdiv in |- *; change (0 < Rabs (f2 x) * / 2) in |- *; - apply Rmult_lt_0_compat; - [ apply Rabs_pos_lt; assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. -clear H3; intros alp_f2 H3. -cut - (forall x0:R, - Rabs (x0 - x) < alp_f2 -> Rabs (f2 x0 - f2 x) < Rabs (f2 x) / 2). -intro H4. -cut (forall a:R, Rabs (a - x) < alp_f2 -> Rabs (f2 x) / 2 < Rabs (f2 a)). -intro H5. -cut - (forall a:R, - Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)). -intro Maj. -unfold derivable_pt_lim in |- *; intros. -elim (H (Rabs (eps * f2 x / 8))); - [ idtac - | unfold Rdiv in |- *; change (0 < Rabs (eps * f2 x * / 8)) in |- *; - apply Rabs_pos_lt; repeat apply prod_neq_R0; - [ red in |- *; intro H7; rewrite H7 in H6; elim (Rlt_irrefl _ H6) - | assumption - | apply Rinv_neq_0_compat; discrR ] ]. -intros alp_f1d H7. -case (Req_dec (f1 x) 0); intro. -case (Req_dec l1 0); intro. + forall (f1 f2:R -> R) (x l1 l2:R), + derivable_pt_lim f1 x l1 -> + derivable_pt_lim f2 x l2 -> + f2 x <> 0 -> + derivable_pt_lim (f1 / f2) x ((l1 * f2 x - l2 * f1 x) / Rsqr (f2 x)). +Proof. + intros f1 f2 x l1 l2 H H0 H1. + cut (derivable_pt f2 x); + [ intro X | unfold derivable_pt in |- *; apply existT with l2; exact H0 ]. + assert (H2 := continuous_neq_0 _ _ (derivable_continuous_pt _ _ X) H1). + elim H2; clear H2; intros eps_f2 H2. + unfold div_fct in |- *. + assert (H3 := derivable_continuous_pt _ _ X). + unfold continuity_pt in H3; unfold continue_in in H3; unfold limit1_in in H3; + unfold limit_in in H3; unfold dist in H3. + simpl in H3; unfold R_dist in H3. + elim (H3 (Rabs (f2 x) / 2)); + [ idtac + | unfold Rdiv in |- *; change (0 < Rabs (f2 x) * / 2) in |- *; + apply Rmult_lt_0_compat; + [ apply Rabs_pos_lt; assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. + clear H3; intros alp_f2 H3. + cut + (forall x0:R, + Rabs (x0 - x) < alp_f2 -> Rabs (f2 x0 - f2 x) < Rabs (f2 x) / 2). + intro H4. + cut (forall a:R, Rabs (a - x) < alp_f2 -> Rabs (f2 x) / 2 < Rabs (f2 a)). + intro H5. + cut + (forall a:R, + Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)). + intro Maj. + unfold derivable_pt_lim in |- *; intros. + elim (H (Rabs (eps * f2 x / 8))); + [ idtac + | unfold Rdiv in |- *; change (0 < Rabs (eps * f2 x * / 8)) in |- *; + apply Rabs_pos_lt; repeat apply prod_neq_R0; + [ red in |- *; intro H7; rewrite H7 in H6; elim (Rlt_irrefl _ H6) + | assumption + | apply Rinv_neq_0_compat; discrR ] ]. + intros alp_f1d H7. + case (Req_dec (f1 x) 0); intro. + case (Req_dec l1 0); intro. (***********************************) (* Cas n° 1 *) (* (f1 x)=0 l1 =0 *) (***********************************) -cut (0 < Rmin eps_f2 (Rmin alp_f2 alp_f1d)); - [ intro - | repeat apply Rmin_pos; - [ apply (cond_pos eps_f2) - | elim H3; intros; assumption - | apply (cond_pos alp_f1d) ] ]. -exists (mkposreal (Rmin eps_f2 (Rmin alp_f2 alp_f1d)) H10). -simpl in |- *; intros. -assert (H13 := Rlt_le_trans _ _ _ H12 (Rmin_r _ _)). -assert (H14 := Rlt_le_trans _ _ _ H12 (Rmin_l _ _)). -assert (H15 := Rlt_le_trans _ _ _ H13 (Rmin_r _ _)). -assert (H16 := Rlt_le_trans _ _ _ H13 (Rmin_l _ _)). -assert (H17 := H7 _ H11 H15). -rewrite formule; [ idtac | assumption | assumption | apply H2; apply H14 ]. -apply Rle_lt_trans with - (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + - Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + - Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + - Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). -unfold Rminus in |- *. -rewrite <- - (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) - . -apply Rabs_4. -repeat rewrite Rabs_mult. -apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4). -cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). -cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). -cut - (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < - eps / 4). -cut - (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < - eps / 4). -intros. -apply Rlt_4; assumption. -rewrite H8. -unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. -rewrite Rabs_R0; rewrite Rmult_0_l. -apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. -rewrite H8. -unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. -rewrite Rabs_R0; rewrite Rmult_0_l. -apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. -rewrite H9. -unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. -rewrite Rabs_R0; rewrite Rmult_0_l. -apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. -rewrite <- Rabs_mult. -apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); - try assumption || apply H2. -apply H14. -apply Rmin_2; assumption. -right; symmetry in |- *; apply quadruple_var. + cut (0 < Rmin eps_f2 (Rmin alp_f2 alp_f1d)); + [ intro + | repeat apply Rmin_pos; + [ apply (cond_pos eps_f2) + | elim H3; intros; assumption + | apply (cond_pos alp_f1d) ] ]. + exists (mkposreal (Rmin eps_f2 (Rmin alp_f2 alp_f1d)) H10). + simpl in |- *; intros. + assert (H13 := Rlt_le_trans _ _ _ H12 (Rmin_r _ _)). + assert (H14 := Rlt_le_trans _ _ _ H12 (Rmin_l _ _)). + assert (H15 := Rlt_le_trans _ _ _ H13 (Rmin_r _ _)). + assert (H16 := Rlt_le_trans _ _ _ H13 (Rmin_l _ _)). + assert (H17 := H7 _ H11 H15). + rewrite formule; [ idtac | assumption | assumption | apply H2; apply H14 ]. + apply Rle_lt_trans with + (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + + Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + + Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + + Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). + unfold Rminus in |- *. + rewrite <- + (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) + . + apply Rabs_4. + repeat rewrite Rabs_mult. + apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4). + cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). + cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). + cut + (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < + eps / 4). + cut + (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < + eps / 4). + intros. + apply Rlt_4; assumption. + rewrite H8. + unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. + rewrite Rabs_R0; rewrite Rmult_0_l. + apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. + rewrite H8. + unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. + rewrite Rabs_R0; rewrite Rmult_0_l. + apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. + rewrite H9. + unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. + rewrite Rabs_R0; rewrite Rmult_0_l. + apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. + rewrite <- Rabs_mult. + apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); + try assumption || apply H2. + apply H14. + apply Rmin_2; assumption. + right; symmetry in |- *; apply quadruple_var. (***********************************) (* Cas n° 2 *) (* (f1 x)=0 l1<>0 *) (***********************************) -assert (H10 := derivable_continuous_pt _ _ X). -unfold continuity_pt in H10. -unfold continue_in in H10. -unfold limit1_in in H10. -unfold limit_in in H10. -unfold dist in H10. -simpl in H10. -unfold R_dist in H10. -elim (H10 (Rabs (eps * Rsqr (f2 x) / (8 * l1)))). -clear H10; intros alp_f2t2 H10. -cut - (forall a:R, - Rabs a < alp_f2t2 -> - Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (8 * l1))). -intro H11. -cut (0 < Rmin (Rmin eps_f2 alp_f1d) (Rmin alp_f2 alp_f2t2)). -intro. -exists (mkposreal (Rmin (Rmin eps_f2 alp_f1d) (Rmin alp_f2 alp_f2t2)) H12). -simpl in |- *. -intros. -assert (H15 := Rlt_le_trans _ _ _ H14 (Rmin_r _ _)). -assert (H16 := Rlt_le_trans _ _ _ H14 (Rmin_l _ _)). -assert (H17 := Rlt_le_trans _ _ _ H15 (Rmin_l _ _)). -assert (H18 := Rlt_le_trans _ _ _ H15 (Rmin_r _ _)). -assert (H19 := Rlt_le_trans _ _ _ H16 (Rmin_l _ _)). -assert (H20 := Rlt_le_trans _ _ _ H16 (Rmin_r _ _)). -clear H14 H15 H16. -rewrite formule; try assumption. -apply Rle_lt_trans with - (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + - Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + - Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + - Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). -unfold Rminus in |- *. -rewrite <- - (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) - . -apply Rabs_4. -repeat rewrite Rabs_mult. -apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4). -cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). -cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). -cut - (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < - eps / 4). -cut - (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < - eps / 4). -intros. -apply Rlt_4; assumption. -rewrite H8. -unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. -rewrite Rabs_R0; rewrite Rmult_0_l. -apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. -rewrite H8. -unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. -rewrite Rabs_R0; rewrite Rmult_0_l. -apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. -rewrite <- Rabs_mult. -apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); try assumption. -apply H2; assumption. -apply Rmin_2; assumption. -rewrite <- Rabs_mult. -apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption. -apply H2; assumption. -apply Rmin_2; assumption. -right; symmetry in |- *; apply quadruple_var. -apply H2; assumption. -repeat apply Rmin_pos. -apply (cond_pos eps_f2). -apply (cond_pos alp_f1d). -elim H3; intros; assumption. -elim H10; intros; assumption. -intros. -elim H10; intros. -case (Req_dec a 0); intro. -rewrite H14; rewrite Rplus_0_r. -unfold Rminus in |- *; rewrite Rplus_opp_r. -rewrite Rabs_R0. -apply Rabs_pos_lt. -unfold Rdiv, Rsqr in |- *; repeat rewrite Rmult_assoc. -repeat apply prod_neq_R0; try assumption. -red in |- *; intro; rewrite H15 in H6; elim (Rlt_irrefl _ H6). -apply Rinv_neq_0_compat; repeat apply prod_neq_R0; discrR || assumption. -apply H13. -split. -apply D_x_no_cond; assumption. -replace (x + a - x) with a; [ assumption | ring ]. -change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))) in |- *. -apply Rabs_pos_lt; unfold Rdiv, Rsqr in |- *; repeat rewrite Rmult_assoc; - repeat apply prod_neq_R0. -red in |- *; intro; rewrite H11 in H6; elim (Rlt_irrefl _ H6). -assumption. -assumption. -apply Rinv_neq_0_compat; repeat apply prod_neq_R0; - [ discrR | discrR | discrR | assumption ]. + assert (H10 := derivable_continuous_pt _ _ X). + unfold continuity_pt in H10. + unfold continue_in in H10. + unfold limit1_in in H10. + unfold limit_in in H10. + unfold dist in H10. + simpl in H10. + unfold R_dist in H10. + elim (H10 (Rabs (eps * Rsqr (f2 x) / (8 * l1)))). + clear H10; intros alp_f2t2 H10. + cut + (forall a:R, + Rabs a < alp_f2t2 -> + Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (8 * l1))). + intro H11. + cut (0 < Rmin (Rmin eps_f2 alp_f1d) (Rmin alp_f2 alp_f2t2)). + intro. + exists (mkposreal (Rmin (Rmin eps_f2 alp_f1d) (Rmin alp_f2 alp_f2t2)) H12). + simpl in |- *. + intros. + assert (H15 := Rlt_le_trans _ _ _ H14 (Rmin_r _ _)). + assert (H16 := Rlt_le_trans _ _ _ H14 (Rmin_l _ _)). + assert (H17 := Rlt_le_trans _ _ _ H15 (Rmin_l _ _)). + assert (H18 := Rlt_le_trans _ _ _ H15 (Rmin_r _ _)). + assert (H19 := Rlt_le_trans _ _ _ H16 (Rmin_l _ _)). + assert (H20 := Rlt_le_trans _ _ _ H16 (Rmin_r _ _)). + clear H14 H15 H16. + rewrite formule; try assumption. + apply Rle_lt_trans with + (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + + Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + + Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + + Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). + unfold Rminus in |- *. + rewrite <- + (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) + . + apply Rabs_4. + repeat rewrite Rabs_mult. + apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4). + cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). + cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). + cut + (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < + eps / 4). + cut + (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < + eps / 4). + intros. + apply Rlt_4; assumption. + rewrite H8. + unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. + rewrite Rabs_R0; rewrite Rmult_0_l. + apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. + rewrite H8. + unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. + rewrite Rabs_R0; rewrite Rmult_0_l. + apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. + rewrite <- Rabs_mult. + apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); try assumption. + apply H2; assumption. + apply Rmin_2; assumption. + rewrite <- Rabs_mult. + apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption. + apply H2; assumption. + apply Rmin_2; assumption. + right; symmetry in |- *; apply quadruple_var. + apply H2; assumption. + repeat apply Rmin_pos. + apply (cond_pos eps_f2). + apply (cond_pos alp_f1d). + elim H3; intros; assumption. + elim H10; intros; assumption. + intros. + elim H10; intros. + case (Req_dec a 0); intro. + rewrite H14; rewrite Rplus_0_r. + unfold Rminus in |- *; rewrite Rplus_opp_r. + rewrite Rabs_R0. + apply Rabs_pos_lt. + unfold Rdiv, Rsqr in |- *; repeat rewrite Rmult_assoc. + repeat apply prod_neq_R0; try assumption. + red in |- *; intro; rewrite H15 in H6; elim (Rlt_irrefl _ H6). + apply Rinv_neq_0_compat; repeat apply prod_neq_R0; discrR || assumption. + apply H13. + split. + apply D_x_no_cond; assumption. + replace (x + a - x) with a; [ assumption | ring ]. + change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))) in |- *. + apply Rabs_pos_lt; unfold Rdiv, Rsqr in |- *; repeat rewrite Rmult_assoc; + repeat apply prod_neq_R0. + red in |- *; intro; rewrite H11 in H6; elim (Rlt_irrefl _ H6). + assumption. + assumption. + apply Rinv_neq_0_compat; repeat apply prod_neq_R0; + [ discrR | discrR | discrR | assumption ]. (***********************************) (* Cas n° 3 *) (* (f1 x)<>0 l1=0 l2=0 *) (***********************************) -case (Req_dec l1 0); intro. -case (Req_dec l2 0); intro. -elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x)))); - [ idtac - | apply Rabs_pos_lt; unfold Rdiv, Rsqr in |- *; repeat rewrite Rmult_assoc; - repeat apply prod_neq_R0; - [ assumption - | assumption - | red in |- *; intro; rewrite H11 in H6; elim (Rlt_irrefl _ H6) - | apply Rinv_neq_0_compat; repeat apply prod_neq_R0; discrR || assumption ] ]. -intros alp_f2d H12. -cut (0 < Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)). -intro. -exists (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) H11). -simpl in |- *. -intros. -assert (H15 := Rlt_le_trans _ _ _ H14 (Rmin_l _ _)). -assert (H16 := Rlt_le_trans _ _ _ H14 (Rmin_r _ _)). -assert (H17 := Rlt_le_trans _ _ _ H15 (Rmin_l _ _)). -assert (H18 := Rlt_le_trans _ _ _ H15 (Rmin_r _ _)). -assert (H19 := Rlt_le_trans _ _ _ H16 (Rmin_l _ _)). -assert (H20 := Rlt_le_trans _ _ _ H16 (Rmin_r _ _)). -clear H15 H16. -rewrite formule; try assumption. -apply Rle_lt_trans with - (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + - Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + - Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + - Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). -unfold Rminus in |- *. -rewrite <- - (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) - . -apply Rabs_4. -repeat rewrite Rabs_mult. -apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4). -cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). -cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). -cut - (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < - eps / 4). -cut - (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < - eps / 4). -intros. -apply Rlt_4; assumption. -rewrite H10. -unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. -rewrite Rabs_R0; rewrite Rmult_0_l. -apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. -rewrite <- Rabs_mult. -apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption. -apply H2; assumption. -apply Rmin_2; assumption. -rewrite H9. -unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. -rewrite Rabs_R0; rewrite Rmult_0_l. -apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. -rewrite <- Rabs_mult. -apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); assumption || idtac. -apply H2; assumption. -apply Rmin_2; assumption. -right; symmetry in |- *; apply quadruple_var. -apply H2; assumption. -repeat apply Rmin_pos. -apply (cond_pos eps_f2). -elim H3; intros; assumption. -apply (cond_pos alp_f1d). -apply (cond_pos alp_f2d). + case (Req_dec l1 0); intro. + case (Req_dec l2 0); intro. + elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x)))); + [ idtac + | apply Rabs_pos_lt; unfold Rdiv, Rsqr in |- *; repeat rewrite Rmult_assoc; + repeat apply prod_neq_R0; + [ assumption + | assumption + | red in |- *; intro; rewrite H11 in H6; elim (Rlt_irrefl _ H6) + | apply Rinv_neq_0_compat; repeat apply prod_neq_R0; discrR || assumption ] ]. + intros alp_f2d H12. + cut (0 < Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)). + intro. + exists (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) H11). + simpl in |- *. + intros. + assert (H15 := Rlt_le_trans _ _ _ H14 (Rmin_l _ _)). + assert (H16 := Rlt_le_trans _ _ _ H14 (Rmin_r _ _)). + assert (H17 := Rlt_le_trans _ _ _ H15 (Rmin_l _ _)). + assert (H18 := Rlt_le_trans _ _ _ H15 (Rmin_r _ _)). + assert (H19 := Rlt_le_trans _ _ _ H16 (Rmin_l _ _)). + assert (H20 := Rlt_le_trans _ _ _ H16 (Rmin_r _ _)). + clear H15 H16. + rewrite formule; try assumption. + apply Rle_lt_trans with + (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + + Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + + Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + + Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). + unfold Rminus in |- *. + rewrite <- + (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) + . + apply Rabs_4. + repeat rewrite Rabs_mult. + apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4). + cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). + cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). + cut + (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < + eps / 4). + cut + (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < + eps / 4). + intros. + apply Rlt_4; assumption. + rewrite H10. + unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. + rewrite Rabs_R0; rewrite Rmult_0_l. + apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. + rewrite <- Rabs_mult. + apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption. + apply H2; assumption. + apply Rmin_2; assumption. + rewrite H9. + unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. + rewrite Rabs_R0; rewrite Rmult_0_l. + apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. + rewrite <- Rabs_mult. + apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); assumption || idtac. + apply H2; assumption. + apply Rmin_2; assumption. + right; symmetry in |- *; apply quadruple_var. + apply H2; assumption. + repeat apply Rmin_pos. + apply (cond_pos eps_f2). + elim H3; intros; assumption. + apply (cond_pos alp_f1d). + apply (cond_pos alp_f2d). (***********************************) (* Cas n° 4 *) (* (f1 x)<>0 l1=0 l2<>0 *) (***********************************) -elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x)))); - [ idtac - | apply Rabs_pos_lt; unfold Rsqr, Rdiv in |- *; - repeat rewrite Rinv_mult_distr; repeat apply prod_neq_R0; - try assumption || discrR ]. -intros alp_f2d H11. -assert (H12 := derivable_continuous_pt _ _ X). -unfold continuity_pt in H12. -unfold continue_in in H12. -unfold limit1_in in H12. -unfold limit_in in H12. -unfold dist in H12. -simpl in H12. -unfold R_dist in H12. -elim (H12 (Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2)))). -intros alp_f2c H13. -cut (0 < Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2c))). -intro. -exists - (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2c))) - H14). -simpl in |- *; intros. -assert (H17 := Rlt_le_trans _ _ _ H16 (Rmin_l _ _)). -assert (H18 := Rlt_le_trans _ _ _ H16 (Rmin_r _ _)). -assert (H19 := Rlt_le_trans _ _ _ H18 (Rmin_r _ _)). -assert (H20 := Rlt_le_trans _ _ _ H19 (Rmin_l _ _)). -assert (H21 := Rlt_le_trans _ _ _ H19 (Rmin_r _ _)). -assert (H22 := Rlt_le_trans _ _ _ H18 (Rmin_l _ _)). -assert (H23 := Rlt_le_trans _ _ _ H17 (Rmin_l _ _)). -assert (H24 := Rlt_le_trans _ _ _ H17 (Rmin_r _ _)). -clear H16 H17 H18 H19. -cut - (forall a:R, - Rabs a < alp_f2c -> - Rabs (f2 (x + a) - f2 x) < - Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))). -intro. -rewrite formule; try assumption. -apply Rle_lt_trans with - (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + - Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + - Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + - Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). -unfold Rminus in |- *. -rewrite <- - (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) - . -apply Rabs_4. -repeat rewrite Rabs_mult. -apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4). -cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). -cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). -cut - (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < - eps / 4). -cut - (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < - eps / 4). -intros. -apply Rlt_4; assumption. -rewrite <- Rabs_mult. -apply (maj_term4 x h eps l2 alp_f2 alp_f2c eps_f2 f1 f2); try assumption. -apply H2; assumption. -apply Rmin_2; assumption. -rewrite <- Rabs_mult. -apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption. -apply H2; assumption. -apply Rmin_2; assumption. -rewrite H9. -unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. -rewrite Rabs_R0; rewrite Rmult_0_l. -apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. -rewrite <- Rabs_mult. -apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption. -apply H2; assumption. -apply Rmin_2; assumption. -right; symmetry in |- *; apply quadruple_var. -apply H2; assumption. -intros. -case (Req_dec a 0); intro. -rewrite H17; rewrite Rplus_0_r. -unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0. -apply Rabs_pos_lt. -unfold Rdiv, Rsqr in |- *. -repeat rewrite Rinv_mult_distr; try assumption. -repeat apply prod_neq_R0; try assumption. -red in |- *; intro H18; rewrite H18 in H6; elim (Rlt_irrefl _ H6). -apply Rinv_neq_0_compat; discrR. -apply Rinv_neq_0_compat; discrR. -apply Rinv_neq_0_compat; discrR. -apply Rinv_neq_0_compat; assumption. -apply Rinv_neq_0_compat; assumption. -discrR. -discrR. -discrR. -discrR. -discrR. -apply prod_neq_R0; [ discrR | assumption ]. -elim H13; intros. -apply H19. -split. -apply D_x_no_cond; assumption. -replace (x + a - x) with a; [ assumption | ring ]. -repeat apply Rmin_pos. -apply (cond_pos eps_f2). -elim H3; intros; assumption. -apply (cond_pos alp_f1d). -apply (cond_pos alp_f2d). -elim H13; intros; assumption. -change (0 < Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))) in |- *. -apply Rabs_pos_lt. -unfold Rsqr, Rdiv in |- *. -repeat rewrite Rinv_mult_distr; try assumption || discrR. -repeat apply prod_neq_R0; try assumption. -red in |- *; intro H13; rewrite H13 in H6; elim (Rlt_irrefl _ H6). -apply Rinv_neq_0_compat; discrR. -apply Rinv_neq_0_compat; discrR. -apply Rinv_neq_0_compat; discrR. -apply Rinv_neq_0_compat; assumption. -apply Rinv_neq_0_compat; assumption. -apply prod_neq_R0; [ discrR | assumption ]. -red in |- *; intro H11; rewrite H11 in H6; elim (Rlt_irrefl _ H6). -apply Rinv_neq_0_compat; discrR. -apply Rinv_neq_0_compat; discrR. -apply Rinv_neq_0_compat; discrR. -apply Rinv_neq_0_compat; assumption. + elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x)))); + [ idtac + | apply Rabs_pos_lt; unfold Rsqr, Rdiv in |- *; + repeat rewrite Rinv_mult_distr; repeat apply prod_neq_R0; + try assumption || discrR ]. + intros alp_f2d H11. + assert (H12 := derivable_continuous_pt _ _ X). + unfold continuity_pt in H12. + unfold continue_in in H12. + unfold limit1_in in H12. + unfold limit_in in H12. + unfold dist in H12. + simpl in H12. + unfold R_dist in H12. + elim (H12 (Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2)))). + intros alp_f2c H13. + cut (0 < Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2c))). + intro. + exists + (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2c))) + H14). + simpl in |- *; intros. + assert (H17 := Rlt_le_trans _ _ _ H16 (Rmin_l _ _)). + assert (H18 := Rlt_le_trans _ _ _ H16 (Rmin_r _ _)). + assert (H19 := Rlt_le_trans _ _ _ H18 (Rmin_r _ _)). + assert (H20 := Rlt_le_trans _ _ _ H19 (Rmin_l _ _)). + assert (H21 := Rlt_le_trans _ _ _ H19 (Rmin_r _ _)). + assert (H22 := Rlt_le_trans _ _ _ H18 (Rmin_l _ _)). + assert (H23 := Rlt_le_trans _ _ _ H17 (Rmin_l _ _)). + assert (H24 := Rlt_le_trans _ _ _ H17 (Rmin_r _ _)). + clear H16 H17 H18 H19. + cut + (forall a:R, + Rabs a < alp_f2c -> + Rabs (f2 (x + a) - f2 x) < + Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))). + intro. + rewrite formule; try assumption. + apply Rle_lt_trans with + (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + + Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + + Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + + Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). + unfold Rminus in |- *. + rewrite <- + (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) + . + apply Rabs_4. + repeat rewrite Rabs_mult. + apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4). + cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). + cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). + cut + (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < + eps / 4). + cut + (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < + eps / 4). + intros. + apply Rlt_4; assumption. + rewrite <- Rabs_mult. + apply (maj_term4 x h eps l2 alp_f2 alp_f2c eps_f2 f1 f2); try assumption. + apply H2; assumption. + apply Rmin_2; assumption. + rewrite <- Rabs_mult. + apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption. + apply H2; assumption. + apply Rmin_2; assumption. + rewrite H9. + unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. + rewrite Rabs_R0; rewrite Rmult_0_l. + apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. + rewrite <- Rabs_mult. + apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption. + apply H2; assumption. + apply Rmin_2; assumption. + right; symmetry in |- *; apply quadruple_var. + apply H2; assumption. + intros. + case (Req_dec a 0); intro. + rewrite H17; rewrite Rplus_0_r. + unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0. + apply Rabs_pos_lt. + unfold Rdiv, Rsqr in |- *. + repeat rewrite Rinv_mult_distr; try assumption. + repeat apply prod_neq_R0; try assumption. + red in |- *; intro H18; rewrite H18 in H6; elim (Rlt_irrefl _ H6). + apply Rinv_neq_0_compat; discrR. + apply Rinv_neq_0_compat; discrR. + apply Rinv_neq_0_compat; discrR. + apply Rinv_neq_0_compat; assumption. + apply Rinv_neq_0_compat; assumption. + discrR. + discrR. + discrR. + discrR. + discrR. + apply prod_neq_R0; [ discrR | assumption ]. + elim H13; intros. + apply H19. + split. + apply D_x_no_cond; assumption. + replace (x + a - x) with a; [ assumption | ring ]. + repeat apply Rmin_pos. + apply (cond_pos eps_f2). + elim H3; intros; assumption. + apply (cond_pos alp_f1d). + apply (cond_pos alp_f2d). + elim H13; intros; assumption. + change (0 < Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))) in |- *. + apply Rabs_pos_lt. + unfold Rsqr, Rdiv in |- *. + repeat rewrite Rinv_mult_distr; try assumption || discrR. + repeat apply prod_neq_R0; try assumption. + red in |- *; intro H13; rewrite H13 in H6; elim (Rlt_irrefl _ H6). + apply Rinv_neq_0_compat; discrR. + apply Rinv_neq_0_compat; discrR. + apply Rinv_neq_0_compat; discrR. + apply Rinv_neq_0_compat; assumption. + apply Rinv_neq_0_compat; assumption. + apply prod_neq_R0; [ discrR | assumption ]. + red in |- *; intro H11; rewrite H11 in H6; elim (Rlt_irrefl _ H6). + apply Rinv_neq_0_compat; discrR. + apply Rinv_neq_0_compat; discrR. + apply Rinv_neq_0_compat; discrR. + apply Rinv_neq_0_compat; assumption. (***********************************) (* Cas n° 5 *) (* (f1 x)<>0 l1<>0 l2=0 *) (***********************************) -case (Req_dec l2 0); intro. -assert (H11 := derivable_continuous_pt _ _ X). -unfold continuity_pt in H11. -unfold continue_in in H11. -unfold limit1_in in H11. -unfold limit_in in H11. -unfold dist in H11. -simpl in H11. -unfold R_dist in H11. -elim (H11 (Rabs (eps * Rsqr (f2 x) / (8 * l1)))). -clear H11; intros alp_f2t2 H11. -elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x)))). -intros alp_f2d H12. -cut (0 < Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2t2))). -intro. -exists - (mkposreal - (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2t2))) H13). -simpl in |- *. -intros. -cut - (forall a:R, - Rabs a < alp_f2t2 -> - Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (8 * l1))). -intro. -assert (H17 := Rlt_le_trans _ _ _ H15 (Rmin_l _ _)). -assert (H18 := Rlt_le_trans _ _ _ H15 (Rmin_r _ _)). -assert (H19 := Rlt_le_trans _ _ _ H17 (Rmin_r _ _)). -assert (H20 := Rlt_le_trans _ _ _ H17 (Rmin_l _ _)). -assert (H21 := Rlt_le_trans _ _ _ H18 (Rmin_r _ _)). -assert (H22 := Rlt_le_trans _ _ _ H18 (Rmin_l _ _)). -assert (H23 := Rlt_le_trans _ _ _ H21 (Rmin_l _ _)). -assert (H24 := Rlt_le_trans _ _ _ H21 (Rmin_r _ _)). -clear H15 H17 H18 H21. -rewrite formule; try assumption. -apply Rle_lt_trans with - (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + - Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + - Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + - Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). -unfold Rminus in |- *. -rewrite <- - (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) - . -apply Rabs_4. -repeat rewrite Rabs_mult. -apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4). -cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). -cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). -cut - (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < - eps / 4). -cut - (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < - eps / 4). -intros. -apply Rlt_4; assumption. -rewrite H10. -unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. -rewrite Rabs_R0; rewrite Rmult_0_l. -apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. -rewrite <- Rabs_mult. -apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption. -apply H2; assumption. -apply Rmin_2; assumption. -rewrite <- Rabs_mult. -apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); try assumption. -apply H2; assumption. -apply Rmin_2; assumption. -rewrite <- Rabs_mult. -apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption. -apply H2; assumption. -apply Rmin_2; assumption. -right; symmetry in |- *; apply quadruple_var. -apply H2; assumption. -intros. -case (Req_dec a 0); intro. -rewrite H17; rewrite Rplus_0_r; unfold Rminus in |- *; rewrite Rplus_opp_r; - rewrite Rabs_R0. -apply Rabs_pos_lt. -unfold Rdiv in |- *; rewrite Rinv_mult_distr; try discrR || assumption. -unfold Rsqr in |- *. -repeat apply prod_neq_R0; - assumption || - (apply Rinv_neq_0_compat; assumption) || - (apply Rinv_neq_0_compat; discrR) || - (red in |- *; intro H18; rewrite H18 in H6; elim (Rlt_irrefl _ H6)). -elim H11; intros. -apply H19. -split. -apply D_x_no_cond; assumption. -replace (x + a - x) with a; [ assumption | ring ]. -repeat apply Rmin_pos. -apply (cond_pos eps_f2). -elim H3; intros; assumption. -apply (cond_pos alp_f1d). -apply (cond_pos alp_f2d). -elim H11; intros; assumption. -apply Rabs_pos_lt. -unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; try discrR || assumption. -repeat apply prod_neq_R0; - assumption || - (apply Rinv_neq_0_compat; assumption) || - (apply Rinv_neq_0_compat; discrR) || - (red in |- *; intro H12; rewrite H12 in H6; elim (Rlt_irrefl _ H6)). -change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))) in |- *. -apply Rabs_pos_lt. -unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; try discrR || assumption. -repeat apply prod_neq_R0; - assumption || - (apply Rinv_neq_0_compat; assumption) || - (apply Rinv_neq_0_compat; discrR) || - (red in |- *; intro H12; rewrite H12 in H6; elim (Rlt_irrefl _ H6)). + case (Req_dec l2 0); intro. + assert (H11 := derivable_continuous_pt _ _ X). + unfold continuity_pt in H11. + unfold continue_in in H11. + unfold limit1_in in H11. + unfold limit_in in H11. + unfold dist in H11. + simpl in H11. + unfold R_dist in H11. + elim (H11 (Rabs (eps * Rsqr (f2 x) / (8 * l1)))). + clear H11; intros alp_f2t2 H11. + elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x)))). + intros alp_f2d H12. + cut (0 < Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2t2))). + intro. + exists + (mkposreal + (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2t2))) H13). + simpl in |- *. + intros. + cut + (forall a:R, + Rabs a < alp_f2t2 -> + Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (8 * l1))). + intro. + assert (H17 := Rlt_le_trans _ _ _ H15 (Rmin_l _ _)). + assert (H18 := Rlt_le_trans _ _ _ H15 (Rmin_r _ _)). + assert (H19 := Rlt_le_trans _ _ _ H17 (Rmin_r _ _)). + assert (H20 := Rlt_le_trans _ _ _ H17 (Rmin_l _ _)). + assert (H21 := Rlt_le_trans _ _ _ H18 (Rmin_r _ _)). + assert (H22 := Rlt_le_trans _ _ _ H18 (Rmin_l _ _)). + assert (H23 := Rlt_le_trans _ _ _ H21 (Rmin_l _ _)). + assert (H24 := Rlt_le_trans _ _ _ H21 (Rmin_r _ _)). + clear H15 H17 H18 H21. + rewrite formule; try assumption. + apply Rle_lt_trans with + (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + + Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + + Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + + Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). + unfold Rminus in |- *. + rewrite <- + (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) + . + apply Rabs_4. + repeat rewrite Rabs_mult. + apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4). + cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). + cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). + cut + (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < + eps / 4). + cut + (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < + eps / 4). + intros. + apply Rlt_4; assumption. + rewrite H10. + unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. + rewrite Rabs_R0; rewrite Rmult_0_l. + apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. + rewrite <- Rabs_mult. + apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption. + apply H2; assumption. + apply Rmin_2; assumption. + rewrite <- Rabs_mult. + apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); try assumption. + apply H2; assumption. + apply Rmin_2; assumption. + rewrite <- Rabs_mult. + apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption. + apply H2; assumption. + apply Rmin_2; assumption. + right; symmetry in |- *; apply quadruple_var. + apply H2; assumption. + intros. + case (Req_dec a 0); intro. + rewrite H17; rewrite Rplus_0_r; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0. + apply Rabs_pos_lt. + unfold Rdiv in |- *; rewrite Rinv_mult_distr; try discrR || assumption. + unfold Rsqr in |- *. + repeat apply prod_neq_R0; + assumption || + (apply Rinv_neq_0_compat; assumption) || + (apply Rinv_neq_0_compat; discrR) || + (red in |- *; intro H18; rewrite H18 in H6; elim (Rlt_irrefl _ H6)). + elim H11; intros. + apply H19. + split. + apply D_x_no_cond; assumption. + replace (x + a - x) with a; [ assumption | ring ]. + repeat apply Rmin_pos. + apply (cond_pos eps_f2). + elim H3; intros; assumption. + apply (cond_pos alp_f1d). + apply (cond_pos alp_f2d). + elim H11; intros; assumption. + apply Rabs_pos_lt. + unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; try discrR || assumption. + repeat apply prod_neq_R0; + assumption || + (apply Rinv_neq_0_compat; assumption) || + (apply Rinv_neq_0_compat; discrR) || + (red in |- *; intro H12; rewrite H12 in H6; elim (Rlt_irrefl _ H6)). + change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))) in |- *. + apply Rabs_pos_lt. + unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; try discrR || assumption. + repeat apply prod_neq_R0; + assumption || + (apply Rinv_neq_0_compat; assumption) || + (apply Rinv_neq_0_compat; discrR) || + (red in |- *; intro H12; rewrite H12 in H6; elim (Rlt_irrefl _ H6)). (***********************************) (* Cas n° 6 *) (* (f1 x)<>0 l1<>0 l2<>0 *) (***********************************) -elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x)))). -intros alp_f2d H11. -assert (H12 := derivable_continuous_pt _ _ X). -unfold continuity_pt in H12. -unfold continue_in in H12. -unfold limit1_in in H12. -unfold limit_in in H12. -unfold dist in H12. -simpl in H12. -unfold R_dist in H12. -elim (H12 (Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2)))). -intros alp_f2c H13. -elim (H12 (Rabs (eps * Rsqr (f2 x) / (8 * l1)))). -intros alp_f2t2 H14. -cut - (0 < - Rmin (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) - (Rmin alp_f2c alp_f2t2)). -intro. -exists - (mkposreal - (Rmin (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) - (Rmin alp_f2c alp_f2t2)) H15). -simpl in |- *. -intros. -assert (H18 := Rlt_le_trans _ _ _ H17 (Rmin_l _ _)). -assert (H19 := Rlt_le_trans _ _ _ H17 (Rmin_r _ _)). -assert (H20 := Rlt_le_trans _ _ _ H18 (Rmin_l _ _)). -assert (H21 := Rlt_le_trans _ _ _ H18 (Rmin_r _ _)). -assert (H22 := Rlt_le_trans _ _ _ H19 (Rmin_l _ _)). -assert (H23 := Rlt_le_trans _ _ _ H19 (Rmin_r _ _)). -assert (H24 := Rlt_le_trans _ _ _ H20 (Rmin_l _ _)). -assert (H25 := Rlt_le_trans _ _ _ H20 (Rmin_r _ _)). -assert (H26 := Rlt_le_trans _ _ _ H21 (Rmin_l _ _)). -assert (H27 := Rlt_le_trans _ _ _ H21 (Rmin_r _ _)). -clear H17 H18 H19 H20 H21. -cut - (forall a:R, - Rabs a < alp_f2t2 -> - Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (8 * l1))). -cut - (forall a:R, - Rabs a < alp_f2c -> - Rabs (f2 (x + a) - f2 x) < - Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))). -intros. -rewrite formule; try assumption. -apply Rle_lt_trans with - (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + - Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + - Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + - Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). -unfold Rminus in |- *. -rewrite <- - (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) - . -apply Rabs_4. -repeat rewrite Rabs_mult. -apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4). -cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). -cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). -cut - (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < - eps / 4). -cut - (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < - eps / 4). -intros. -apply Rlt_4; assumption. -rewrite <- Rabs_mult. -apply (maj_term4 x h eps l2 alp_f2 alp_f2c eps_f2 f1 f2); try assumption. -apply H2; assumption. -apply Rmin_2; assumption. -rewrite <- Rabs_mult. -apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption. -apply H2; assumption. -apply Rmin_2; assumption. -rewrite <- Rabs_mult. -apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); try assumption. -apply H2; assumption. -apply Rmin_2; assumption. -rewrite <- Rabs_mult. -apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption. -apply H2; assumption. -apply Rmin_2; assumption. -right; symmetry in |- *; apply quadruple_var. -apply H2; assumption. -intros. -case (Req_dec a 0); intro. -rewrite H18; rewrite Rplus_0_r; unfold Rminus in |- *; rewrite Rplus_opp_r; - rewrite Rabs_R0; apply Rabs_pos_lt. -unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr. -repeat apply prod_neq_R0; - assumption || - (apply Rinv_neq_0_compat; assumption) || - (apply Rinv_neq_0_compat; discrR) || - (red in |- *; intro H28; rewrite H28 in H6; elim (Rlt_irrefl _ H6)). -apply prod_neq_R0; [ discrR | assumption ]. -apply prod_neq_R0; [ discrR | assumption ]. -assumption. -elim H13; intros. -apply H20. -split. -apply D_x_no_cond; assumption. -replace (x + a - x) with a; [ assumption | ring ]. -intros. -case (Req_dec a 0); intro. -rewrite H18; rewrite Rplus_0_r; unfold Rminus in |- *; rewrite Rplus_opp_r; - rewrite Rabs_R0; apply Rabs_pos_lt. -unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr. -repeat apply prod_neq_R0; - assumption || - (apply Rinv_neq_0_compat; assumption) || - (apply Rinv_neq_0_compat; discrR) || - (red in |- *; intro H28; rewrite H28 in H6; elim (Rlt_irrefl _ H6)). -discrR. -assumption. -elim H14; intros. -apply H20. -split. -unfold D_x, no_cond in |- *; split. -trivial. -apply Rminus_not_eq_right. -replace (x + a - x) with a; [ assumption | ring ]. -replace (x + a - x) with a; [ assumption | ring ]. -repeat apply Rmin_pos. -apply (cond_pos eps_f2). -elim H3; intros; assumption. -apply (cond_pos alp_f1d). -apply (cond_pos alp_f2d). -elim H13; intros; assumption. -elim H14; intros; assumption. -change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))) in |- *; apply Rabs_pos_lt. -unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; try discrR || assumption. -repeat apply prod_neq_R0; - assumption || - (apply Rinv_neq_0_compat; assumption) || - (apply Rinv_neq_0_compat; discrR) || - (red in |- *; intro H14; rewrite H14 in H6; elim (Rlt_irrefl _ H6)). -change (0 < Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))) in |- *; - apply Rabs_pos_lt. -unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr. -repeat apply prod_neq_R0; - assumption || - (apply Rinv_neq_0_compat; assumption) || - (apply Rinv_neq_0_compat; discrR) || - (red in |- *; intro H13; rewrite H13 in H6; elim (Rlt_irrefl _ H6)). -apply prod_neq_R0; [ discrR | assumption ]. -apply prod_neq_R0; [ discrR | assumption ]. -assumption. -apply Rabs_pos_lt. -unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; - [ idtac | discrR | assumption ]. -repeat apply prod_neq_R0; - assumption || - (apply Rinv_neq_0_compat; assumption) || - (apply Rinv_neq_0_compat; discrR) || - (red in |- *; intro H11; rewrite H11 in H6; elim (Rlt_irrefl _ H6)). -intros. -unfold Rdiv in |- *. -apply Rmult_lt_reg_l with (Rabs (f2 (x + a))). -apply Rabs_pos_lt; apply H2. -apply Rlt_le_trans with (Rmin eps_f2 alp_f2). -assumption. -apply Rmin_l. -rewrite <- Rinv_r_sym. -apply Rmult_lt_reg_l with (Rabs (f2 x)). -apply Rabs_pos_lt; assumption. -rewrite Rmult_1_r. -rewrite (Rmult_comm (Rabs (f2 x))). -repeat rewrite Rmult_assoc. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_r. -apply Rmult_lt_reg_l with (/ 2). -apply Rinv_0_lt_compat; prove_sup0. -repeat rewrite (Rmult_comm (/ 2)). -repeat rewrite Rmult_assoc. -rewrite <- Rinv_r_sym. -rewrite Rmult_1_r. -unfold Rdiv in H5; apply H5. -replace (x + a - x) with a. -assert (H7 := Rlt_le_trans _ _ _ H6 (Rmin_r _ _)); assumption. -ring. -discrR. -apply Rabs_no_R0; assumption. -apply Rabs_no_R0; apply H2. -assert (H7 := Rlt_le_trans _ _ _ H6 (Rmin_l _ _)); assumption. -intros. -assert (H6 := H4 a H5). -rewrite <- (Rabs_Ropp (f2 a - f2 x)) in H6. -rewrite Ropp_minus_distr in H6. -assert (H7 := Rle_lt_trans _ _ _ (Rabs_triang_inv _ _) H6). -apply Rplus_lt_reg_r with (- Rabs (f2 a) + Rabs (f2 x) / 2). -rewrite Rplus_assoc. -rewrite <- double_var. -do 2 rewrite (Rplus_comm (- Rabs (f2 a))). -rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r. -unfold Rminus in H7; assumption. -intros. -case (Req_dec x x0); intro. -rewrite <- H5; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; - unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ apply Rabs_pos_lt; assumption | apply Rinv_0_lt_compat; prove_sup0 ]. -elim H3; intros. -apply H7. -split. -unfold D_x, no_cond in |- *; split. -trivial. -assumption. -assumption. + elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x)))). + intros alp_f2d H11. + assert (H12 := derivable_continuous_pt _ _ X). + unfold continuity_pt in H12. + unfold continue_in in H12. + unfold limit1_in in H12. + unfold limit_in in H12. + unfold dist in H12. + simpl in H12. + unfold R_dist in H12. + elim (H12 (Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2)))). + intros alp_f2c H13. + elim (H12 (Rabs (eps * Rsqr (f2 x) / (8 * l1)))). + intros alp_f2t2 H14. + cut + (0 < + Rmin (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) + (Rmin alp_f2c alp_f2t2)). + intro. + exists + (mkposreal + (Rmin (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) + (Rmin alp_f2c alp_f2t2)) H15). + simpl in |- *. + intros. + assert (H18 := Rlt_le_trans _ _ _ H17 (Rmin_l _ _)). + assert (H19 := Rlt_le_trans _ _ _ H17 (Rmin_r _ _)). + assert (H20 := Rlt_le_trans _ _ _ H18 (Rmin_l _ _)). + assert (H21 := Rlt_le_trans _ _ _ H18 (Rmin_r _ _)). + assert (H22 := Rlt_le_trans _ _ _ H19 (Rmin_l _ _)). + assert (H23 := Rlt_le_trans _ _ _ H19 (Rmin_r _ _)). + assert (H24 := Rlt_le_trans _ _ _ H20 (Rmin_l _ _)). + assert (H25 := Rlt_le_trans _ _ _ H20 (Rmin_r _ _)). + assert (H26 := Rlt_le_trans _ _ _ H21 (Rmin_l _ _)). + assert (H27 := Rlt_le_trans _ _ _ H21 (Rmin_r _ _)). + clear H17 H18 H19 H20 H21. + cut + (forall a:R, + Rabs a < alp_f2t2 -> + Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (8 * l1))). + cut + (forall a:R, + Rabs a < alp_f2c -> + Rabs (f2 (x + a) - f2 x) < + Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))). + intros. + rewrite formule; try assumption. + apply Rle_lt_trans with + (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + + Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + + Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + + Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). + unfold Rminus in |- *. + rewrite <- + (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) + . + apply Rabs_4. + repeat rewrite Rabs_mult. + apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4). + cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). + cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). + cut + (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < + eps / 4). + cut + (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < + eps / 4). + intros. + apply Rlt_4; assumption. + rewrite <- Rabs_mult. + apply (maj_term4 x h eps l2 alp_f2 alp_f2c eps_f2 f1 f2); try assumption. + apply H2; assumption. + apply Rmin_2; assumption. + rewrite <- Rabs_mult. + apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption. + apply H2; assumption. + apply Rmin_2; assumption. + rewrite <- Rabs_mult. + apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); try assumption. + apply H2; assumption. + apply Rmin_2; assumption. + rewrite <- Rabs_mult. + apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption. + apply H2; assumption. + apply Rmin_2; assumption. + right; symmetry in |- *; apply quadruple_var. + apply H2; assumption. + intros. + case (Req_dec a 0); intro. + rewrite H18; rewrite Rplus_0_r; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; apply Rabs_pos_lt. + unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr. + repeat apply prod_neq_R0; + assumption || + (apply Rinv_neq_0_compat; assumption) || + (apply Rinv_neq_0_compat; discrR) || + (red in |- *; intro H28; rewrite H28 in H6; elim (Rlt_irrefl _ H6)). + apply prod_neq_R0; [ discrR | assumption ]. + apply prod_neq_R0; [ discrR | assumption ]. + assumption. + elim H13; intros. + apply H20. + split. + apply D_x_no_cond; assumption. + replace (x + a - x) with a; [ assumption | ring ]. + intros. + case (Req_dec a 0); intro. + rewrite H18; rewrite Rplus_0_r; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; apply Rabs_pos_lt. + unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr. + repeat apply prod_neq_R0; + assumption || + (apply Rinv_neq_0_compat; assumption) || + (apply Rinv_neq_0_compat; discrR) || + (red in |- *; intro H28; rewrite H28 in H6; elim (Rlt_irrefl _ H6)). + discrR. + assumption. + elim H14; intros. + apply H20. + split. + unfold D_x, no_cond in |- *; split. + trivial. + apply Rminus_not_eq_right. + replace (x + a - x) with a; [ assumption | ring ]. + replace (x + a - x) with a; [ assumption | ring ]. + repeat apply Rmin_pos. + apply (cond_pos eps_f2). + elim H3; intros; assumption. + apply (cond_pos alp_f1d). + apply (cond_pos alp_f2d). + elim H13; intros; assumption. + elim H14; intros; assumption. + change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))) in |- *; apply Rabs_pos_lt. + unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; try discrR || assumption. + repeat apply prod_neq_R0; + assumption || + (apply Rinv_neq_0_compat; assumption) || + (apply Rinv_neq_0_compat; discrR) || + (red in |- *; intro H14; rewrite H14 in H6; elim (Rlt_irrefl _ H6)). + change (0 < Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))) in |- *; + apply Rabs_pos_lt. + unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr. + repeat apply prod_neq_R0; + assumption || + (apply Rinv_neq_0_compat; assumption) || + (apply Rinv_neq_0_compat; discrR) || + (red in |- *; intro H13; rewrite H13 in H6; elim (Rlt_irrefl _ H6)). + apply prod_neq_R0; [ discrR | assumption ]. + apply prod_neq_R0; [ discrR | assumption ]. + assumption. + apply Rabs_pos_lt. + unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; + [ idtac | discrR | assumption ]. + repeat apply prod_neq_R0; + assumption || + (apply Rinv_neq_0_compat; assumption) || + (apply Rinv_neq_0_compat; discrR) || + (red in |- *; intro H11; rewrite H11 in H6; elim (Rlt_irrefl _ H6)). + intros. + unfold Rdiv in |- *. + apply Rmult_lt_reg_l with (Rabs (f2 (x + a))). + apply Rabs_pos_lt; apply H2. + apply Rlt_le_trans with (Rmin eps_f2 alp_f2). + assumption. + apply Rmin_l. + rewrite <- Rinv_r_sym. + apply Rmult_lt_reg_l with (Rabs (f2 x)). + apply Rabs_pos_lt; assumption. + rewrite Rmult_1_r. + rewrite (Rmult_comm (Rabs (f2 x))). + repeat rewrite Rmult_assoc. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_r. + apply Rmult_lt_reg_l with (/ 2). + apply Rinv_0_lt_compat; prove_sup0. + repeat rewrite (Rmult_comm (/ 2)). + repeat rewrite Rmult_assoc. + rewrite <- Rinv_r_sym. + rewrite Rmult_1_r. + unfold Rdiv in H5; apply H5. + replace (x + a - x) with a. + assert (H7 := Rlt_le_trans _ _ _ H6 (Rmin_r _ _)); assumption. + ring. + discrR. + apply Rabs_no_R0; assumption. + apply Rabs_no_R0; apply H2. + assert (H7 := Rlt_le_trans _ _ _ H6 (Rmin_l _ _)); assumption. + intros. + assert (H6 := H4 a H5). + rewrite <- (Rabs_Ropp (f2 a - f2 x)) in H6. + rewrite Ropp_minus_distr in H6. + assert (H7 := Rle_lt_trans _ _ _ (Rabs_triang_inv _ _) H6). + apply Rplus_lt_reg_r with (- Rabs (f2 a) + Rabs (f2 x) / 2). + rewrite Rplus_assoc. + rewrite <- double_var. + do 2 rewrite (Rplus_comm (- Rabs (f2 a))). + rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r. + unfold Rminus in H7; assumption. + intros. + case (Req_dec x x0); intro. + rewrite <- H5; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply Rabs_pos_lt; assumption | apply Rinv_0_lt_compat; prove_sup0 ]. + elim H3; intros. + apply H7. + split. + unfold D_x, no_cond in |- *; split. + trivial. + assumption. + assumption. Qed. Lemma derivable_pt_div : - forall (f1 f2:R -> R) (x:R), - derivable_pt f1 x -> - derivable_pt f2 x -> f2 x <> 0 -> derivable_pt (f1 / f2) x. -unfold derivable_pt in |- *. -intros f1 f2 x X X0 H. -elim X; intros. -elim X0; intros. -apply existT with ((x0 * f2 x - x1 * f1 x) / Rsqr (f2 x)). -apply derivable_pt_lim_div; assumption. + forall (f1 f2:R -> R) (x:R), + derivable_pt f1 x -> + derivable_pt f2 x -> f2 x <> 0 -> derivable_pt (f1 / f2) x. +Proof. + unfold derivable_pt in |- *. + intros f1 f2 x X X0 H. + elim X; intros. + elim X0; intros. + apply existT with ((x0 * f2 x - x1 * f1 x) / Rsqr (f2 x)). + apply derivable_pt_lim_div; assumption. Qed. Lemma derivable_div : - forall f1 f2:R -> R, - derivable f1 -> - derivable f2 -> (forall x:R, f2 x <> 0) -> derivable (f1 / f2). -unfold derivable in |- *; intros f1 f2 X X0 H x. -apply (derivable_pt_div _ _ _ (X x) (X0 x) (H x)). + forall f1 f2:R -> R, + derivable f1 -> + derivable f2 -> (forall x:R, f2 x <> 0) -> derivable (f1 / f2). +Proof. + unfold derivable in |- *; intros f1 f2 X X0 H x. + apply (derivable_pt_div _ _ _ (X x) (X0 x) (H x)). Qed. Lemma derive_pt_div : - forall (f1 f2:R -> R) (x:R) (pr1:derivable_pt f1 x) - (pr2:derivable_pt f2 x) (na:f2 x <> 0), - derive_pt (f1 / f2) x (derivable_pt_div _ _ _ pr1 pr2 na) = - (derive_pt f1 x pr1 * f2 x - derive_pt f2 x pr2 * f1 x) / Rsqr (f2 x). -intros. -assert (H := derivable_derive f1 x pr1). -assert (H0 := derivable_derive f2 x pr2). -assert - (H1 := derivable_derive (f1 / f2)%F x (derivable_pt_div _ _ _ pr1 pr2 na)). -elim H; clear H; intros l1 H. -elim H0; clear H0; intros l2 H0. -elim H1; clear H1; intros l H1. -rewrite H; rewrite H0; apply derive_pt_eq_0. -assert (H3 := projT2 pr1). -unfold derive_pt in H; rewrite H in H3. -assert (H4 := projT2 pr2). -unfold derive_pt in H0; rewrite H0 in H4. -apply derivable_pt_lim_div; assumption. + forall (f1 f2:R -> R) (x:R) (pr1:derivable_pt f1 x) + (pr2:derivable_pt f2 x) (na:f2 x <> 0), + derive_pt (f1 / f2) x (derivable_pt_div _ _ _ pr1 pr2 na) = + (derive_pt f1 x pr1 * f2 x - derive_pt f2 x pr2 * f1 x) / Rsqr (f2 x). +Proof. + intros. + assert (H := derivable_derive f1 x pr1). + assert (H0 := derivable_derive f2 x pr2). + assert + (H1 := derivable_derive (f1 / f2)%F x (derivable_pt_div _ _ _ pr1 pr2 na)). + elim H; clear H; intros l1 H. + elim H0; clear H0; intros l2 H0. + elim H1; clear H1; intros l H1. + rewrite H; rewrite H0; apply derive_pt_eq_0. + assert (H3 := projT2 pr1). + unfold derive_pt in H; rewrite H in H3. + assert (H4 := projT2 pr2). + unfold derive_pt in H0; rewrite H0 in H4. + apply derivable_pt_lim_div; assumption. Qed. diff --git a/theories/Reals/Ranalysis4.v b/theories/Reals/Ranalysis4.v index 40bb2429..205c06b4 100644 --- a/theories/Reals/Ranalysis4.v +++ b/theories/Reals/Ranalysis4.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Ranalysis4.v 8670 2006-03-28 22:16:14Z herbelin $ i*) +(*i $Id: Ranalysis4.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -18,367 +18,392 @@ Require Import Exp_prop. Open Local Scope R_scope. (**********) Lemma derivable_pt_inv : - forall (f:R -> R) (x:R), - f x <> 0 -> derivable_pt f x -> derivable_pt (/ f) x. -intros f x H X; cut (derivable_pt (fct_cte 1 / f) x -> derivable_pt (/ f) x). -intro X0; apply X0. -apply derivable_pt_div. -apply derivable_pt_const. -assumption. -assumption. -unfold div_fct, inv_fct, fct_cte in |- *; intro X0; elim X0; intros; - unfold derivable_pt in |- *; apply existT with x0; - unfold derivable_pt_abs in |- *; unfold derivable_pt_lim in |- *; - unfold derivable_pt_abs in p; unfold derivable_pt_lim in p; - intros; elim (p eps H0); intros; exists x1; intros; - unfold Rdiv in H1; unfold Rdiv in |- *; rewrite <- (Rmult_1_l (/ f x)); - rewrite <- (Rmult_1_l (/ f (x + h))). -apply H1; assumption. + forall (f:R -> R) (x:R), + f x <> 0 -> derivable_pt f x -> derivable_pt (/ f) x. +Proof. + intros f x H X; cut (derivable_pt (fct_cte 1 / f) x -> derivable_pt (/ f) x). + intro X0; apply X0. + apply derivable_pt_div. + apply derivable_pt_const. + assumption. + assumption. + unfold div_fct, inv_fct, fct_cte in |- *; intro X0; elim X0; intros; + unfold derivable_pt in |- *; apply existT with x0; + unfold derivable_pt_abs in |- *; unfold derivable_pt_lim in |- *; + unfold derivable_pt_abs in p; unfold derivable_pt_lim in p; + intros; elim (p eps H0); intros; exists x1; intros; + unfold Rdiv in H1; unfold Rdiv in |- *; rewrite <- (Rmult_1_l (/ f x)); + rewrite <- (Rmult_1_l (/ f (x + h))). + apply H1; assumption. Qed. (**********) Lemma pr_nu_var : - forall (f g:R -> R) (x:R) (pr1:derivable_pt f x) (pr2:derivable_pt g x), - f = g -> derive_pt f x pr1 = derive_pt g x pr2. -unfold derivable_pt, derive_pt in |- *; intros. -elim pr1; intros. -elim pr2; intros. -simpl in |- *. -rewrite H in p. -apply uniqueness_limite with g x; assumption. + forall (f g:R -> R) (x:R) (pr1:derivable_pt f x) (pr2:derivable_pt g x), + f = g -> derive_pt f x pr1 = derive_pt g x pr2. +Proof. + unfold derivable_pt, derive_pt in |- *; intros. + elim pr1; intros. + elim pr2; intros. + simpl in |- *. + rewrite H in p. + apply uniqueness_limite with g x; assumption. Qed. (**********) Lemma pr_nu_var2 : - forall (f g:R -> R) (x:R) (pr1:derivable_pt f x) (pr2:derivable_pt g x), - (forall h:R, f h = g h) -> derive_pt f x pr1 = derive_pt g x pr2. -unfold derivable_pt, derive_pt in |- *; intros. -elim pr1; intros. -elim pr2; intros. -simpl in |- *. -assert (H0 := uniqueness_step2 _ _ _ p). -assert (H1 := uniqueness_step2 _ _ _ p0). -cut (limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) x1 0). -intro; assert (H3 := uniqueness_step1 _ _ _ _ H0 H2). -assumption. -unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *; - simpl in |- *; unfold R_dist in |- *; unfold limit1_in in H1; - unfold limit_in in H1; unfold dist in H1; simpl in H1; - unfold R_dist in H1. -intros; elim (H1 eps H2); intros. -elim H3; intros. -exists x2. -split. -assumption. -intros; do 2 rewrite H; apply H5; assumption. + forall (f g:R -> R) (x:R) (pr1:derivable_pt f x) (pr2:derivable_pt g x), + (forall h:R, f h = g h) -> derive_pt f x pr1 = derive_pt g x pr2. +Proof. + unfold derivable_pt, derive_pt in |- *; intros. + elim pr1; intros. + elim pr2; intros. + simpl in |- *. + assert (H0 := uniqueness_step2 _ _ _ p). + assert (H1 := uniqueness_step2 _ _ _ p0). + cut (limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) x1 0). + intro; assert (H3 := uniqueness_step1 _ _ _ _ H0 H2). + assumption. + unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *; + simpl in |- *; unfold R_dist in |- *; unfold limit1_in in H1; + unfold limit_in in H1; unfold dist in H1; simpl in H1; + unfold R_dist in H1. + intros; elim (H1 eps H2); intros. + elim H3; intros. + exists x2. + split. + assumption. + intros; do 2 rewrite H; apply H5; assumption. Qed. (**********) Lemma derivable_inv : - forall f:R -> R, (forall x:R, f x <> 0) -> derivable f -> derivable (/ f). -intros f H X. -unfold derivable in |- *; intro x. -apply derivable_pt_inv. -apply (H x). -apply (X x). + forall f:R -> R, (forall x:R, f x <> 0) -> derivable f -> derivable (/ f). +Proof. + intros f H X. + unfold derivable in |- *; intro x. + apply derivable_pt_inv. + apply (H x). + apply (X x). Qed. Lemma derive_pt_inv : - forall (f:R -> R) (x:R) (pr:derivable_pt f x) (na:f x <> 0), - derive_pt (/ f) x (derivable_pt_inv f x na pr) = - - derive_pt f x pr / Rsqr (f x). -intros; - replace (derive_pt (/ f) x (derivable_pt_inv f x na pr)) with - (derive_pt (fct_cte 1 / f) x - (derivable_pt_div (fct_cte 1) f x (derivable_pt_const 1 x) pr na)). -rewrite derive_pt_div; rewrite derive_pt_const; unfold fct_cte in |- *; - rewrite Rmult_0_l; rewrite Rmult_1_r; unfold Rminus in |- *; - rewrite Rplus_0_l; reflexivity. -apply pr_nu_var2. -intro; unfold div_fct, fct_cte, inv_fct in |- *. -unfold Rdiv in |- *; ring. + forall (f:R -> R) (x:R) (pr:derivable_pt f x) (na:f x <> 0), + derive_pt (/ f) x (derivable_pt_inv f x na pr) = + - derive_pt f x pr / Rsqr (f x). +Proof. + intros; + replace (derive_pt (/ f) x (derivable_pt_inv f x na pr)) with + (derive_pt (fct_cte 1 / f) x + (derivable_pt_div (fct_cte 1) f x (derivable_pt_const 1 x) pr na)). + rewrite derive_pt_div; rewrite derive_pt_const; unfold fct_cte in |- *; + rewrite Rmult_0_l; rewrite Rmult_1_r; unfold Rminus in |- *; + rewrite Rplus_0_l; reflexivity. + apply pr_nu_var2. + intro; unfold div_fct, fct_cte, inv_fct in |- *. + unfold Rdiv in |- *; ring. Qed. -(* Rabsolu *) +(** Rabsolu *) Lemma Rabs_derive_1 : forall x:R, 0 < x -> derivable_pt_lim Rabs x 1. -intros. -unfold derivable_pt_lim in |- *; intros. -exists (mkposreal x H); intros. -rewrite (Rabs_right x). -rewrite (Rabs_right (x + h)). -rewrite Rplus_comm. -unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_r. -rewrite Rplus_0_r; unfold Rdiv in |- *; rewrite <- Rinv_r_sym. -rewrite Rplus_opp_r; rewrite Rabs_R0; apply H0. -apply H1. -apply Rle_ge. -case (Rcase_abs h); intro. -rewrite (Rabs_left h r) in H2. -left; rewrite Rplus_comm; apply Rplus_lt_reg_r with (- h); rewrite Rplus_0_r; - rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; - apply H2. -apply Rplus_le_le_0_compat. -left; apply H. -apply Rge_le; apply r. -left; apply H. +Proof. + intros. + unfold derivable_pt_lim in |- *; intros. + exists (mkposreal x H); intros. + rewrite (Rabs_right x). + rewrite (Rabs_right (x + h)). + rewrite Rplus_comm. + unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_r. + rewrite Rplus_0_r; unfold Rdiv in |- *; rewrite <- Rinv_r_sym. + rewrite Rplus_opp_r; rewrite Rabs_R0; apply H0. + apply H1. + apply Rle_ge. + case (Rcase_abs h); intro. + rewrite (Rabs_left h r) in H2. + left; rewrite Rplus_comm; apply Rplus_lt_reg_r with (- h); rewrite Rplus_0_r; + rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; + apply H2. + apply Rplus_le_le_0_compat. + left; apply H. + apply Rge_le; apply r. + left; apply H. Qed. Lemma Rabs_derive_2 : forall x:R, x < 0 -> derivable_pt_lim Rabs x (-1). -intros. -unfold derivable_pt_lim in |- *; intros. -cut (0 < - x). -intro; exists (mkposreal (- x) H1); intros. -rewrite (Rabs_left x). -rewrite (Rabs_left (x + h)). -rewrite Rplus_comm. -rewrite Ropp_plus_distr. -unfold Rminus in |- *; rewrite Ropp_involutive; rewrite Rplus_assoc; - rewrite Rplus_opp_l. -rewrite Rplus_0_r; unfold Rdiv in |- *. -rewrite Ropp_mult_distr_l_reverse. -rewrite <- Rinv_r_sym. -rewrite Ropp_involutive; rewrite Rplus_opp_l; rewrite Rabs_R0; apply H0. -apply H2. -case (Rcase_abs h); intro. -apply Ropp_lt_cancel. -rewrite Ropp_0; rewrite Ropp_plus_distr; apply Rplus_lt_0_compat. -apply H1. -apply Ropp_0_gt_lt_contravar; apply r. -rewrite (Rabs_right h r) in H3. -apply Rplus_lt_reg_r with (- x); rewrite Rplus_0_r; rewrite <- Rplus_assoc; - rewrite Rplus_opp_l; rewrite Rplus_0_l; apply H3. -apply H. -apply Ropp_0_gt_lt_contravar; apply H. +Proof. + intros. + unfold derivable_pt_lim in |- *; intros. + cut (0 < - x). + intro; exists (mkposreal (- x) H1); intros. + rewrite (Rabs_left x). + rewrite (Rabs_left (x + h)). + rewrite Rplus_comm. + rewrite Ropp_plus_distr. + unfold Rminus in |- *; rewrite Ropp_involutive; rewrite Rplus_assoc; + rewrite Rplus_opp_l. + rewrite Rplus_0_r; unfold Rdiv in |- *. + rewrite Ropp_mult_distr_l_reverse. + rewrite <- Rinv_r_sym. + rewrite Ropp_involutive; rewrite Rplus_opp_l; rewrite Rabs_R0; apply H0. + apply H2. + case (Rcase_abs h); intro. + apply Ropp_lt_cancel. + rewrite Ropp_0; rewrite Ropp_plus_distr; apply Rplus_lt_0_compat. + apply H1. + apply Ropp_0_gt_lt_contravar; apply r. + rewrite (Rabs_right h r) in H3. + apply Rplus_lt_reg_r with (- x); rewrite Rplus_0_r; rewrite <- Rplus_assoc; + rewrite Rplus_opp_l; rewrite Rplus_0_l; apply H3. + apply H. + apply Ropp_0_gt_lt_contravar; apply H. Qed. -(* Rabsolu is derivable for all x <> 0 *) +(** Rabsolu is derivable for all x <> 0 *) Lemma Rderivable_pt_abs : forall x:R, x <> 0 -> derivable_pt Rabs x. -intros. -case (total_order_T x 0); intro. -elim s; intro. -unfold derivable_pt in |- *; apply existT with (-1). -apply (Rabs_derive_2 x a). -elim H; exact b. -unfold derivable_pt in |- *; apply existT with 1. -apply (Rabs_derive_1 x r). +Proof. + intros. + case (total_order_T x 0); intro. + elim s; intro. + unfold derivable_pt in |- *; apply existT with (-1). + apply (Rabs_derive_2 x a). + elim H; exact b. + unfold derivable_pt in |- *; apply existT with 1. + apply (Rabs_derive_1 x r). Qed. -(* Rabsolu is continuous for all x *) +(** Rabsolu is continuous for all x *) Lemma Rcontinuity_abs : continuity Rabs. -unfold continuity in |- *; intro. -case (Req_dec x 0); intro. -unfold continuity_pt in |- *; unfold continue_in in |- *; - unfold limit1_in in |- *; unfold limit_in in |- *; - simpl in |- *; unfold R_dist in |- *; intros; exists eps; - split. -apply H0. -intros; rewrite H; rewrite Rabs_R0; unfold Rminus in |- *; rewrite Ropp_0; - rewrite Rplus_0_r; rewrite Rabs_Rabsolu; elim H1; - intros; rewrite H in H3; unfold Rminus in H3; rewrite Ropp_0 in H3; - rewrite Rplus_0_r in H3; apply H3. -apply derivable_continuous_pt; apply (Rderivable_pt_abs x H). +Proof. + unfold continuity in |- *; intro. + case (Req_dec x 0); intro. + unfold continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros; exists eps; + split. + apply H0. + intros; rewrite H; rewrite Rabs_R0; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; rewrite Rabs_Rabsolu; elim H1; + intros; rewrite H in H3; unfold Rminus in H3; rewrite Ropp_0 in H3; + rewrite Rplus_0_r in H3; apply H3. + apply derivable_continuous_pt; apply (Rderivable_pt_abs x H). Qed. -(* Finite sums : Sum a_k x^k *) +(** Finite sums : Sum a_k x^k *) Lemma continuity_finite_sum : - forall (An:nat -> R) (N:nat), - continuity (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N). -intros; unfold continuity in |- *; intro. -induction N as [| N HrecN]. -simpl in |- *. -apply continuity_pt_const. -unfold constant in |- *; intros; reflexivity. -replace (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) (S N)) with - ((fun y:R => sum_f_R0 (fun k:nat => (An k * y ^ k)%R) N) + - (fun y:R => (An (S N) * y ^ S N)%R))%F. -apply continuity_pt_plus. -apply HrecN. -replace (fun y:R => An (S N) * y ^ S N) with - (mult_real_fct (An (S N)) (fun y:R => y ^ S N)). -apply continuity_pt_scal. -apply derivable_continuous_pt. -apply derivable_pt_pow. -reflexivity. -reflexivity. + forall (An:nat -> R) (N:nat), + continuity (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N). +Proof. + intros; unfold continuity in |- *; intro. + induction N as [| N HrecN]. + simpl in |- *. + apply continuity_pt_const. + unfold constant in |- *; intros; reflexivity. + replace (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) (S N)) with + ((fun y:R => sum_f_R0 (fun k:nat => (An k * y ^ k)%R) N) + + (fun y:R => (An (S N) * y ^ S N)%R))%F. + apply continuity_pt_plus. + apply HrecN. + replace (fun y:R => An (S N) * y ^ S N) with + (mult_real_fct (An (S N)) (fun y:R => y ^ S N)). + apply continuity_pt_scal. + apply derivable_continuous_pt. + apply derivable_pt_pow. + reflexivity. + reflexivity. Qed. Lemma derivable_pt_lim_fs : - forall (An:nat -> R) (x:R) (N:nat), - (0 < N)%nat -> - derivable_pt_lim (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N) x - (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred N)). -intros; induction N as [| N HrecN]. -elim (lt_irrefl _ H). -cut (N = 0%nat \/ (0 < N)%nat). -intro; elim H0; intro. -rewrite H1. -simpl in |- *. -replace (fun y:R => An 0%nat * 1 + An 1%nat * (y * 1)) with - (fct_cte (An 0%nat * 1) + mult_real_fct (An 1%nat) (id * fct_cte 1))%F. -replace (1 * An 1%nat * 1) with (0 + An 1%nat * (1 * fct_cte 1 x + id x * 0)). -apply derivable_pt_lim_plus. -apply derivable_pt_lim_const. -apply derivable_pt_lim_scal. -apply derivable_pt_lim_mult. -apply derivable_pt_lim_id. -apply derivable_pt_lim_const. -unfold fct_cte, id in |- *; ring. -reflexivity. -replace (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) (S N)) with - ((fun y:R => sum_f_R0 (fun k:nat => (An k * y ^ k)%R) N) + - (fun y:R => (An (S N) * y ^ S N)%R))%F. -replace (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred (S N))) - with - (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred N) + - An (S N) * (INR (S (pred (S N))) * x ^ pred (S N))). -apply derivable_pt_lim_plus. -apply HrecN. -assumption. -replace (fun y:R => An (S N) * y ^ S N) with - (mult_real_fct (An (S N)) (fun y:R => y ^ S N)). -apply derivable_pt_lim_scal. -replace (pred (S N)) with N; [ idtac | reflexivity ]. -pattern N at 3 in |- *; replace N with (pred (S N)). -apply derivable_pt_lim_pow. -reflexivity. -reflexivity. -cut (pred (S N) = S (pred N)). -intro; rewrite H2. -rewrite tech5. -apply Rplus_eq_compat_l. -rewrite <- H2. -replace (pred (S N)) with N; [ idtac | reflexivity ]. -ring. -simpl in |- *. -apply S_pred with 0%nat; assumption. -unfold plus_fct in |- *. -simpl in |- *; reflexivity. -inversion H. -left; reflexivity. -right; apply lt_le_trans with 1%nat; [ apply lt_O_Sn | assumption ]. + forall (An:nat -> R) (x:R) (N:nat), + (0 < N)%nat -> + derivable_pt_lim (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N) x + (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred N)). +Proof. + intros; induction N as [| N HrecN]. + elim (lt_irrefl _ H). + cut (N = 0%nat \/ (0 < N)%nat). + intro; elim H0; intro. + rewrite H1. + simpl in |- *. + replace (fun y:R => An 0%nat * 1 + An 1%nat * (y * 1)) with + (fct_cte (An 0%nat * 1) + mult_real_fct (An 1%nat) (id * fct_cte 1))%F. + replace (1 * An 1%nat * 1) with (0 + An 1%nat * (1 * fct_cte 1 x + id x * 0)). + apply derivable_pt_lim_plus. + apply derivable_pt_lim_const. + apply derivable_pt_lim_scal. + apply derivable_pt_lim_mult. + apply derivable_pt_lim_id. + apply derivable_pt_lim_const. + unfold fct_cte, id in |- *; ring. + reflexivity. + replace (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) (S N)) with + ((fun y:R => sum_f_R0 (fun k:nat => (An k * y ^ k)%R) N) + + (fun y:R => (An (S N) * y ^ S N)%R))%F. + replace (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred (S N))) + with + (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred N) + + An (S N) * (INR (S (pred (S N))) * x ^ pred (S N))). + apply derivable_pt_lim_plus. + apply HrecN. + assumption. + replace (fun y:R => An (S N) * y ^ S N) with + (mult_real_fct (An (S N)) (fun y:R => y ^ S N)). + apply derivable_pt_lim_scal. + replace (pred (S N)) with N; [ idtac | reflexivity ]. + pattern N at 3 in |- *; replace N with (pred (S N)). + apply derivable_pt_lim_pow. + reflexivity. + reflexivity. + cut (pred (S N) = S (pred N)). + intro; rewrite H2. + rewrite tech5. + apply Rplus_eq_compat_l. + rewrite <- H2. + replace (pred (S N)) with N; [ idtac | reflexivity ]. + ring. + simpl in |- *. + apply S_pred with 0%nat; assumption. + unfold plus_fct in |- *. + simpl in |- *; reflexivity. + inversion H. + left; reflexivity. + right; apply lt_le_trans with 1%nat; [ apply lt_O_Sn | assumption ]. Qed. Lemma derivable_pt_lim_finite_sum : - forall (An:nat -> R) (x:R) (N:nat), - derivable_pt_lim (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N) x - match N with - | O => 0 - | _ => sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred N) - end. -intros. -induction N as [| N HrecN]. -simpl in |- *. -rewrite Rmult_1_r. -replace (fun _:R => An 0%nat) with (fct_cte (An 0%nat)); - [ apply derivable_pt_lim_const | reflexivity ]. -apply derivable_pt_lim_fs; apply lt_O_Sn. + forall (An:nat -> R) (x:R) (N:nat), + derivable_pt_lim (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N) x + match N with + | O => 0 + | _ => sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred N) + end. +Proof. + intros. + induction N as [| N HrecN]. + simpl in |- *. + rewrite Rmult_1_r. + replace (fun _:R => An 0%nat) with (fct_cte (An 0%nat)); + [ apply derivable_pt_lim_const | reflexivity ]. + apply derivable_pt_lim_fs; apply lt_O_Sn. Qed. Lemma derivable_pt_finite_sum : - forall (An:nat -> R) (N:nat) (x:R), - derivable_pt (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N) x. -intros. -unfold derivable_pt in |- *. -assert (H := derivable_pt_lim_finite_sum An x N). -induction N as [| N HrecN]. -apply existT with 0; apply H. -apply existT with - (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred (S N))); - apply H. + forall (An:nat -> R) (N:nat) (x:R), + derivable_pt (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N) x. +Proof. + intros. + unfold derivable_pt in |- *. + assert (H := derivable_pt_lim_finite_sum An x N). + induction N as [| N HrecN]. + apply existT with 0; apply H. + apply existT with + (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred (S N))); + apply H. Qed. Lemma derivable_finite_sum : - forall (An:nat -> R) (N:nat), - derivable (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N). -intros; unfold derivable in |- *; intro; apply derivable_pt_finite_sum. + forall (An:nat -> R) (N:nat), + derivable (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N). +Proof. + intros; unfold derivable in |- *; intro; apply derivable_pt_finite_sum. Qed. -(* Regularity of hyperbolic functions *) +(** Regularity of hyperbolic functions *) Lemma derivable_pt_lim_cosh : forall x:R, derivable_pt_lim cosh x (sinh x). -intro. -unfold cosh, sinh in |- *; unfold Rdiv in |- *. -replace (fun x0:R => (exp x0 + exp (- x0)) * / 2) with - ((exp + comp exp (- id)) * fct_cte (/ 2))%F; [ idtac | reflexivity ]. -replace ((exp x - exp (- x)) * / 2) with - ((exp x + exp (- x) * -1) * fct_cte (/ 2) x + - (exp + comp exp (- id))%F x * 0). -apply derivable_pt_lim_mult. -apply derivable_pt_lim_plus. -apply derivable_pt_lim_exp. -apply derivable_pt_lim_comp. -apply derivable_pt_lim_opp. -apply derivable_pt_lim_id. -apply derivable_pt_lim_exp. -apply derivable_pt_lim_const. -unfold plus_fct, mult_real_fct, comp, opp_fct, id, fct_cte in |- *; ring. +Proof. + intro. + unfold cosh, sinh in |- *; unfold Rdiv in |- *. + replace (fun x0:R => (exp x0 + exp (- x0)) * / 2) with + ((exp + comp exp (- id)) * fct_cte (/ 2))%F; [ idtac | reflexivity ]. + replace ((exp x - exp (- x)) * / 2) with + ((exp x + exp (- x) * -1) * fct_cte (/ 2) x + + (exp + comp exp (- id))%F x * 0). + apply derivable_pt_lim_mult. + apply derivable_pt_lim_plus. + apply derivable_pt_lim_exp. + apply derivable_pt_lim_comp. + apply derivable_pt_lim_opp. + apply derivable_pt_lim_id. + apply derivable_pt_lim_exp. + apply derivable_pt_lim_const. + unfold plus_fct, mult_real_fct, comp, opp_fct, id, fct_cte in |- *; ring. Qed. Lemma derivable_pt_lim_sinh : forall x:R, derivable_pt_lim sinh x (cosh x). -intro. -unfold cosh, sinh in |- *; unfold Rdiv in |- *. -replace (fun x0:R => (exp x0 - exp (- x0)) * / 2) with - ((exp - comp exp (- id)) * fct_cte (/ 2))%F; [ idtac | reflexivity ]. -replace ((exp x + exp (- x)) * / 2) with - ((exp x - exp (- x) * -1) * fct_cte (/ 2) x + - (exp - comp exp (- id))%F x * 0). -apply derivable_pt_lim_mult. -apply derivable_pt_lim_minus. -apply derivable_pt_lim_exp. -apply derivable_pt_lim_comp. -apply derivable_pt_lim_opp. -apply derivable_pt_lim_id. -apply derivable_pt_lim_exp. -apply derivable_pt_lim_const. -unfold plus_fct, mult_real_fct, comp, opp_fct, id, fct_cte in |- *; ring. +Proof. + intro. + unfold cosh, sinh in |- *; unfold Rdiv in |- *. + replace (fun x0:R => (exp x0 - exp (- x0)) * / 2) with + ((exp - comp exp (- id)) * fct_cte (/ 2))%F; [ idtac | reflexivity ]. + replace ((exp x + exp (- x)) * / 2) with + ((exp x - exp (- x) * -1) * fct_cte (/ 2) x + + (exp - comp exp (- id))%F x * 0). + apply derivable_pt_lim_mult. + apply derivable_pt_lim_minus. + apply derivable_pt_lim_exp. + apply derivable_pt_lim_comp. + apply derivable_pt_lim_opp. + apply derivable_pt_lim_id. + apply derivable_pt_lim_exp. + apply derivable_pt_lim_const. + unfold plus_fct, mult_real_fct, comp, opp_fct, id, fct_cte in |- *; ring. Qed. Lemma derivable_pt_exp : forall x:R, derivable_pt exp x. -intro. -unfold derivable_pt in |- *. -apply existT with (exp x). -apply derivable_pt_lim_exp. +Proof. + intro. + unfold derivable_pt in |- *. + apply existT with (exp x). + apply derivable_pt_lim_exp. Qed. Lemma derivable_pt_cosh : forall x:R, derivable_pt cosh x. -intro. -unfold derivable_pt in |- *. -apply existT with (sinh x). -apply derivable_pt_lim_cosh. +Proof. + intro. + unfold derivable_pt in |- *. + apply existT with (sinh x). + apply derivable_pt_lim_cosh. Qed. Lemma derivable_pt_sinh : forall x:R, derivable_pt sinh x. -intro. -unfold derivable_pt in |- *. -apply existT with (cosh x). -apply derivable_pt_lim_sinh. +Proof. + intro. + unfold derivable_pt in |- *. + apply existT with (cosh x). + apply derivable_pt_lim_sinh. Qed. Lemma derivable_exp : derivable exp. -unfold derivable in |- *; apply derivable_pt_exp. +Proof. + unfold derivable in |- *; apply derivable_pt_exp. Qed. Lemma derivable_cosh : derivable cosh. -unfold derivable in |- *; apply derivable_pt_cosh. +Proof. + unfold derivable in |- *; apply derivable_pt_cosh. Qed. Lemma derivable_sinh : derivable sinh. -unfold derivable in |- *; apply derivable_pt_sinh. +Proof. + unfold derivable in |- *; apply derivable_pt_sinh. Qed. Lemma derive_pt_exp : - forall x:R, derive_pt exp x (derivable_pt_exp x) = exp x. -intro; apply derive_pt_eq_0. -apply derivable_pt_lim_exp. + forall x:R, derive_pt exp x (derivable_pt_exp x) = exp x. +Proof. + intro; apply derive_pt_eq_0. + apply derivable_pt_lim_exp. Qed. Lemma derive_pt_cosh : - forall x:R, derive_pt cosh x (derivable_pt_cosh x) = sinh x. -intro; apply derive_pt_eq_0. -apply derivable_pt_lim_cosh. + forall x:R, derive_pt cosh x (derivable_pt_cosh x) = sinh x. +Proof. + intro; apply derive_pt_eq_0. + apply derivable_pt_lim_cosh. Qed. Lemma derive_pt_sinh : - forall x:R, derive_pt sinh x (derivable_pt_sinh x) = cosh x. -intro; apply derive_pt_eq_0. -apply derivable_pt_lim_sinh. + forall x:R, derive_pt sinh x (derivable_pt_sinh x) = cosh x. +Proof. + intro; apply derive_pt_eq_0. + apply derivable_pt_lim_sinh. Qed. diff --git a/theories/Reals/Raxioms.v b/theories/Reals/Raxioms.v index 61902568..aaea59f4 100644 --- a/theories/Reals/Raxioms.v +++ b/theories/Reals/Raxioms.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Raxioms.v 6338 2004-11-22 09:10:51Z gregoire $ i*) +(*i $Id: Raxioms.v 9245 2006-10-17 12:53:34Z notin $ i*) (*********************************************************) (** Axiomatisation of the classical reals *) @@ -17,11 +17,11 @@ Require Export Rdefinitions. Open Local Scope R_scope. (*********************************************************) -(* Field axioms *) +(** * Field axioms *) (*********************************************************) (*********************************************************) -(** Addition *) +(** ** Addition *) (*********************************************************) (**********) @@ -41,7 +41,7 @@ Axiom Rplus_0_l : forall r:R, 0 + r = r. Hint Resolve Rplus_0_l: real. (***********************************************************) -(** Multiplication *) +(** ** Multiplication *) (***********************************************************) (**********) @@ -65,7 +65,7 @@ Axiom R1_neq_R0 : 1 <> 0. Hint Resolve R1_neq_R0: real. (*********************************************************) -(** Distributivity *) +(** ** Distributivity *) (*********************************************************) (**********) @@ -74,17 +74,17 @@ Axiom Hint Resolve Rmult_plus_distr_l: real v62. (*********************************************************) -(** Order axioms *) +(** * Order axioms *) (*********************************************************) (*********************************************************) -(** Total Order *) +(** ** Total Order *) (*********************************************************) (**********) Axiom total_order_T : forall r1 r2:R, {r1 < r2} + {r1 = r2} + {r1 > r2}. (*********************************************************) -(** Lower *) +(** ** Lower *) (*********************************************************) (**********) @@ -103,7 +103,7 @@ Axiom Hint Resolve Rlt_asym Rplus_lt_compat_l Rmult_lt_compat_l: real. (**********************************************************) -(** Injection from N to R *) +(** * Injection from N to R *) (**********************************************************) (**********) @@ -117,7 +117,7 @@ Arguments Scope INR [nat_scope]. (**********************************************************) -(** Injection from [Z] to [R] *) +(** * Injection from [Z] to [R] *) (**********************************************************) (**********) @@ -130,14 +130,14 @@ Definition IZR (z:Z) : R := Arguments Scope IZR [Z_scope]. (**********************************************************) -(** [R] Archimedian *) +(** * [R] Archimedian *) (**********************************************************) (**********) Axiom archimed : forall r:R, IZR (up r) > r /\ IZR (up r) - r <= 1. (**********************************************************) -(** [R] Complete *) +(** * [R] Complete *) (**********************************************************) (**********) diff --git a/theories/Reals/Rbase.v b/theories/Reals/Rbase.v index 5bfb692a..5bee0f82 100644 --- a/theories/Reals/Rbase.v +++ b/theories/Reals/Rbase.v @@ -6,9 +6,9 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Rbase.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Rbase.v 9178 2006-09-26 11:18:22Z barras $ i*) Require Export Rdefinitions. Require Export Raxioms. Require Export RIneq. -Require Export DiscrR.
\ No newline at end of file +Require Export DiscrR. diff --git a/theories/Reals/Rbasic_fun.v b/theories/Reals/Rbasic_fun.v index 0d1b06e2..98bd607b 100644 --- a/theories/Reals/Rbasic_fun.v +++ b/theories/Reals/Rbasic_fun.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Rbasic_fun.v 8838 2006-05-22 09:26:36Z herbelin $ i*) +(*i $Id: Rbasic_fun.v 9245 2006-10-17 12:53:34Z notin $ i*) (*********************************************************) (** Complements for the real numbers *) @@ -20,453 +20,489 @@ Require Import Fourier. Open Local Scope R_scope. Implicit Type r : R. (*******************************) -(** Rmin *) +(** * Rmin *) (*******************************) (*********) Definition Rmin (x y:R) : R := match Rle_dec x y with - | left _ => x - | right _ => y + | left _ => x + | right _ => y end. (*********) Lemma Rmin_Rgt_l : forall r1 r2 r, Rmin r1 r2 > r -> r1 > r /\ r2 > r. -intros r1 r2 r; unfold Rmin in |- *; case (Rle_dec r1 r2); intros. -split. -assumption. -unfold Rgt in |- *; unfold Rgt in H; exact (Rlt_le_trans r r1 r2 H r0). -split. -generalize (Rnot_le_lt r1 r2 n); intro; exact (Rgt_trans r1 r2 r H0 H). -assumption. +Proof. + intros r1 r2 r; unfold Rmin in |- *; case (Rle_dec r1 r2); intros. + split. + assumption. + unfold Rgt in |- *; unfold Rgt in H; exact (Rlt_le_trans r r1 r2 H r0). + split. + generalize (Rnot_le_lt r1 r2 n); intro; exact (Rgt_trans r1 r2 r H0 H). + assumption. Qed. (*********) Lemma Rmin_Rgt_r : forall r1 r2 r, r1 > r /\ r2 > r -> Rmin r1 r2 > r. -intros; unfold Rmin in |- *; case (Rle_dec r1 r2); elim H; clear H; intros; - assumption. +Proof. + intros; unfold Rmin in |- *; case (Rle_dec r1 r2); elim H; clear H; intros; + assumption. Qed. (*********) Lemma Rmin_Rgt : forall r1 r2 r, Rmin r1 r2 > r <-> r1 > r /\ r2 > r. -intros; split. -exact (Rmin_Rgt_l r1 r2 r). -exact (Rmin_Rgt_r r1 r2 r). +Proof. + intros; split. + exact (Rmin_Rgt_l r1 r2 r). + exact (Rmin_Rgt_r r1 r2 r). Qed. (*********) Lemma Rmin_l : forall x y:R, Rmin x y <= x. -intros; unfold Rmin in |- *; case (Rle_dec x y); intro H1; - [ right; reflexivity | auto with real ]. +Proof. + intros; unfold Rmin in |- *; case (Rle_dec x y); intro H1; + [ right; reflexivity | auto with real ]. Qed. - + (*********) Lemma Rmin_r : forall x y:R, Rmin x y <= y. -intros; unfold Rmin in |- *; case (Rle_dec x y); intro H1; - [ assumption | auto with real ]. +Proof. + intros; unfold Rmin in |- *; case (Rle_dec x y); intro H1; + [ assumption | auto with real ]. Qed. (*********) Lemma Rmin_comm : forall a b:R, Rmin a b = Rmin b a. -intros; unfold Rmin in |- *; case (Rle_dec a b); case (Rle_dec b a); intros; - try reflexivity || (apply Rle_antisym; assumption || auto with real). +Proof. + intros; unfold Rmin in |- *; case (Rle_dec a b); case (Rle_dec b a); intros; + try reflexivity || (apply Rle_antisym; assumption || auto with real). Qed. (*********) Lemma Rmin_stable_in_posreal : forall x y:posreal, 0 < Rmin x y. -intros; apply Rmin_Rgt_r; split; [ apply (cond_pos x) | apply (cond_pos y) ]. +Proof. + intros; apply Rmin_Rgt_r; split; [ apply (cond_pos x) | apply (cond_pos y) ]. Qed. (*******************************) -(** Rmax *) +(** * Rmax *) (*******************************) (*********) Definition Rmax (x y:R) : R := match Rle_dec x y with - | left _ => y - | right _ => x + | left _ => y + | right _ => x end. (*********) Lemma Rmax_Rle : forall r1 r2 r, r <= Rmax r1 r2 <-> r <= r1 \/ r <= r2. -intros; split. -unfold Rmax in |- *; case (Rle_dec r1 r2); intros; auto. -intro; unfold Rmax in |- *; case (Rle_dec r1 r2); elim H; clear H; intros; - auto. -apply (Rle_trans r r1 r2); auto. -generalize (Rnot_le_lt r1 r2 n); clear n; intro; unfold Rgt in H0; - apply (Rlt_le r r1 (Rle_lt_trans r r2 r1 H H0)). +Proof. + intros; split. + unfold Rmax in |- *; case (Rle_dec r1 r2); intros; auto. + intro; unfold Rmax in |- *; case (Rle_dec r1 r2); elim H; clear H; intros; + auto. + apply (Rle_trans r r1 r2); auto. + generalize (Rnot_le_lt r1 r2 n); clear n; intro; unfold Rgt in H0; + apply (Rlt_le r r1 (Rle_lt_trans r r2 r1 H H0)). Qed. Lemma RmaxLess1 : forall r1 r2, r1 <= Rmax r1 r2. -intros r1 r2; unfold Rmax in |- *; case (Rle_dec r1 r2); auto with real. +Proof. + intros r1 r2; unfold Rmax in |- *; case (Rle_dec r1 r2); auto with real. Qed. - + Lemma RmaxLess2 : forall r1 r2, r2 <= Rmax r1 r2. -intros r1 r2; unfold Rmax in |- *; case (Rle_dec r1 r2); auto with real. +Proof. + intros r1 r2; unfold Rmax in |- *; case (Rle_dec r1 r2); auto with real. Qed. - + Lemma Rmax_comm : forall p q:R, Rmax p q = Rmax q p. -intros p q; unfold Rmax in |- *; case (Rle_dec p q); case (Rle_dec q p); auto; - intros H1 H2; apply Rle_antisym; auto with real. +Proof. + intros p q; unfold Rmax in |- *; case (Rle_dec p q); case (Rle_dec q p); auto; + intros H1 H2; apply Rle_antisym; auto with real. Qed. Notation RmaxSym := Rmax_comm (only parsing). Lemma RmaxRmult : - forall (p q:R) r, 0 <= r -> Rmax (r * p) (r * q) = r * Rmax p q. -intros p q r H; unfold Rmax in |- *. -case (Rle_dec p q); case (Rle_dec (r * p) (r * q)); auto; intros H1 H2; auto. -case H; intros E1. -case H1; auto with real. -rewrite <- E1; repeat rewrite Rmult_0_l; auto. -case H; intros E1. -case H2; auto with real. -apply Rmult_le_reg_l with (r := r); auto. -rewrite <- E1; repeat rewrite Rmult_0_l; auto. + forall (p q:R) r, 0 <= r -> Rmax (r * p) (r * q) = r * Rmax p q. +Proof. + intros p q r H; unfold Rmax in |- *. + case (Rle_dec p q); case (Rle_dec (r * p) (r * q)); auto; intros H1 H2; auto. + case H; intros E1. + case H1; auto with real. + rewrite <- E1; repeat rewrite Rmult_0_l; auto. + case H; intros E1. + case H2; auto with real. + apply Rmult_le_reg_l with (r := r); auto. + rewrite <- E1; repeat rewrite Rmult_0_l; auto. Qed. Lemma Rmax_stable_in_negreal : forall x y:negreal, Rmax x y < 0. -intros; unfold Rmax in |- *; case (Rle_dec x y); intro; - [ apply (cond_neg y) | apply (cond_neg x) ]. +Proof. + intros; unfold Rmax in |- *; case (Rle_dec x y); intro; + [ apply (cond_neg y) | apply (cond_neg x) ]. Qed. (*******************************) -(** Rabsolu *) +(** * Rabsolu *) (*******************************) (*********) Lemma Rcase_abs : forall r, {r < 0} + {r >= 0}. -intro; generalize (Rle_dec 0 r); intro X; elim X; intro; clear X. -right; apply (Rle_ge 0 r a). -left; fold (0 > r) in |- *; apply (Rnot_le_lt 0 r b). +Proof. + intro; generalize (Rle_dec 0 r); intro X; elim X; intro; clear X. + right; apply (Rle_ge 0 r a). + left; fold (0 > r) in |- *; apply (Rnot_le_lt 0 r b). Qed. (*********) Definition Rabs r : R := match Rcase_abs r with - | left _ => - r - | right _ => r + | left _ => - r + | right _ => r end. (*********) Lemma Rabs_R0 : Rabs 0 = 0. -unfold Rabs in |- *; case (Rcase_abs 0); auto; intro. -generalize (Rlt_irrefl 0); intro; elimtype False; auto. +Proof. + unfold Rabs in |- *; case (Rcase_abs 0); auto; intro. + generalize (Rlt_irrefl 0); intro; elimtype False; auto. Qed. Lemma Rabs_R1 : Rabs 1 = 1. +Proof. unfold Rabs in |- *; case (Rcase_abs 1); auto with real. intros H; absurd (1 < 0); auto with real. Qed. (*********) Lemma Rabs_no_R0 : forall r, r <> 0 -> Rabs r <> 0. -intros; unfold Rabs in |- *; case (Rcase_abs r); intro; auto. -apply Ropp_neq_0_compat; auto. +Proof. + intros; unfold Rabs in |- *; case (Rcase_abs r); intro; auto. + apply Ropp_neq_0_compat; auto. Qed. (*********) Lemma Rabs_left : forall r, r < 0 -> Rabs r = - r. -intros; unfold Rabs in |- *; case (Rcase_abs r); trivial; intro; - absurd (r >= 0). -exact (Rlt_not_ge r 0 H). -assumption. +Proof. + intros; unfold Rabs in |- *; case (Rcase_abs r); trivial; intro; + absurd (r >= 0). + exact (Rlt_not_ge r 0 H). + assumption. Qed. (*********) Lemma Rabs_right : forall r, r >= 0 -> Rabs r = r. -intros; unfold Rabs in |- *; case (Rcase_abs r); intro. -absurd (r >= 0). -exact (Rlt_not_ge r 0 r0). -assumption. -trivial. +Proof. + intros; unfold Rabs in |- *; case (Rcase_abs r); intro. + absurd (r >= 0). + exact (Rlt_not_ge r 0 r0). + assumption. + trivial. Qed. Lemma Rabs_left1 : forall a:R, a <= 0 -> Rabs a = - a. -intros a H; case H; intros H1. -apply Rabs_left; auto. -rewrite H1; simpl in |- *; rewrite Rabs_right; auto with real. +Proof. + intros a H; case H; intros H1. + apply Rabs_left; auto. + rewrite H1; simpl in |- *; rewrite Rabs_right; auto with real. Qed. (*********) Lemma Rabs_pos : forall x:R, 0 <= Rabs x. -intros; unfold Rabs in |- *; case (Rcase_abs x); intro. -generalize (Ropp_lt_gt_contravar x 0 r); intro; unfold Rgt in H; - rewrite Ropp_0 in H; unfold Rle in |- *; left; assumption. -apply Rge_le; assumption. +Proof. + intros; unfold Rabs in |- *; case (Rcase_abs x); intro. + generalize (Ropp_lt_gt_contravar x 0 r); intro; unfold Rgt in H; + rewrite Ropp_0 in H; unfold Rle in |- *; left; assumption. + apply Rge_le; assumption. Qed. Lemma RRle_abs : forall x:R, x <= Rabs x. -intro; unfold Rabs in |- *; case (Rcase_abs x); intros; fourier. +Proof. + intro; unfold Rabs in |- *; case (Rcase_abs x); intros; fourier. Qed. (*********) Lemma Rabs_pos_eq : forall x:R, 0 <= x -> Rabs x = x. -intros; unfold Rabs in |- *; case (Rcase_abs x); intro; - [ generalize (Rgt_not_le 0 x r); intro; elimtype False; auto | trivial ]. +Proof. + intros; unfold Rabs in |- *; case (Rcase_abs x); intro; + [ generalize (Rgt_not_le 0 x r); intro; elimtype False; auto | trivial ]. Qed. (*********) Lemma Rabs_Rabsolu : forall x:R, Rabs (Rabs x) = Rabs x. -intro; apply (Rabs_pos_eq (Rabs x) (Rabs_pos x)). +Proof. + intro; apply (Rabs_pos_eq (Rabs x) (Rabs_pos x)). Qed. (*********) Lemma Rabs_pos_lt : forall x:R, x <> 0 -> 0 < Rabs x. -intros; generalize (Rabs_pos x); intro; unfold Rle in H0; elim H0; intro; - auto. -elimtype False; clear H0; elim H; clear H; generalize H1; unfold Rabs in |- *; - case (Rcase_abs x); intros; auto. -clear r H1; generalize (Rplus_eq_compat_l x 0 (- x) H0); - rewrite (let (H1, H2) := Rplus_ne x in H1); rewrite (Rplus_opp_r x); - trivial. +Proof. + intros; generalize (Rabs_pos x); intro; unfold Rle in H0; elim H0; intro; + auto. + elimtype False; clear H0; elim H; clear H; generalize H1; unfold Rabs in |- *; + case (Rcase_abs x); intros; auto. + clear r H1; generalize (Rplus_eq_compat_l x 0 (- x) H0); + rewrite (let (H1, H2) := Rplus_ne x in H1); rewrite (Rplus_opp_r x); + trivial. Qed. (*********) Lemma Rabs_minus_sym : forall x y:R, Rabs (x - y) = Rabs (y - x). -intros; unfold Rabs in |- *; case (Rcase_abs (x - y)); - case (Rcase_abs (y - x)); intros. - generalize (Rminus_lt y x r); generalize (Rminus_lt x y r0); intros; - generalize (Rlt_asym x y H); intro; elimtype False; - auto. -rewrite (Ropp_minus_distr x y); trivial. -rewrite (Ropp_minus_distr y x); trivial. -unfold Rge in r, r0; elim r; elim r0; intros; clear r r0. -generalize (Ropp_lt_gt_0_contravar (x - y) H); rewrite (Ropp_minus_distr x y); - intro; unfold Rgt in H0; generalize (Rlt_asym 0 (y - x) H0); - intro; elimtype False; auto. -rewrite (Rminus_diag_uniq x y H); trivial. -rewrite (Rminus_diag_uniq y x H0); trivial. -rewrite (Rminus_diag_uniq y x H0); trivial. +Proof. + intros; unfold Rabs in |- *; case (Rcase_abs (x - y)); + case (Rcase_abs (y - x)); intros. + generalize (Rminus_lt y x r); generalize (Rminus_lt x y r0); intros; + generalize (Rlt_asym x y H); intro; elimtype False; + auto. + rewrite (Ropp_minus_distr x y); trivial. + rewrite (Ropp_minus_distr y x); trivial. + unfold Rge in r, r0; elim r; elim r0; intros; clear r r0. + generalize (Ropp_lt_gt_0_contravar (x - y) H); rewrite (Ropp_minus_distr x y); + intro; unfold Rgt in H0; generalize (Rlt_asym 0 (y - x) H0); + intro; elimtype False; auto. + rewrite (Rminus_diag_uniq x y H); trivial. + rewrite (Rminus_diag_uniq y x H0); trivial. + rewrite (Rminus_diag_uniq y x H0); trivial. Qed. (*********) Lemma Rabs_mult : forall x y:R, Rabs (x * y) = Rabs x * Rabs y. -intros; unfold Rabs in |- *; case (Rcase_abs (x * y)); case (Rcase_abs x); - case (Rcase_abs y); intros; auto. -generalize (Rmult_lt_gt_compat_neg_l y x 0 r r0); intro; - rewrite (Rmult_0_r y) in H; generalize (Rlt_asym (x * y) 0 r1); - intro; unfold Rgt in H; elimtype False; rewrite (Rmult_comm y x) in H; - auto. -rewrite (Ropp_mult_distr_l_reverse x y); trivial. -rewrite (Rmult_comm x (- y)); rewrite (Ropp_mult_distr_l_reverse y x); - rewrite (Rmult_comm x y); trivial. -unfold Rge in r, r0; elim r; elim r0; clear r r0; intros; unfold Rgt in H, H0. -generalize (Rmult_lt_compat_l x 0 y H H0); intro; rewrite (Rmult_0_r x) in H1; - generalize (Rlt_asym (x * y) 0 r1); intro; elimtype False; - auto. -rewrite H in r1; rewrite (Rmult_0_l y) in r1; generalize (Rlt_irrefl 0); - intro; elimtype False; auto. -rewrite H0 in r1; rewrite (Rmult_0_r x) in r1; generalize (Rlt_irrefl 0); - intro; elimtype False; auto. -rewrite H0 in r1; rewrite (Rmult_0_r x) in r1; generalize (Rlt_irrefl 0); - intro; elimtype False; auto. -rewrite (Rmult_opp_opp x y); trivial. -unfold Rge in r, r1; elim r; elim r1; clear r r1; intros; unfold Rgt in H0, H. -generalize (Rmult_lt_compat_l y x 0 H0 r0); intro; - rewrite (Rmult_0_r y) in H1; rewrite (Rmult_comm y x) in H1; - generalize (Rlt_asym (x * y) 0 H1); intro; elimtype False; - auto. -generalize (Rlt_dichotomy_converse x 0 (or_introl (x > 0) r0)); - generalize (Rlt_dichotomy_converse y 0 (or_intror (y < 0) H0)); - intros; generalize (Rmult_integral x y H); intro; - elim H3; intro; elimtype False; auto. -rewrite H0 in H; rewrite (Rmult_0_r x) in H; unfold Rgt in H; - generalize (Rlt_irrefl 0); intro; elimtype False; - auto. -rewrite H0; rewrite (Rmult_0_r x); rewrite (Rmult_0_r (- x)); trivial. -unfold Rge in r0, r1; elim r0; elim r1; clear r0 r1; intros; - unfold Rgt in H0, H. -generalize (Rmult_lt_compat_l x y 0 H0 r); intro; rewrite (Rmult_0_r x) in H1; - generalize (Rlt_asym (x * y) 0 H1); intro; elimtype False; - auto. -generalize (Rlt_dichotomy_converse y 0 (or_introl (y > 0) r)); - generalize (Rlt_dichotomy_converse 0 x (or_introl (0 > x) H0)); - intros; generalize (Rmult_integral x y H); intro; - elim H3; intro; elimtype False; auto. -rewrite H0 in H; rewrite (Rmult_0_l y) in H; unfold Rgt in H; - generalize (Rlt_irrefl 0); intro; elimtype False; - auto. -rewrite H0; rewrite (Rmult_0_l y); rewrite (Rmult_0_l (- y)); trivial. +Proof. + intros; unfold Rabs in |- *; case (Rcase_abs (x * y)); case (Rcase_abs x); + case (Rcase_abs y); intros; auto. + generalize (Rmult_lt_gt_compat_neg_l y x 0 r r0); intro; + rewrite (Rmult_0_r y) in H; generalize (Rlt_asym (x * y) 0 r1); + intro; unfold Rgt in H; elimtype False; rewrite (Rmult_comm y x) in H; + auto. + rewrite (Ropp_mult_distr_l_reverse x y); trivial. + rewrite (Rmult_comm x (- y)); rewrite (Ropp_mult_distr_l_reverse y x); + rewrite (Rmult_comm x y); trivial. + unfold Rge in r, r0; elim r; elim r0; clear r r0; intros; unfold Rgt in H, H0. + generalize (Rmult_lt_compat_l x 0 y H H0); intro; rewrite (Rmult_0_r x) in H1; + generalize (Rlt_asym (x * y) 0 r1); intro; elimtype False; + auto. + rewrite H in r1; rewrite (Rmult_0_l y) in r1; generalize (Rlt_irrefl 0); + intro; elimtype False; auto. + rewrite H0 in r1; rewrite (Rmult_0_r x) in r1; generalize (Rlt_irrefl 0); + intro; elimtype False; auto. + rewrite H0 in r1; rewrite (Rmult_0_r x) in r1; generalize (Rlt_irrefl 0); + intro; elimtype False; auto. + rewrite (Rmult_opp_opp x y); trivial. + unfold Rge in r, r1; elim r; elim r1; clear r r1; intros; unfold Rgt in H0, H. + generalize (Rmult_lt_compat_l y x 0 H0 r0); intro; + rewrite (Rmult_0_r y) in H1; rewrite (Rmult_comm y x) in H1; + generalize (Rlt_asym (x * y) 0 H1); intro; elimtype False; + auto. + generalize (Rlt_dichotomy_converse x 0 (or_introl (x > 0) r0)); + generalize (Rlt_dichotomy_converse y 0 (or_intror (y < 0) H0)); + intros; generalize (Rmult_integral x y H); intro; + elim H3; intro; elimtype False; auto. + rewrite H0 in H; rewrite (Rmult_0_r x) in H; unfold Rgt in H; + generalize (Rlt_irrefl 0); intro; elimtype False; + auto. + rewrite H0; rewrite (Rmult_0_r x); rewrite (Rmult_0_r (- x)); trivial. + unfold Rge in r0, r1; elim r0; elim r1; clear r0 r1; intros; + unfold Rgt in H0, H. + generalize (Rmult_lt_compat_l x y 0 H0 r); intro; rewrite (Rmult_0_r x) in H1; + generalize (Rlt_asym (x * y) 0 H1); intro; elimtype False; + auto. + generalize (Rlt_dichotomy_converse y 0 (or_introl (y > 0) r)); + generalize (Rlt_dichotomy_converse 0 x (or_introl (0 > x) H0)); + intros; generalize (Rmult_integral x y H); intro; + elim H3; intro; elimtype False; auto. + rewrite H0 in H; rewrite (Rmult_0_l y) in H; unfold Rgt in H; + generalize (Rlt_irrefl 0); intro; elimtype False; + auto. + rewrite H0; rewrite (Rmult_0_l y); rewrite (Rmult_0_l (- y)); trivial. Qed. (*********) Lemma Rabs_Rinv : forall r, r <> 0 -> Rabs (/ r) = / Rabs r. -intro; unfold Rabs in |- *; case (Rcase_abs r); case (Rcase_abs (/ r)); auto; - intros. -apply Ropp_inv_permute; auto. -generalize (Rinv_lt_0_compat r r1); intro; unfold Rge in r0; elim r0; intros. -unfold Rgt in H1; generalize (Rlt_asym 0 (/ r) H1); intro; elimtype False; - auto. -generalize (Rlt_dichotomy_converse (/ r) 0 (or_introl (/ r > 0) H0)); intro; - elimtype False; auto. -unfold Rge in r1; elim r1; clear r1; intro. -unfold Rgt in H0; generalize (Rlt_asym 0 (/ r) (Rinv_0_lt_compat r H0)); - intro; elimtype False; auto. -elimtype False; auto. +Proof. + intro; unfold Rabs in |- *; case (Rcase_abs r); case (Rcase_abs (/ r)); auto; + intros. + apply Ropp_inv_permute; auto. + generalize (Rinv_lt_0_compat r r1); intro; unfold Rge in r0; elim r0; intros. + unfold Rgt in H1; generalize (Rlt_asym 0 (/ r) H1); intro; elimtype False; + auto. + generalize (Rlt_dichotomy_converse (/ r) 0 (or_introl (/ r > 0) H0)); intro; + elimtype False; auto. + unfold Rge in r1; elim r1; clear r1; intro. + unfold Rgt in H0; generalize (Rlt_asym 0 (/ r) (Rinv_0_lt_compat r H0)); + intro; elimtype False; auto. + elimtype False; auto. Qed. Lemma Rabs_Ropp : forall x:R, Rabs (- x) = Rabs x. -intro; cut (- x = -1 * x). -intros; rewrite H. -rewrite Rabs_mult. -cut (Rabs (-1) = 1). -intros; rewrite H0. -ring. -unfold Rabs in |- *; case (Rcase_abs (-1)). -intro; ring. -intro H0; generalize (Rge_le (-1) 0 H0); intros. -generalize (Ropp_le_ge_contravar 0 (-1) H1). -rewrite Ropp_involutive; rewrite Ropp_0. -intro; generalize (Rgt_not_le 1 0 Rlt_0_1); intro; generalize (Rge_le 0 1 H2); - intro; elimtype False; auto. -ring. +Proof. + intro; cut (- x = -1 * x). + intros; rewrite H. + rewrite Rabs_mult. + cut (Rabs (-1) = 1). + intros; rewrite H0. + ring. + unfold Rabs in |- *; case (Rcase_abs (-1)). + intro; ring. + intro H0; generalize (Rge_le (-1) 0 H0); intros. + generalize (Ropp_le_ge_contravar 0 (-1) H1). + rewrite Ropp_involutive; rewrite Ropp_0. + intro; generalize (Rgt_not_le 1 0 Rlt_0_1); intro; generalize (Rge_le 0 1 H2); + intro; elimtype False; auto. + ring. Qed. (*********) Lemma Rabs_triang : forall a b:R, Rabs (a + b) <= Rabs a + Rabs b. -intros a b; unfold Rabs in |- *; case (Rcase_abs (a + b)); case (Rcase_abs a); - case (Rcase_abs b); intros. -apply (Req_le (- (a + b)) (- a + - b)); rewrite (Ropp_plus_distr a b); - reflexivity. +Proof. + intros a b; unfold Rabs in |- *; case (Rcase_abs (a + b)); case (Rcase_abs a); + case (Rcase_abs b); intros. + apply (Req_le (- (a + b)) (- a + - b)); rewrite (Ropp_plus_distr a b); + reflexivity. (**) -rewrite (Ropp_plus_distr a b); apply (Rplus_le_compat_l (- a) (- b) b); - unfold Rle in |- *; unfold Rge in r; elim r; intro. -left; unfold Rgt in H; generalize (Rplus_lt_compat_l (- b) 0 b H); intro; - elim (Rplus_ne (- b)); intros v w; rewrite v in H0; - clear v w; rewrite (Rplus_opp_l b) in H0; apply (Rlt_trans (- b) 0 b H0 H). -right; rewrite H; apply Ropp_0. + rewrite (Ropp_plus_distr a b); apply (Rplus_le_compat_l (- a) (- b) b); + unfold Rle in |- *; unfold Rge in r; elim r; intro. + left; unfold Rgt in H; generalize (Rplus_lt_compat_l (- b) 0 b H); intro; + elim (Rplus_ne (- b)); intros v w; rewrite v in H0; + clear v w; rewrite (Rplus_opp_l b) in H0; apply (Rlt_trans (- b) 0 b H0 H). + right; rewrite H; apply Ropp_0. (**) -rewrite (Ropp_plus_distr a b); rewrite (Rplus_comm (- a) (- b)); - rewrite (Rplus_comm a (- b)); apply (Rplus_le_compat_l (- b) (- a) a); - unfold Rle in |- *; unfold Rge in r0; elim r0; intro. -left; unfold Rgt in H; generalize (Rplus_lt_compat_l (- a) 0 a H); intro; - elim (Rplus_ne (- a)); intros v w; rewrite v in H0; - clear v w; rewrite (Rplus_opp_l a) in H0; apply (Rlt_trans (- a) 0 a H0 H). -right; rewrite H; apply Ropp_0. + rewrite (Ropp_plus_distr a b); rewrite (Rplus_comm (- a) (- b)); + rewrite (Rplus_comm a (- b)); apply (Rplus_le_compat_l (- b) (- a) a); + unfold Rle in |- *; unfold Rge in r0; elim r0; intro. + left; unfold Rgt in H; generalize (Rplus_lt_compat_l (- a) 0 a H); intro; + elim (Rplus_ne (- a)); intros v w; rewrite v in H0; + clear v w; rewrite (Rplus_opp_l a) in H0; apply (Rlt_trans (- a) 0 a H0 H). + right; rewrite H; apply Ropp_0. (**) -elimtype False; generalize (Rplus_ge_compat_l a b 0 r); intro; - elim (Rplus_ne a); intros v w; rewrite v in H; clear v w; - generalize (Rge_trans (a + b) a 0 H r0); intro; clear H; - unfold Rge in H0; elim H0; intro; clear H0. -unfold Rgt in H; generalize (Rlt_asym (a + b) 0 r1); intro; auto. -absurd (a + b = 0); auto. -apply (Rlt_dichotomy_converse (a + b) 0); left; assumption. + elimtype False; generalize (Rplus_ge_compat_l a b 0 r); intro; + elim (Rplus_ne a); intros v w; rewrite v in H; clear v w; + generalize (Rge_trans (a + b) a 0 H r0); intro; clear H; + unfold Rge in H0; elim H0; intro; clear H0. + unfold Rgt in H; generalize (Rlt_asym (a + b) 0 r1); intro; auto. + absurd (a + b = 0); auto. + apply (Rlt_dichotomy_converse (a + b) 0); left; assumption. (**) -elimtype False; generalize (Rplus_lt_compat_l a b 0 r); intro; - elim (Rplus_ne a); intros v w; rewrite v in H; clear v w; - generalize (Rlt_trans (a + b) a 0 H r0); intro; clear H; - unfold Rge in r1; elim r1; clear r1; intro. -unfold Rgt in H; generalize (Rlt_trans (a + b) 0 (a + b) H0 H); intro; - apply (Rlt_irrefl (a + b)); assumption. -rewrite H in H0; apply (Rlt_irrefl 0); assumption. + elimtype False; generalize (Rplus_lt_compat_l a b 0 r); intro; + elim (Rplus_ne a); intros v w; rewrite v in H; clear v w; + generalize (Rlt_trans (a + b) a 0 H r0); intro; clear H; + unfold Rge in r1; elim r1; clear r1; intro. + unfold Rgt in H; generalize (Rlt_trans (a + b) 0 (a + b) H0 H); intro; + apply (Rlt_irrefl (a + b)); assumption. + rewrite H in H0; apply (Rlt_irrefl 0); assumption. (**) -rewrite (Rplus_comm a b); rewrite (Rplus_comm (- a) b); - apply (Rplus_le_compat_l b a (- a)); apply (Rminus_le a (- a)); - unfold Rminus in |- *; rewrite (Ropp_involutive a); - generalize (Rplus_lt_compat_l a a 0 r0); clear r r1; - intro; elim (Rplus_ne a); intros v w; rewrite v in H; - clear v w; generalize (Rlt_trans (a + a) a 0 H r0); - intro; apply (Rlt_le (a + a) 0 H0). + rewrite (Rplus_comm a b); rewrite (Rplus_comm (- a) b); + apply (Rplus_le_compat_l b a (- a)); apply (Rminus_le a (- a)); + unfold Rminus in |- *; rewrite (Ropp_involutive a); + generalize (Rplus_lt_compat_l a a 0 r0); clear r r1; + intro; elim (Rplus_ne a); intros v w; rewrite v in H; + clear v w; generalize (Rlt_trans (a + a) a 0 H r0); + intro; apply (Rlt_le (a + a) 0 H0). (**) -apply (Rplus_le_compat_l a b (- b)); apply (Rminus_le b (- b)); - unfold Rminus in |- *; rewrite (Ropp_involutive b); - generalize (Rplus_lt_compat_l b b 0 r); clear r0 r1; - intro; elim (Rplus_ne b); intros v w; rewrite v in H; - clear v w; generalize (Rlt_trans (b + b) b 0 H r); - intro; apply (Rlt_le (b + b) 0 H0). + apply (Rplus_le_compat_l a b (- b)); apply (Rminus_le b (- b)); + unfold Rminus in |- *; rewrite (Ropp_involutive b); + generalize (Rplus_lt_compat_l b b 0 r); clear r0 r1; + intro; elim (Rplus_ne b); intros v w; rewrite v in H; + clear v w; generalize (Rlt_trans (b + b) b 0 H r); + intro; apply (Rlt_le (b + b) 0 H0). (**) -unfold Rle in |- *; right; reflexivity. + unfold Rle in |- *; right; reflexivity. Qed. (*********) Lemma Rabs_triang_inv : forall a b:R, Rabs a - Rabs b <= Rabs (a - b). -intros; apply (Rplus_le_reg_l (Rabs b) (Rabs a - Rabs b) (Rabs (a - b))); - unfold Rminus in |- *; rewrite <- (Rplus_assoc (Rabs b) (Rabs a) (- Rabs b)); - rewrite (Rplus_comm (Rabs b) (Rabs a)); - rewrite (Rplus_assoc (Rabs a) (Rabs b) (- Rabs b)); - rewrite (Rplus_opp_r (Rabs b)); rewrite (proj1 (Rplus_ne (Rabs a))); - replace (Rabs a) with (Rabs (a + 0)). - rewrite <- (Rplus_opp_r b); rewrite <- (Rplus_assoc a b (- b)); - rewrite (Rplus_comm a b); rewrite (Rplus_assoc b a (- b)). - exact (Rabs_triang b (a + - b)). - rewrite (proj1 (Rplus_ne a)); trivial. +Proof. + intros; apply (Rplus_le_reg_l (Rabs b) (Rabs a - Rabs b) (Rabs (a - b))); + unfold Rminus in |- *; rewrite <- (Rplus_assoc (Rabs b) (Rabs a) (- Rabs b)); + rewrite (Rplus_comm (Rabs b) (Rabs a)); + rewrite (Rplus_assoc (Rabs a) (Rabs b) (- Rabs b)); + rewrite (Rplus_opp_r (Rabs b)); rewrite (proj1 (Rplus_ne (Rabs a))); + replace (Rabs a) with (Rabs (a + 0)). + rewrite <- (Rplus_opp_r b); rewrite <- (Rplus_assoc a b (- b)); + rewrite (Rplus_comm a b); rewrite (Rplus_assoc b a (- b)). + exact (Rabs_triang b (a + - b)). + rewrite (proj1 (Rplus_ne a)); trivial. Qed. (* ||a|-|b||<=|a-b| *) Lemma Rabs_triang_inv2 : forall a b:R, Rabs (Rabs a - Rabs b) <= Rabs (a - b). -cut - (forall a b:R, Rabs b <= Rabs a -> Rabs (Rabs a - Rabs b) <= Rabs (a - b)). -intros; destruct (Rtotal_order (Rabs a) (Rabs b)) as [Hlt| [Heq| Hgt]]. -rewrite <- (Rabs_Ropp (Rabs a - Rabs b)); rewrite <- (Rabs_Ropp (a - b)); - do 2 rewrite Ropp_minus_distr. -apply H; left; assumption. -rewrite Heq; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; - apply Rabs_pos. -apply H; left; assumption. -intros; replace (Rabs (Rabs a - Rabs b)) with (Rabs a - Rabs b). -apply Rabs_triang_inv. -rewrite (Rabs_right (Rabs a - Rabs b)); - [ reflexivity - | apply Rle_ge; apply Rplus_le_reg_l with (Rabs b); rewrite Rplus_0_r; - replace (Rabs b + (Rabs a - Rabs b)) with (Rabs a); - [ assumption | ring ] ]. +Proof. + cut + (forall a b:R, Rabs b <= Rabs a -> Rabs (Rabs a - Rabs b) <= Rabs (a - b)). + intros; destruct (Rtotal_order (Rabs a) (Rabs b)) as [Hlt| [Heq| Hgt]]. + rewrite <- (Rabs_Ropp (Rabs a - Rabs b)); rewrite <- (Rabs_Ropp (a - b)); + do 2 rewrite Ropp_minus_distr. + apply H; left; assumption. + rewrite Heq; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + apply Rabs_pos. + apply H; left; assumption. + intros; replace (Rabs (Rabs a - Rabs b)) with (Rabs a - Rabs b). + apply Rabs_triang_inv. + rewrite (Rabs_right (Rabs a - Rabs b)); + [ reflexivity + | apply Rle_ge; apply Rplus_le_reg_l with (Rabs b); rewrite Rplus_0_r; + replace (Rabs b + (Rabs a - Rabs b)) with (Rabs a); + [ assumption | ring ] ]. Qed. (*********) Lemma Rabs_def1 : forall x a:R, x < a -> - a < x -> Rabs x < a. -unfold Rabs in |- *; intros; case (Rcase_abs x); intro. -generalize (Ropp_lt_gt_contravar (- a) x H0); unfold Rgt in |- *; - rewrite Ropp_involutive; intro; assumption. -assumption. +Proof. + unfold Rabs in |- *; intros; case (Rcase_abs x); intro. + generalize (Ropp_lt_gt_contravar (- a) x H0); unfold Rgt in |- *; + rewrite Ropp_involutive; intro; assumption. + assumption. Qed. (*********) Lemma Rabs_def2 : forall x a:R, Rabs x < a -> x < a /\ - a < x. -unfold Rabs in |- *; intro x; case (Rcase_abs x); intros. -generalize (Ropp_gt_lt_0_contravar x r); unfold Rgt in |- *; intro; - generalize (Rlt_trans 0 (- x) a H0 H); intro; split. -apply (Rlt_trans x 0 a r H1). -generalize (Ropp_lt_gt_contravar (- x) a H); rewrite (Ropp_involutive x); - unfold Rgt in |- *; trivial. -fold (a > x) in H; generalize (Rgt_ge_trans a x 0 H r); intro; - generalize (Ropp_lt_gt_0_contravar a H0); intro; fold (0 > - a) in |- *; - generalize (Rge_gt_trans x 0 (- a) r H1); unfold Rgt in |- *; - intro; split; assumption. +Proof. + unfold Rabs in |- *; intro x; case (Rcase_abs x); intros. + generalize (Ropp_gt_lt_0_contravar x r); unfold Rgt in |- *; intro; + generalize (Rlt_trans 0 (- x) a H0 H); intro; split. + apply (Rlt_trans x 0 a r H1). + generalize (Ropp_lt_gt_contravar (- x) a H); rewrite (Ropp_involutive x); + unfold Rgt in |- *; trivial. + fold (a > x) in H; generalize (Rgt_ge_trans a x 0 H r); intro; + generalize (Ropp_lt_gt_0_contravar a H0); intro; fold (0 > - a) in |- *; + generalize (Rge_gt_trans x 0 (- a) r H1); unfold Rgt in |- *; + intro; split; assumption. Qed. Lemma RmaxAbs : - forall (p q:R) r, p <= q -> q <= r -> Rabs q <= Rmax (Rabs p) (Rabs r). -intros p q r H' H'0; case (Rle_or_lt 0 p); intros H'1. -repeat rewrite Rabs_right; auto with real. -apply Rle_trans with r; auto with real. -apply RmaxLess2; auto. -apply Rge_trans with p; auto with real; apply Rge_trans with q; - auto with real. -apply Rge_trans with p; auto with real. -rewrite (Rabs_left p); auto. -case (Rle_or_lt 0 q); intros H'2. -repeat rewrite Rabs_right; auto with real. -apply Rle_trans with r; auto. -apply RmaxLess2; auto. -apply Rge_trans with q; auto with real. -rewrite (Rabs_left q); auto. -case (Rle_or_lt 0 r); intros H'3. -repeat rewrite Rabs_right; auto with real. -apply Rle_trans with (- p); auto with real. -apply RmaxLess1; auto. -rewrite (Rabs_left r); auto. -apply Rle_trans with (- p); auto with real. -apply RmaxLess1; auto. + forall (p q:R) r, p <= q -> q <= r -> Rabs q <= Rmax (Rabs p) (Rabs r). +Proof. + intros p q r H' H'0; case (Rle_or_lt 0 p); intros H'1. + repeat rewrite Rabs_right; auto with real. + apply Rle_trans with r; auto with real. + apply RmaxLess2; auto. + apply Rge_trans with p; auto with real; apply Rge_trans with q; + auto with real. + apply Rge_trans with p; auto with real. + rewrite (Rabs_left p); auto. + case (Rle_or_lt 0 q); intros H'2. + repeat rewrite Rabs_right; auto with real. + apply Rle_trans with r; auto. + apply RmaxLess2; auto. + apply Rge_trans with q; auto with real. + rewrite (Rabs_left q); auto. + case (Rle_or_lt 0 r); intros H'3. + repeat rewrite Rabs_right; auto with real. + apply Rle_trans with (- p); auto with real. + apply RmaxLess1; auto. + rewrite (Rabs_left r); auto. + apply Rle_trans with (- p); auto with real. + apply RmaxLess1; auto. Qed. Lemma Rabs_Zabs : forall z:Z, Rabs (IZR z) = IZR (Zabs z). -intros z; case z; simpl in |- *; auto with real. -apply Rabs_right; auto with real. -intros p0; apply Rabs_right; auto with real zarith. -intros p0; rewrite Rabs_Ropp. -apply Rabs_right; auto with real zarith. +Proof. + intros z; case z; simpl in |- *; auto with real. + apply Rabs_right; auto with real. + intros p0; apply Rabs_right; auto with real zarith. + intros p0; rewrite Rabs_Ropp. + apply Rabs_right; auto with real zarith. Qed. diff --git a/theories/Reals/Rcomplete.v b/theories/Reals/Rcomplete.v index 2f11a404..16e12d7f 100644 --- a/theories/Reals/Rcomplete.v +++ b/theories/Reals/Rcomplete.v @@ -5,8 +5,8 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) - -(*i $Id: Rcomplete.v 5920 2004-07-16 20:01:26Z herbelin $ i*) + +(*i $Id: Rcomplete.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -24,175 +24,176 @@ Open Local Scope R_scope. (****************************************************) Theorem R_complete : - forall Un:nat -> R, Cauchy_crit Un -> sigT (fun l:R => Un_cv Un l). -intros. -set (Vn := sequence_minorant Un (cauchy_min Un H)). -set (Wn := sequence_majorant Un (cauchy_maj Un H)). -assert (H0 := maj_cv Un H). -fold Wn in H0. -assert (H1 := min_cv Un H). -fold Vn in H1. -elim H0; intros. -elim H1; intros. -cut (x = x0). -intros. -apply existT with x. -rewrite <- H2 in p0. -unfold Un_cv in |- *. -intros. -unfold Un_cv in p; unfold Un_cv in p0. -cut (0 < eps / 3). -intro. -elim (p (eps / 3) H4); intros. -elim (p0 (eps / 3) H4); intros. -exists (max x1 x2). -intros. -unfold R_dist in |- *. -apply Rle_lt_trans with (Rabs (Un n - Vn n) + Rabs (Vn n - x)). -replace (Un n - x) with (Un n - Vn n + (Vn n - x)); - [ apply Rabs_triang | ring ]. -apply Rle_lt_trans with (Rabs (Wn n - Vn n) + Rabs (Vn n - x)). -do 2 rewrite <- (Rplus_comm (Rabs (Vn n - x))). -apply Rplus_le_compat_l. -repeat rewrite Rabs_right. -unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- Vn n)); - apply Rplus_le_compat_l. -assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)). -fold Vn Wn in H8. -elim (H8 n); intros. -assumption. -apply Rle_ge. -unfold Rminus in |- *; apply Rplus_le_reg_l with (Vn n). -rewrite Rplus_0_r. -replace (Vn n + (Wn n + - Vn n)) with (Wn n); [ idtac | ring ]. -assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)). -fold Vn Wn in H8. -elim (H8 n); intros. -apply Rle_trans with (Un n); assumption. -apply Rle_ge. -unfold Rminus in |- *; apply Rplus_le_reg_l with (Vn n). -rewrite Rplus_0_r. -replace (Vn n + (Un n + - Vn n)) with (Un n); [ idtac | ring ]. -assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)). -fold Vn Wn in H8. -elim (H8 n); intros. -assumption. -apply Rle_lt_trans with (Rabs (Wn n - x) + Rabs (x - Vn n) + Rabs (Vn n - x)). -do 2 rewrite <- (Rplus_comm (Rabs (Vn n - x))). -apply Rplus_le_compat_l. -replace (Wn n - Vn n) with (Wn n - x + (x - Vn n)); - [ apply Rabs_triang | ring ]. -apply Rlt_le_trans with (eps / 3 + eps / 3 + eps / 3). -repeat apply Rplus_lt_compat. -unfold R_dist in H5. -apply H5. -unfold ge in |- *; apply le_trans with (max x1 x2). -apply le_max_l. -assumption. -rewrite <- Rabs_Ropp. -replace (- (x - Vn n)) with (Vn n - x); [ idtac | ring ]. -unfold R_dist in H6. -apply H6. -unfold ge in |- *; apply le_trans with (max x1 x2). -apply le_max_r. -assumption. -unfold R_dist in H6. -apply H6. -unfold ge in |- *; apply le_trans with (max x1 x2). -apply le_max_r. -assumption. -right. -pattern eps at 4 in |- *; replace eps with (3 * (eps / 3)). -ring. -unfold Rdiv in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m; discrR. -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. -apply cond_eq. -intros. -cut (0 < eps / 5). -intro. -unfold Un_cv in p; unfold Un_cv in p0. -unfold R_dist in p; unfold R_dist in p0. -elim (p (eps / 5) H3); intros N1 H4. -elim (p0 (eps / 5) H3); intros N2 H5. -unfold Cauchy_crit in H. -unfold R_dist in H. -elim (H (eps / 5) H3); intros N3 H6. -set (N := max (max N1 N2) N3). -apply Rle_lt_trans with (Rabs (x - Wn N) + Rabs (Wn N - x0)). -replace (x - x0) with (x - Wn N + (Wn N - x0)); [ apply Rabs_triang | ring ]. -apply Rle_lt_trans with - (Rabs (x - Wn N) + Rabs (Wn N - Vn N) + Rabs (Vn N - x0)). -rewrite Rplus_assoc. -apply Rplus_le_compat_l. -replace (Wn N - x0) with (Wn N - Vn N + (Vn N - x0)); - [ apply Rabs_triang | ring ]. -replace eps with (eps / 5 + 3 * (eps / 5) + eps / 5). -repeat apply Rplus_lt_compat. -rewrite <- Rabs_Ropp. -replace (- (x - Wn N)) with (Wn N - x); [ apply H4 | ring ]. -unfold ge, N in |- *. -apply le_trans with (max N1 N2); apply le_max_l. -unfold Wn, Vn in |- *. -unfold sequence_majorant, sequence_minorant in |- *. -assert - (H7 := - approx_maj (fun k:nat => Un (N + k)%nat) (maj_ss Un N (cauchy_maj Un H))). -assert - (H8 := - approx_min (fun k:nat => Un (N + k)%nat) (min_ss Un N (cauchy_min Un H))). -cut - (Wn N = - majorant (fun k:nat => Un (N + k)%nat) (maj_ss Un N (cauchy_maj Un H))). -cut - (Vn N = - minorant (fun k:nat => Un (N + k)%nat) (min_ss Un N (cauchy_min Un H))). -intros. -rewrite <- H9; rewrite <- H10. -rewrite <- H9 in H8. -rewrite <- H10 in H7. -elim (H7 (eps / 5) H3); intros k2 H11. -elim (H8 (eps / 5) H3); intros k1 H12. -apply Rle_lt_trans with - (Rabs (Wn N - Un (N + k2)%nat) + Rabs (Un (N + k2)%nat - Vn N)). -replace (Wn N - Vn N) with - (Wn N - Un (N + k2)%nat + (Un (N + k2)%nat - Vn N)); - [ apply Rabs_triang | ring ]. -apply Rle_lt_trans with - (Rabs (Wn N - Un (N + k2)%nat) + Rabs (Un (N + k2)%nat - Un (N + k1)%nat) + - Rabs (Un (N + k1)%nat - Vn N)). -rewrite Rplus_assoc. -apply Rplus_le_compat_l. -replace (Un (N + k2)%nat - Vn N) with - (Un (N + k2)%nat - Un (N + k1)%nat + (Un (N + k1)%nat - Vn N)); - [ apply Rabs_triang | ring ]. -replace (3 * (eps / 5)) with (eps / 5 + eps / 5 + eps / 5); - [ repeat apply Rplus_lt_compat | ring ]. -assumption. -apply H6. -unfold ge in |- *. -apply le_trans with N. -unfold N in |- *; apply le_max_r. -apply le_plus_l. -unfold ge in |- *. -apply le_trans with N. -unfold N in |- *; apply le_max_r. -apply le_plus_l. -rewrite <- Rabs_Ropp. -replace (- (Un (N + k1)%nat - Vn N)) with (Vn N - Un (N + k1)%nat); - [ assumption | ring ]. -reflexivity. -reflexivity. -apply H5. -unfold ge in |- *; apply le_trans with (max N1 N2). -apply le_max_r. -unfold N in |- *; apply le_max_l. -pattern eps at 4 in |- *; replace eps with (5 * (eps / 5)). -ring. -unfold Rdiv in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m. -discrR. -unfold Rdiv in |- *; apply Rmult_lt_0_compat. -assumption. -apply Rinv_0_lt_compat. -prove_sup0; try apply lt_O_Sn. -Qed.
\ No newline at end of file + forall Un:nat -> R, Cauchy_crit Un -> sigT (fun l:R => Un_cv Un l). +Proof. + intros. + set (Vn := sequence_minorant Un (cauchy_min Un H)). + set (Wn := sequence_majorant Un (cauchy_maj Un H)). + assert (H0 := maj_cv Un H). + fold Wn in H0. + assert (H1 := min_cv Un H). + fold Vn in H1. + elim H0; intros. + elim H1; intros. + cut (x = x0). + intros. + apply existT with x. + rewrite <- H2 in p0. + unfold Un_cv in |- *. + intros. + unfold Un_cv in p; unfold Un_cv in p0. + cut (0 < eps / 3). + intro. + elim (p (eps / 3) H4); intros. + elim (p0 (eps / 3) H4); intros. + exists (max x1 x2). + intros. + unfold R_dist in |- *. + apply Rle_lt_trans with (Rabs (Un n - Vn n) + Rabs (Vn n - x)). + replace (Un n - x) with (Un n - Vn n + (Vn n - x)); + [ apply Rabs_triang | ring ]. + apply Rle_lt_trans with (Rabs (Wn n - Vn n) + Rabs (Vn n - x)). + do 2 rewrite <- (Rplus_comm (Rabs (Vn n - x))). + apply Rplus_le_compat_l. + repeat rewrite Rabs_right. + unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- Vn n)); + apply Rplus_le_compat_l. + assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)). + fold Vn Wn in H8. + elim (H8 n); intros. + assumption. + apply Rle_ge. + unfold Rminus in |- *; apply Rplus_le_reg_l with (Vn n). + rewrite Rplus_0_r. + replace (Vn n + (Wn n + - Vn n)) with (Wn n); [ idtac | ring ]. + assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)). + fold Vn Wn in H8. + elim (H8 n); intros. + apply Rle_trans with (Un n); assumption. + apply Rle_ge. + unfold Rminus in |- *; apply Rplus_le_reg_l with (Vn n). + rewrite Rplus_0_r. + replace (Vn n + (Un n + - Vn n)) with (Un n); [ idtac | ring ]. + assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)). + fold Vn Wn in H8. + elim (H8 n); intros. + assumption. + apply Rle_lt_trans with (Rabs (Wn n - x) + Rabs (x - Vn n) + Rabs (Vn n - x)). + do 2 rewrite <- (Rplus_comm (Rabs (Vn n - x))). + apply Rplus_le_compat_l. + replace (Wn n - Vn n) with (Wn n - x + (x - Vn n)); + [ apply Rabs_triang | ring ]. + apply Rlt_le_trans with (eps / 3 + eps / 3 + eps / 3). + repeat apply Rplus_lt_compat. + unfold R_dist in H5. + apply H5. + unfold ge in |- *; apply le_trans with (max x1 x2). + apply le_max_l. + assumption. + rewrite <- Rabs_Ropp. + replace (- (x - Vn n)) with (Vn n - x); [ idtac | ring ]. + unfold R_dist in H6. + apply H6. + unfold ge in |- *; apply le_trans with (max x1 x2). + apply le_max_r. + assumption. + unfold R_dist in H6. + apply H6. + unfold ge in |- *; apply le_trans with (max x1 x2). + apply le_max_r. + assumption. + right. + pattern eps at 4 in |- *; replace eps with (3 * (eps / 3)). + ring. + unfold Rdiv in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m; discrR. + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. + apply cond_eq. + intros. + cut (0 < eps / 5). + intro. + unfold Un_cv in p; unfold Un_cv in p0. + unfold R_dist in p; unfold R_dist in p0. + elim (p (eps / 5) H3); intros N1 H4. + elim (p0 (eps / 5) H3); intros N2 H5. + unfold Cauchy_crit in H. + unfold R_dist in H. + elim (H (eps / 5) H3); intros N3 H6. + set (N := max (max N1 N2) N3). + apply Rle_lt_trans with (Rabs (x - Wn N) + Rabs (Wn N - x0)). + replace (x - x0) with (x - Wn N + (Wn N - x0)); [ apply Rabs_triang | ring ]. + apply Rle_lt_trans with + (Rabs (x - Wn N) + Rabs (Wn N - Vn N) + Rabs (Vn N - x0)). + rewrite Rplus_assoc. + apply Rplus_le_compat_l. + replace (Wn N - x0) with (Wn N - Vn N + (Vn N - x0)); + [ apply Rabs_triang | ring ]. + replace eps with (eps / 5 + 3 * (eps / 5) + eps / 5). + repeat apply Rplus_lt_compat. + rewrite <- Rabs_Ropp. + replace (- (x - Wn N)) with (Wn N - x); [ apply H4 | ring ]. + unfold ge, N in |- *. + apply le_trans with (max N1 N2); apply le_max_l. + unfold Wn, Vn in |- *. + unfold sequence_majorant, sequence_minorant in |- *. + assert + (H7 := + approx_maj (fun k:nat => Un (N + k)%nat) (maj_ss Un N (cauchy_maj Un H))). + assert + (H8 := + approx_min (fun k:nat => Un (N + k)%nat) (min_ss Un N (cauchy_min Un H))). + cut + (Wn N = + majorant (fun k:nat => Un (N + k)%nat) (maj_ss Un N (cauchy_maj Un H))). + cut + (Vn N = + minorant (fun k:nat => Un (N + k)%nat) (min_ss Un N (cauchy_min Un H))). + intros. + rewrite <- H9; rewrite <- H10. + rewrite <- H9 in H8. + rewrite <- H10 in H7. + elim (H7 (eps / 5) H3); intros k2 H11. + elim (H8 (eps / 5) H3); intros k1 H12. + apply Rle_lt_trans with + (Rabs (Wn N - Un (N + k2)%nat) + Rabs (Un (N + k2)%nat - Vn N)). + replace (Wn N - Vn N) with + (Wn N - Un (N + k2)%nat + (Un (N + k2)%nat - Vn N)); + [ apply Rabs_triang | ring ]. + apply Rle_lt_trans with + (Rabs (Wn N - Un (N + k2)%nat) + Rabs (Un (N + k2)%nat - Un (N + k1)%nat) + + Rabs (Un (N + k1)%nat - Vn N)). + rewrite Rplus_assoc. + apply Rplus_le_compat_l. + replace (Un (N + k2)%nat - Vn N) with + (Un (N + k2)%nat - Un (N + k1)%nat + (Un (N + k1)%nat - Vn N)); + [ apply Rabs_triang | ring ]. + replace (3 * (eps / 5)) with (eps / 5 + eps / 5 + eps / 5); + [ repeat apply Rplus_lt_compat | ring ]. + assumption. + apply H6. + unfold ge in |- *. + apply le_trans with N. + unfold N in |- *; apply le_max_r. + apply le_plus_l. + unfold ge in |- *. + apply le_trans with N. + unfold N in |- *; apply le_max_r. + apply le_plus_l. + rewrite <- Rabs_Ropp. + replace (- (Un (N + k1)%nat - Vn N)) with (Vn N - Un (N + k1)%nat); + [ assumption | ring ]. + reflexivity. + reflexivity. + apply H5. + unfold ge in |- *; apply le_trans with (max N1 N2). + apply le_max_r. + unfold N in |- *; apply le_max_l. + pattern eps at 4 in |- *; replace eps with (5 * (eps / 5)). + ring. + unfold Rdiv in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m. + discrR. + unfold Rdiv in |- *; apply Rmult_lt_0_compat. + assumption. + apply Rinv_0_lt_compat. + prove_sup0; try apply lt_O_Sn. +Qed. diff --git a/theories/Reals/Rdefinitions.v b/theories/Reals/Rdefinitions.v index 62aec6bc..f9ba589e 100644 --- a/theories/Reals/Rdefinitions.v +++ b/theories/Reals/Rdefinitions.v @@ -5,12 +5,11 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Rdefinitions.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Rdefinitions.v 9245 2006-10-17 12:53:34Z notin $ i*) (*********************************************************) (** Definitions for the axiomatization *) -(* *) (*********************************************************) Require Export ZArith_base. @@ -66,4 +65,4 @@ Infix ">" := Rgt : R_scope. Notation "x <= y <= z" := ((x <= y)%R /\ (y <= z)%R) : R_scope. Notation "x <= y < z" := ((x <= y)%R /\ (y < z)%R) : R_scope. Notation "x < y < z" := ((x < y)%R /\ (y < z)%R) : R_scope. -Notation "x < y <= z" := ((x < y)%R /\ (y <= z)%R) : R_scope.
\ No newline at end of file +Notation "x < y <= z" := ((x < y)%R /\ (y <= z)%R) : R_scope. diff --git a/theories/Reals/Rderiv.v b/theories/Reals/Rderiv.v index 42663de6..e2fd2efe 100644 --- a/theories/Reals/Rderiv.v +++ b/theories/Reals/Rderiv.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Rderiv.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Rderiv.v 9245 2006-10-17 12:53:34Z notin $ i*) (*********************************************************) (** Definition of the derivative,continuity *) @@ -34,398 +34,409 @@ Definition D_in (f d:R -> R) (D:R -> Prop) (x0:R) : Prop := (*********) Lemma cont_deriv : - forall (f d:R -> R) (D:R -> Prop) (x0:R), - D_in f d D x0 -> continue_in f D x0. -unfold continue_in in |- *; unfold D_in in |- *; unfold limit1_in in |- *; - unfold limit_in in |- *; unfold Rdiv in |- *; simpl in |- *; - intros; elim (H eps H0); clear H; intros; elim H; - clear H; intros; elim (Req_dec (d x0) 0); intro. -split with (Rmin 1 x); split. -elim (Rmin_Rgt 1 x 0); intros a b; apply (b (conj Rlt_0_1 H)). -intros; elim H3; clear H3; intros; - generalize (let (H1, H2) := Rmin_Rgt 1 x (R_dist x1 x0) in H1); - unfold Rgt in |- *; intro; elim (H5 H4); clear H5; - intros; generalize (H1 x1 (conj H3 H6)); clear H1; - intro; unfold D_x in H3; elim H3; intros. -rewrite H2 in H1; unfold R_dist in |- *; unfold R_dist in H1; - cut (Rabs (f x1 - f x0) < eps * Rabs (x1 - x0)). -intro; unfold R_dist in H5; - generalize (Rmult_lt_compat_l eps (Rabs (x1 - x0)) 1 H0 H5); - rewrite Rmult_1_r; intro; apply Rlt_trans with (r2 := eps * Rabs (x1 - x0)); - assumption. -rewrite (Rminus_0_r ((f x1 - f x0) * / (x1 - x0))) in H1; - rewrite Rabs_mult in H1; cut (x1 - x0 <> 0). -intro; rewrite (Rabs_Rinv (x1 - x0) H9) in H1; - generalize - (Rmult_lt_compat_l (Rabs (x1 - x0)) (Rabs (f x1 - f x0) * / Rabs (x1 - x0)) - eps (Rabs_pos_lt (x1 - x0) H9) H1); intro; rewrite Rmult_comm in H10; - rewrite Rmult_assoc in H10; rewrite Rinv_l in H10. -rewrite Rmult_1_r in H10; rewrite Rmult_comm; assumption. -apply Rabs_no_R0; auto. -apply Rminus_eq_contra; auto. + forall (f d:R -> R) (D:R -> Prop) (x0:R), + D_in f d D x0 -> continue_in f D x0. +Proof. + unfold continue_in in |- *; unfold D_in in |- *; unfold limit1_in in |- *; + unfold limit_in in |- *; unfold Rdiv in |- *; simpl in |- *; + intros; elim (H eps H0); clear H; intros; elim H; + clear H; intros; elim (Req_dec (d x0) 0); intro. + split with (Rmin 1 x); split. + elim (Rmin_Rgt 1 x 0); intros a b; apply (b (conj Rlt_0_1 H)). + intros; elim H3; clear H3; intros; + generalize (let (H1, H2) := Rmin_Rgt 1 x (R_dist x1 x0) in H1); + unfold Rgt in |- *; intro; elim (H5 H4); clear H5; + intros; generalize (H1 x1 (conj H3 H6)); clear H1; + intro; unfold D_x in H3; elim H3; intros. + rewrite H2 in H1; unfold R_dist in |- *; unfold R_dist in H1; + cut (Rabs (f x1 - f x0) < eps * Rabs (x1 - x0)). + intro; unfold R_dist in H5; + generalize (Rmult_lt_compat_l eps (Rabs (x1 - x0)) 1 H0 H5); + rewrite Rmult_1_r; intro; apply Rlt_trans with (r2 := eps * Rabs (x1 - x0)); + assumption. + rewrite (Rminus_0_r ((f x1 - f x0) * / (x1 - x0))) in H1; + rewrite Rabs_mult in H1; cut (x1 - x0 <> 0). + intro; rewrite (Rabs_Rinv (x1 - x0) H9) in H1; + generalize + (Rmult_lt_compat_l (Rabs (x1 - x0)) (Rabs (f x1 - f x0) * / Rabs (x1 - x0)) + eps (Rabs_pos_lt (x1 - x0) H9) H1); intro; rewrite Rmult_comm in H10; + rewrite Rmult_assoc in H10; rewrite Rinv_l in H10. + rewrite Rmult_1_r in H10; rewrite Rmult_comm; assumption. + apply Rabs_no_R0; auto. + apply Rminus_eq_contra; auto. (**) - split with (Rmin (Rmin (/ 2) x) (eps * / Rabs (2 * d x0))); split. -cut (Rmin (/ 2) x > 0). -cut (eps * / Rabs (2 * d x0) > 0). -intros; elim (Rmin_Rgt (Rmin (/ 2) x) (eps * / Rabs (2 * d x0)) 0); - intros a b; apply (b (conj H4 H3)). -apply Rmult_gt_0_compat; auto. -unfold Rgt in |- *; apply Rinv_0_lt_compat; apply Rabs_pos_lt; - apply Rmult_integral_contrapositive; split. -discrR. -assumption. -elim (Rmin_Rgt (/ 2) x 0); intros a b; cut (0 < 2). -intro; generalize (Rinv_0_lt_compat 2 H3); intro; fold (/ 2 > 0) in H4; - apply (b (conj H4 H)). -fourier. -intros; elim H3; clear H3; intros; - generalize - (let (H1, H2) := - Rmin_Rgt (Rmin (/ 2) x) (eps * / Rabs (2 * d x0)) (R_dist x1 x0) in - H1); unfold Rgt in |- *; intro; elim (H5 H4); clear H5; - intros; generalize (let (H1, H2) := Rmin_Rgt (/ 2) x (R_dist x1 x0) in H1); - unfold Rgt in |- *; intro; elim (H7 H5); clear H7; - intros; clear H4 H5; generalize (H1 x1 (conj H3 H8)); - clear H1; intro; unfold D_x in H3; elim H3; intros; - generalize (sym_not_eq H5); clear H5; intro H5; - generalize (Rminus_eq_contra x1 x0 H5); intro; generalize H1; - pattern (d x0) at 1 in |- *; - rewrite <- (let (H1, H2) := Rmult_ne (d x0) in H2); - rewrite <- (Rinv_l (x1 - x0) H9); unfold R_dist in |- *; - unfold Rminus at 1 in |- *; rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0))); - rewrite (Rmult_comm (/ (x1 - x0) * (x1 - x0)) (d x0)); - rewrite <- (Ropp_mult_distr_l_reverse (d x0) (/ (x1 - x0) * (x1 - x0))); - rewrite (Rmult_comm (- d x0) (/ (x1 - x0) * (x1 - x0))); - rewrite (Rmult_assoc (/ (x1 - x0)) (x1 - x0) (- d x0)); - rewrite <- - (Rmult_plus_distr_l (/ (x1 - x0)) (f x1 - f x0) ((x1 - x0) * - d x0)) - ; rewrite (Rabs_mult (/ (x1 - x0)) (f x1 - f x0 + (x1 - x0) * - d x0)); - clear H1; intro; - generalize - (Rmult_lt_compat_l (Rabs (x1 - x0)) - (Rabs (/ (x1 - x0)) * Rabs (f x1 - f x0 + (x1 - x0) * - d x0)) eps - (Rabs_pos_lt (x1 - x0) H9) H1); - rewrite <- - (Rmult_assoc (Rabs (x1 - x0)) (Rabs (/ (x1 - x0))) - (Rabs (f x1 - f x0 + (x1 - x0) * - d x0))); - rewrite (Rabs_Rinv (x1 - x0) H9); - rewrite (Rinv_r (Rabs (x1 - x0)) (Rabs_no_R0 (x1 - x0) H9)); - rewrite - (let (H1, H2) := Rmult_ne (Rabs (f x1 - f x0 + (x1 - x0) * - d x0)) in H2) - ; generalize (Rabs_triang_inv (f x1 - f x0) ((x1 - x0) * d x0)); - intro; rewrite (Rmult_comm (x1 - x0) (- d x0)); - rewrite (Ropp_mult_distr_l_reverse (d x0) (x1 - x0)); - fold (f x1 - f x0 - d x0 * (x1 - x0)) in |- *; - rewrite (Rmult_comm (x1 - x0) (d x0)) in H10; clear H1; - intro; - generalize - (Rle_lt_trans (Rabs (f x1 - f x0) - Rabs (d x0 * (x1 - x0))) - (Rabs (f x1 - f x0 - d x0 * (x1 - x0))) (Rabs (x1 - x0) * eps) H10 H1); - clear H1; intro; - generalize - (Rplus_lt_compat_l (Rabs (d x0 * (x1 - x0))) - (Rabs (f x1 - f x0) - Rabs (d x0 * (x1 - x0))) ( - Rabs (x1 - x0) * eps) H1); unfold Rminus at 2 in |- *; - rewrite (Rplus_comm (Rabs (f x1 - f x0)) (- Rabs (d x0 * (x1 - x0)))); - rewrite <- - (Rplus_assoc (Rabs (d x0 * (x1 - x0))) (- Rabs (d x0 * (x1 - x0))) - (Rabs (f x1 - f x0))); rewrite (Rplus_opp_r (Rabs (d x0 * (x1 - x0)))); - rewrite (let (H1, H2) := Rplus_ne (Rabs (f x1 - f x0)) in H2); - clear H1; intro; cut (Rabs (d x0 * (x1 - x0)) + Rabs (x1 - x0) * eps < eps). -intro; - apply - (Rlt_trans (Rabs (f x1 - f x0)) - (Rabs (d x0 * (x1 - x0)) + Rabs (x1 - x0) * eps) eps H1 H11). -clear H1 H5 H3 H10; generalize (Rabs_pos_lt (d x0) H2); intro; - unfold Rgt in H0; - generalize (Rmult_lt_compat_l eps (R_dist x1 x0) (/ 2) H0 H7); - clear H7; intro; - generalize - (Rmult_lt_compat_l (Rabs (d x0)) (R_dist x1 x0) ( - eps * / Rabs (2 * d x0)) H1 H6); clear H6; intro; - rewrite (Rmult_comm eps (R_dist x1 x0)) in H3; unfold R_dist in H3, H5; - rewrite <- (Rabs_mult (d x0) (x1 - x0)) in H5; - rewrite (Rabs_mult 2 (d x0)) in H5; cut (Rabs 2 <> 0). -intro; fold (Rabs (d x0) > 0) in H1; - rewrite - (Rinv_mult_distr (Rabs 2) (Rabs (d x0)) H6 - (Rlt_dichotomy_converse (Rabs (d x0)) 0 (or_intror (Rabs (d x0) < 0) H1))) - in H5; - rewrite (Rmult_comm (Rabs (d x0)) (eps * (/ Rabs 2 * / Rabs (d x0)))) in H5; - rewrite <- (Rmult_assoc eps (/ Rabs 2) (/ Rabs (d x0))) in H5; - rewrite (Rmult_assoc (eps * / Rabs 2) (/ Rabs (d x0)) (Rabs (d x0))) in H5; - rewrite - (Rinv_l (Rabs (d x0)) - (Rlt_dichotomy_converse (Rabs (d x0)) 0 (or_intror (Rabs (d x0) < 0) H1))) - in H5; rewrite (let (H1, H2) := Rmult_ne (eps * / Rabs 2) in H1) in H5; - cut (Rabs 2 = 2). -intro; rewrite H7 in H5; - generalize - (Rplus_lt_compat (Rabs (d x0 * (x1 - x0))) (eps * / 2) - (Rabs (x1 - x0) * eps) (eps * / 2) H5 H3); intro; - rewrite eps2 in H10; assumption. -unfold Rabs in |- *; case (Rcase_abs 2); auto. - intro; cut (0 < 2). -intro; generalize (Rlt_asym 0 2 H7); intro; elimtype False; auto. -fourier. -apply Rabs_no_R0. -discrR. + split with (Rmin (Rmin (/ 2) x) (eps * / Rabs (2 * d x0))); split. + cut (Rmin (/ 2) x > 0). + cut (eps * / Rabs (2 * d x0) > 0). + intros; elim (Rmin_Rgt (Rmin (/ 2) x) (eps * / Rabs (2 * d x0)) 0); + intros a b; apply (b (conj H4 H3)). + apply Rmult_gt_0_compat; auto. + unfold Rgt in |- *; apply Rinv_0_lt_compat; apply Rabs_pos_lt; + apply Rmult_integral_contrapositive; split. + discrR. + assumption. + elim (Rmin_Rgt (/ 2) x 0); intros a b; cut (0 < 2). + intro; generalize (Rinv_0_lt_compat 2 H3); intro; fold (/ 2 > 0) in H4; + apply (b (conj H4 H)). + fourier. + intros; elim H3; clear H3; intros; + generalize + (let (H1, H2) := + Rmin_Rgt (Rmin (/ 2) x) (eps * / Rabs (2 * d x0)) (R_dist x1 x0) in + H1); unfold Rgt in |- *; intro; elim (H5 H4); clear H5; + intros; generalize (let (H1, H2) := Rmin_Rgt (/ 2) x (R_dist x1 x0) in H1); + unfold Rgt in |- *; intro; elim (H7 H5); clear H7; + intros; clear H4 H5; generalize (H1 x1 (conj H3 H8)); + clear H1; intro; unfold D_x in H3; elim H3; intros; + generalize (sym_not_eq H5); clear H5; intro H5; + generalize (Rminus_eq_contra x1 x0 H5); intro; generalize H1; + pattern (d x0) at 1 in |- *; + rewrite <- (let (H1, H2) := Rmult_ne (d x0) in H2); + rewrite <- (Rinv_l (x1 - x0) H9); unfold R_dist in |- *; + unfold Rminus at 1 in |- *; rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0))); + rewrite (Rmult_comm (/ (x1 - x0) * (x1 - x0)) (d x0)); + rewrite <- (Ropp_mult_distr_l_reverse (d x0) (/ (x1 - x0) * (x1 - x0))); + rewrite (Rmult_comm (- d x0) (/ (x1 - x0) * (x1 - x0))); + rewrite (Rmult_assoc (/ (x1 - x0)) (x1 - x0) (- d x0)); + rewrite <- + (Rmult_plus_distr_l (/ (x1 - x0)) (f x1 - f x0) ((x1 - x0) * - d x0)) + ; rewrite (Rabs_mult (/ (x1 - x0)) (f x1 - f x0 + (x1 - x0) * - d x0)); + clear H1; intro; + generalize + (Rmult_lt_compat_l (Rabs (x1 - x0)) + (Rabs (/ (x1 - x0)) * Rabs (f x1 - f x0 + (x1 - x0) * - d x0)) eps + (Rabs_pos_lt (x1 - x0) H9) H1); + rewrite <- + (Rmult_assoc (Rabs (x1 - x0)) (Rabs (/ (x1 - x0))) + (Rabs (f x1 - f x0 + (x1 - x0) * - d x0))); + rewrite (Rabs_Rinv (x1 - x0) H9); + rewrite (Rinv_r (Rabs (x1 - x0)) (Rabs_no_R0 (x1 - x0) H9)); + rewrite + (let (H1, H2) := Rmult_ne (Rabs (f x1 - f x0 + (x1 - x0) * - d x0)) in H2) + ; generalize (Rabs_triang_inv (f x1 - f x0) ((x1 - x0) * d x0)); + intro; rewrite (Rmult_comm (x1 - x0) (- d x0)); + rewrite (Ropp_mult_distr_l_reverse (d x0) (x1 - x0)); + fold (f x1 - f x0 - d x0 * (x1 - x0)) in |- *; + rewrite (Rmult_comm (x1 - x0) (d x0)) in H10; clear H1; + intro; + generalize + (Rle_lt_trans (Rabs (f x1 - f x0) - Rabs (d x0 * (x1 - x0))) + (Rabs (f x1 - f x0 - d x0 * (x1 - x0))) (Rabs (x1 - x0) * eps) H10 H1); + clear H1; intro; + generalize + (Rplus_lt_compat_l (Rabs (d x0 * (x1 - x0))) + (Rabs (f x1 - f x0) - Rabs (d x0 * (x1 - x0))) ( + Rabs (x1 - x0) * eps) H1); unfold Rminus at 2 in |- *; + rewrite (Rplus_comm (Rabs (f x1 - f x0)) (- Rabs (d x0 * (x1 - x0)))); + rewrite <- + (Rplus_assoc (Rabs (d x0 * (x1 - x0))) (- Rabs (d x0 * (x1 - x0))) + (Rabs (f x1 - f x0))); rewrite (Rplus_opp_r (Rabs (d x0 * (x1 - x0)))); + rewrite (let (H1, H2) := Rplus_ne (Rabs (f x1 - f x0)) in H2); + clear H1; intro; cut (Rabs (d x0 * (x1 - x0)) + Rabs (x1 - x0) * eps < eps). + intro; + apply + (Rlt_trans (Rabs (f x1 - f x0)) + (Rabs (d x0 * (x1 - x0)) + Rabs (x1 - x0) * eps) eps H1 H11). + clear H1 H5 H3 H10; generalize (Rabs_pos_lt (d x0) H2); intro; + unfold Rgt in H0; + generalize (Rmult_lt_compat_l eps (R_dist x1 x0) (/ 2) H0 H7); + clear H7; intro; + generalize + (Rmult_lt_compat_l (Rabs (d x0)) (R_dist x1 x0) ( + eps * / Rabs (2 * d x0)) H1 H6); clear H6; intro; + rewrite (Rmult_comm eps (R_dist x1 x0)) in H3; unfold R_dist in H3, H5; + rewrite <- (Rabs_mult (d x0) (x1 - x0)) in H5; + rewrite (Rabs_mult 2 (d x0)) in H5; cut (Rabs 2 <> 0). + intro; fold (Rabs (d x0) > 0) in H1; + rewrite + (Rinv_mult_distr (Rabs 2) (Rabs (d x0)) H6 + (Rlt_dichotomy_converse (Rabs (d x0)) 0 (or_intror (Rabs (d x0) < 0) H1))) + in H5; + rewrite (Rmult_comm (Rabs (d x0)) (eps * (/ Rabs 2 * / Rabs (d x0)))) in H5; + rewrite <- (Rmult_assoc eps (/ Rabs 2) (/ Rabs (d x0))) in H5; + rewrite (Rmult_assoc (eps * / Rabs 2) (/ Rabs (d x0)) (Rabs (d x0))) in H5; + rewrite + (Rinv_l (Rabs (d x0)) + (Rlt_dichotomy_converse (Rabs (d x0)) 0 (or_intror (Rabs (d x0) < 0) H1))) + in H5; rewrite (let (H1, H2) := Rmult_ne (eps * / Rabs 2) in H1) in H5; + cut (Rabs 2 = 2). + intro; rewrite H7 in H5; + generalize + (Rplus_lt_compat (Rabs (d x0 * (x1 - x0))) (eps * / 2) + (Rabs (x1 - x0) * eps) (eps * / 2) H5 H3); intro; + rewrite eps2 in H10; assumption. + unfold Rabs in |- *; case (Rcase_abs 2); auto. + intro; cut (0 < 2). + intro; generalize (Rlt_asym 0 2 H7); intro; elimtype False; auto. + fourier. + apply Rabs_no_R0. + discrR. Qed. (*********) Lemma Dconst : - forall (D:R -> Prop) (y x0:R), D_in (fun x:R => y) (fun x:R => 0) D x0. -unfold D_in in |- *; intros; unfold limit1_in in |- *; - unfold limit_in in |- *; unfold Rdiv in |- *; intros; - simpl in |- *; split with eps; split; auto. -intros; rewrite (Rminus_diag_eq y y (refl_equal y)); rewrite Rmult_0_l; - unfold R_dist in |- *; rewrite (Rminus_diag_eq 0 0 (refl_equal 0)); - unfold Rabs in |- *; case (Rcase_abs 0); intro. -absurd (0 < 0); auto. -red in |- *; intro; apply (Rlt_irrefl 0 H1). -unfold Rgt in H0; assumption. + forall (D:R -> Prop) (y x0:R), D_in (fun x:R => y) (fun x:R => 0) D x0. +Proof. + unfold D_in in |- *; intros; unfold limit1_in in |- *; + unfold limit_in in |- *; unfold Rdiv in |- *; intros; + simpl in |- *; split with eps; split; auto. + intros; rewrite (Rminus_diag_eq y y (refl_equal y)); rewrite Rmult_0_l; + unfold R_dist in |- *; rewrite (Rminus_diag_eq 0 0 (refl_equal 0)); + unfold Rabs in |- *; case (Rcase_abs 0); intro. + absurd (0 < 0); auto. + red in |- *; intro; apply (Rlt_irrefl 0 H1). + unfold Rgt in H0; assumption. Qed. (*********) Lemma Dx : - forall (D:R -> Prop) (x0:R), D_in (fun x:R => x) (fun x:R => 1) D x0. -unfold D_in in |- *; unfold Rdiv in |- *; intros; unfold limit1_in in |- *; - unfold limit_in in |- *; intros; simpl in |- *; split with eps; - split; auto. -intros; elim H0; clear H0; intros; unfold D_x in H0; elim H0; intros; - rewrite (Rinv_r (x - x0) (Rminus_eq_contra x x0 (sym_not_eq H3))); - unfold R_dist in |- *; rewrite (Rminus_diag_eq 1 1 (refl_equal 1)); - unfold Rabs in |- *; case (Rcase_abs 0); intro. -absurd (0 < 0); auto. -red in |- *; intro; apply (Rlt_irrefl 0 r). -unfold Rgt in H; assumption. + forall (D:R -> Prop) (x0:R), D_in (fun x:R => x) (fun x:R => 1) D x0. +Proof. + unfold D_in in |- *; unfold Rdiv in |- *; intros; unfold limit1_in in |- *; + unfold limit_in in |- *; intros; simpl in |- *; split with eps; + split; auto. + intros; elim H0; clear H0; intros; unfold D_x in H0; elim H0; intros; + rewrite (Rinv_r (x - x0) (Rminus_eq_contra x x0 (sym_not_eq H3))); + unfold R_dist in |- *; rewrite (Rminus_diag_eq 1 1 (refl_equal 1)); + unfold Rabs in |- *; case (Rcase_abs 0); intro. + absurd (0 < 0); auto. + red in |- *; intro; apply (Rlt_irrefl 0 r). + unfold Rgt in H; assumption. Qed. (*********) Lemma Dadd : - forall (D:R -> Prop) (df dg f g:R -> R) (x0:R), - D_in f df D x0 -> - D_in g dg D x0 -> - D_in (fun x:R => f x + g x) (fun x:R => df x + dg x) D x0. -unfold D_in in |- *; intros; - generalize - (limit_plus (fun x:R => (f x - f x0) * / (x - x0)) - (fun x:R => (g x - g x0) * / (x - x0)) (D_x D x0) ( - df x0) (dg x0) x0 H H0); clear H H0; unfold limit1_in in |- *; - unfold limit_in in |- *; simpl in |- *; intros; elim (H eps H0); - clear H; intros; elim H; clear H; intros; split with x; - split; auto; intros; generalize (H1 x1 H2); clear H1; - intro; rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0))) in H1; - rewrite (Rmult_comm (g x1 - g x0) (/ (x1 - x0))) in H1; - rewrite <- (Rmult_plus_distr_l (/ (x1 - x0)) (f x1 - f x0) (g x1 - g x0)) - in H1; - rewrite (Rmult_comm (/ (x1 - x0)) (f x1 - f x0 + (g x1 - g x0))) in H1; - cut (f x1 - f x0 + (g x1 - g x0) = f x1 + g x1 - (f x0 + g x0)). -intro; rewrite H3 in H1; assumption. -ring. + forall (D:R -> Prop) (df dg f g:R -> R) (x0:R), + D_in f df D x0 -> + D_in g dg D x0 -> + D_in (fun x:R => f x + g x) (fun x:R => df x + dg x) D x0. +Proof. + unfold D_in in |- *; intros; + generalize + (limit_plus (fun x:R => (f x - f x0) * / (x - x0)) + (fun x:R => (g x - g x0) * / (x - x0)) (D_x D x0) ( + df x0) (dg x0) x0 H H0); clear H H0; unfold limit1_in in |- *; + unfold limit_in in |- *; simpl in |- *; intros; elim (H eps H0); + clear H; intros; elim H; clear H; intros; split with x; + split; auto; intros; generalize (H1 x1 H2); clear H1; + intro; rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0))) in H1; + rewrite (Rmult_comm (g x1 - g x0) (/ (x1 - x0))) in H1; + rewrite <- (Rmult_plus_distr_l (/ (x1 - x0)) (f x1 - f x0) (g x1 - g x0)) + in H1; + rewrite (Rmult_comm (/ (x1 - x0)) (f x1 - f x0 + (g x1 - g x0))) in H1; + cut (f x1 - f x0 + (g x1 - g x0) = f x1 + g x1 - (f x0 + g x0)). + intro; rewrite H3 in H1; assumption. + ring. Qed. (*********) Lemma Dmult : - forall (D:R -> Prop) (df dg f g:R -> R) (x0:R), - D_in f df D x0 -> - D_in g dg D x0 -> - D_in (fun x:R => f x * g x) (fun x:R => df x * g x + f x * dg x) D x0. -intros; unfold D_in in |- *; generalize H H0; intros; unfold D_in in H, H0; - generalize (cont_deriv f df D x0 H1); unfold continue_in in |- *; - intro; - generalize - (limit_mul (fun x:R => (g x - g x0) * / (x - x0)) ( - fun x:R => f x) (D_x D x0) (dg x0) (f x0) x0 H0 H3); - intro; cut (limit1_in (fun x:R => g x0) (D_x D x0) (g x0) x0). -intro; - generalize - (limit_mul (fun x:R => (f x - f x0) * / (x - x0)) ( - fun _:R => g x0) (D_x D x0) (df x0) (g x0) x0 H H5); - clear H H0 H1 H2 H3 H5; intro; - generalize - (limit_plus (fun x:R => (f x - f x0) * / (x - x0) * g x0) - (fun x:R => (g x - g x0) * / (x - x0) * f x) ( - D_x D x0) (df x0 * g x0) (dg x0 * f x0) x0 H H4); - clear H4 H; intro; unfold limit1_in in H; unfold limit_in in H; - simpl in H; unfold limit1_in in |- *; unfold limit_in in |- *; - simpl in |- *; intros; elim (H eps H0); clear H; intros; - elim H; clear H; intros; split with x; split; auto; - intros; generalize (H1 x1 H2); clear H1; intro; - rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0))) in H1; - rewrite (Rmult_comm (g x1 - g x0) (/ (x1 - x0))) in H1; - rewrite (Rmult_assoc (/ (x1 - x0)) (f x1 - f x0) (g x0)) in H1; - rewrite (Rmult_assoc (/ (x1 - x0)) (g x1 - g x0) (f x1)) in H1; - rewrite <- - (Rmult_plus_distr_l (/ (x1 - x0)) ((f x1 - f x0) * g x0) - ((g x1 - g x0) * f x1)) in H1; - rewrite - (Rmult_comm (/ (x1 - x0)) ((f x1 - f x0) * g x0 + (g x1 - g x0) * f x1)) - in H1; rewrite (Rmult_comm (dg x0) (f x0)) in H1; - cut - ((f x1 - f x0) * g x0 + (g x1 - g x0) * f x1 = f x1 * g x1 - f x0 * g x0). -intro; rewrite H3 in H1; assumption. -ring. -unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros; - split with eps; split; auto; intros; elim (R_dist_refl (g x0) (g x0)); - intros a b; rewrite (b (refl_equal (g x0))); unfold Rgt in H; - assumption. + forall (D:R -> Prop) (df dg f g:R -> R) (x0:R), + D_in f df D x0 -> + D_in g dg D x0 -> + D_in (fun x:R => f x * g x) (fun x:R => df x * g x + f x * dg x) D x0. +Proof. + intros; unfold D_in in |- *; generalize H H0; intros; unfold D_in in H, H0; + generalize (cont_deriv f df D x0 H1); unfold continue_in in |- *; + intro; + generalize + (limit_mul (fun x:R => (g x - g x0) * / (x - x0)) ( + fun x:R => f x) (D_x D x0) (dg x0) (f x0) x0 H0 H3); + intro; cut (limit1_in (fun x:R => g x0) (D_x D x0) (g x0) x0). + intro; + generalize + (limit_mul (fun x:R => (f x - f x0) * / (x - x0)) ( + fun _:R => g x0) (D_x D x0) (df x0) (g x0) x0 H H5); + clear H H0 H1 H2 H3 H5; intro; + generalize + (limit_plus (fun x:R => (f x - f x0) * / (x - x0) * g x0) + (fun x:R => (g x - g x0) * / (x - x0) * f x) ( + D_x D x0) (df x0 * g x0) (dg x0 * f x0) x0 H H4); + clear H4 H; intro; unfold limit1_in in H; unfold limit_in in H; + simpl in H; unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; intros; elim (H eps H0); clear H; intros; + elim H; clear H; intros; split with x; split; auto; + intros; generalize (H1 x1 H2); clear H1; intro; + rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0))) in H1; + rewrite (Rmult_comm (g x1 - g x0) (/ (x1 - x0))) in H1; + rewrite (Rmult_assoc (/ (x1 - x0)) (f x1 - f x0) (g x0)) in H1; + rewrite (Rmult_assoc (/ (x1 - x0)) (g x1 - g x0) (f x1)) in H1; + rewrite <- + (Rmult_plus_distr_l (/ (x1 - x0)) ((f x1 - f x0) * g x0) + ((g x1 - g x0) * f x1)) in H1; + rewrite + (Rmult_comm (/ (x1 - x0)) ((f x1 - f x0) * g x0 + (g x1 - g x0) * f x1)) + in H1; rewrite (Rmult_comm (dg x0) (f x0)) in H1; + cut + ((f x1 - f x0) * g x0 + (g x1 - g x0) * f x1 = f x1 * g x1 - f x0 * g x0). + intro; rewrite H3 in H1; assumption. + ring. + unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros; + split with eps; split; auto; intros; elim (R_dist_refl (g x0) (g x0)); + intros a b; rewrite (b (refl_equal (g x0))); unfold Rgt in H; + assumption. Qed. (*********) Lemma Dmult_const : - forall (D:R -> Prop) (f df:R -> R) (x0 a:R), - D_in f df D x0 -> D_in (fun x:R => a * f x) (fun x:R => a * df x) D x0. -intros; - generalize (Dmult D (fun _:R => 0) df (fun _:R => a) f x0 (Dconst D a x0) H); - unfold D_in in |- *; intros; rewrite (Rmult_0_l (f x0)) in H0; - rewrite (let (H1, H2) := Rplus_ne (a * df x0) in H2) in H0; - assumption. + forall (D:R -> Prop) (f df:R -> R) (x0 a:R), + D_in f df D x0 -> D_in (fun x:R => a * f x) (fun x:R => a * df x) D x0. +Proof. + intros; + generalize (Dmult D (fun _:R => 0) df (fun _:R => a) f x0 (Dconst D a x0) H); + unfold D_in in |- *; intros; rewrite (Rmult_0_l (f x0)) in H0; + rewrite (let (H1, H2) := Rplus_ne (a * df x0) in H2) in H0; + assumption. Qed. (*********) Lemma Dopp : - forall (D:R -> Prop) (f df:R -> R) (x0:R), - D_in f df D x0 -> D_in (fun x:R => - f x) (fun x:R => - df x) D x0. -intros; generalize (Dmult_const D f df x0 (-1) H); unfold D_in in |- *; - unfold limit1_in in |- *; unfold limit_in in |- *; - intros; generalize (H0 eps H1); clear H0; intro; elim H0; - clear H0; intros; elim H0; clear H0; simpl in |- *; - intros; split with x; split; auto. -intros; generalize (H2 x1 H3); clear H2; intro; - rewrite Ropp_mult_distr_l_reverse in H2; - rewrite Ropp_mult_distr_l_reverse in H2; - rewrite Ropp_mult_distr_l_reverse in H2; - rewrite (let (H1, H2) := Rmult_ne (f x1) in H2) in H2; - rewrite (let (H1, H2) := Rmult_ne (f x0) in H2) in H2; - rewrite (let (H1, H2) := Rmult_ne (df x0) in H2) in H2; - assumption. + forall (D:R -> Prop) (f df:R -> R) (x0:R), + D_in f df D x0 -> D_in (fun x:R => - f x) (fun x:R => - df x) D x0. +Proof. + intros; generalize (Dmult_const D f df x0 (-1) H); unfold D_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + intros; generalize (H0 eps H1); clear H0; intro; elim H0; + clear H0; intros; elim H0; clear H0; simpl in |- *; + intros; split with x; split; auto. + intros; generalize (H2 x1 H3); clear H2; intro; + rewrite Ropp_mult_distr_l_reverse in H2; + rewrite Ropp_mult_distr_l_reverse in H2; + rewrite Ropp_mult_distr_l_reverse in H2; + rewrite (let (H1, H2) := Rmult_ne (f x1) in H2) in H2; + rewrite (let (H1, H2) := Rmult_ne (f x0) in H2) in H2; + rewrite (let (H1, H2) := Rmult_ne (df x0) in H2) in H2; + assumption. Qed. (*********) Lemma Dminus : - forall (D:R -> Prop) (df dg f g:R -> R) (x0:R), - D_in f df D x0 -> - D_in g dg D x0 -> - D_in (fun x:R => f x - g x) (fun x:R => df x - dg x) D x0. -unfold Rminus in |- *; intros; generalize (Dopp D g dg x0 H0); intro; - apply (Dadd D df (fun x:R => - dg x) f (fun x:R => - g x) x0); - assumption. + forall (D:R -> Prop) (df dg f g:R -> R) (x0:R), + D_in f df D x0 -> + D_in g dg D x0 -> + D_in (fun x:R => f x - g x) (fun x:R => df x - dg x) D x0. +Proof. + unfold Rminus in |- *; intros; generalize (Dopp D g dg x0 H0); intro; + apply (Dadd D df (fun x:R => - dg x) f (fun x:R => - g x) x0); + assumption. Qed. (*********) Lemma Dx_pow_n : - forall (n:nat) (D:R -> Prop) (x0:R), - D_in (fun x:R => x ^ n) (fun x:R => INR n * x ^ (n - 1)) D x0. -simple induction n; intros. -simpl in |- *; rewrite Rmult_0_l; apply Dconst. -intros; cut (n0 = (S n0 - 1)%nat); - [ intro a; rewrite <- a; clear a | simpl in |- *; apply minus_n_O ]. -generalize - (Dmult D (fun _:R => 1) (fun x:R => INR n0 * x ^ (n0 - 1)) ( - fun x:R => x) (fun x:R => x ^ n0) x0 (Dx D x0) ( - H D x0)); unfold D_in in |- *; unfold limit1_in in |- *; - unfold limit_in in |- *; simpl in |- *; intros; elim (H0 eps H1); - clear H0; intros; elim H0; clear H0; intros; split with x; - split; auto. -intros; generalize (H2 x1 H3); clear H2 H3; intro; - rewrite (let (H1, H2) := Rmult_ne (x0 ^ n0) in H2) in H2; - rewrite (tech_pow_Rmult x1 n0) in H2; rewrite (tech_pow_Rmult x0 n0) in H2; - rewrite (Rmult_comm (INR n0) (x0 ^ (n0 - 1))) in H2; - rewrite <- (Rmult_assoc x0 (x0 ^ (n0 - 1)) (INR n0)) in H2; - rewrite (tech_pow_Rmult x0 (n0 - 1)) in H2; elim (classic (n0 = 0%nat)); - intro cond. -rewrite cond in H2; rewrite cond; simpl in H2; simpl in |- *; - cut (1 + x0 * 1 * 0 = 1 * 1); - [ intro A; rewrite A in H2; assumption | ring ]. -cut (n0 <> 0%nat -> S (n0 - 1) = n0); [ intro | omega ]; - rewrite (H3 cond) in H2; rewrite (Rmult_comm (x0 ^ n0) (INR n0)) in H2; - rewrite (tech_pow_Rplus x0 n0 n0) in H2; assumption. + forall (n:nat) (D:R -> Prop) (x0:R), + D_in (fun x:R => x ^ n) (fun x:R => INR n * x ^ (n - 1)) D x0. +Proof. + simple induction n; intros. + simpl in |- *; rewrite Rmult_0_l; apply Dconst. + intros; cut (n0 = (S n0 - 1)%nat); + [ intro a; rewrite <- a; clear a | simpl in |- *; apply minus_n_O ]. + generalize + (Dmult D (fun _:R => 1) (fun x:R => INR n0 * x ^ (n0 - 1)) ( + fun x:R => x) (fun x:R => x ^ n0) x0 (Dx D x0) ( + H D x0)); unfold D_in in |- *; unfold limit1_in in |- *; + unfold limit_in in |- *; simpl in |- *; intros; elim (H0 eps H1); + clear H0; intros; elim H0; clear H0; intros; split with x; + split; auto. + intros; generalize (H2 x1 H3); clear H2 H3; intro; + rewrite (let (H1, H2) := Rmult_ne (x0 ^ n0) in H2) in H2; + rewrite (tech_pow_Rmult x1 n0) in H2; rewrite (tech_pow_Rmult x0 n0) in H2; + rewrite (Rmult_comm (INR n0) (x0 ^ (n0 - 1))) in H2; + rewrite <- (Rmult_assoc x0 (x0 ^ (n0 - 1)) (INR n0)) in H2; + rewrite (tech_pow_Rmult x0 (n0 - 1)) in H2; elim (classic (n0 = 0%nat)); + intro cond. + rewrite cond in H2; rewrite cond; simpl in H2; simpl in |- *; + cut (1 + x0 * 1 * 0 = 1 * 1); + [ intro A; rewrite A in H2; assumption | ring ]. + cut (n0 <> 0%nat -> S (n0 - 1) = n0); [ intro | omega ]; + rewrite (H3 cond) in H2; rewrite (Rmult_comm (x0 ^ n0) (INR n0)) in H2; + rewrite (tech_pow_Rplus x0 n0 n0) in H2; assumption. Qed. (*********) Lemma Dcomp : - forall (Df Dg:R -> Prop) (df dg f g:R -> R) (x0:R), - D_in f df Df x0 -> - D_in g dg Dg (f x0) -> - D_in (fun x:R => g (f x)) (fun x:R => df x * dg (f x)) (Dgf Df Dg f) x0. -intros Df Dg df dg f g x0 H H0; generalize H H0; unfold D_in in |- *; - unfold Rdiv in |- *; intros; - generalize - (limit_comp f (fun x:R => (g x - g (f x0)) * / (x - f x0)) ( - D_x Df x0) (D_x Dg (f x0)) (f x0) (dg (f x0)) x0); - intro; generalize (cont_deriv f df Df x0 H); intro; - unfold continue_in in H4; generalize (H3 H4 H2); clear H3; - intro; - generalize - (limit_mul (fun x:R => (g (f x) - g (f x0)) * / (f x - f x0)) - (fun x:R => (f x - f x0) * / (x - x0)) - (Dgf (D_x Df x0) (D_x Dg (f x0)) f) (dg (f x0)) ( - df x0) x0 H3); intro; - cut - (limit1_in (fun x:R => (f x - f x0) * / (x - x0)) - (Dgf (D_x Df x0) (D_x Dg (f x0)) f) (df x0) x0). -intro; generalize (H5 H6); clear H5; intro; - generalize - (limit_mul (fun x:R => (f x - f x0) * / (x - x0)) ( - fun x:R => dg (f x0)) (D_x Df x0) (df x0) (dg (f x0)) x0 H1 - (limit_free (fun x:R => dg (f x0)) (D_x Df x0) x0 x0)); - intro; unfold limit1_in in |- *; unfold limit_in in |- *; - simpl in |- *; unfold limit1_in in H5, H7; unfold limit_in in H5, H7; - simpl in H5, H7; intros; elim (H5 eps H8); elim (H7 eps H8); - clear H5 H7; intros; elim H5; elim H7; clear H5 H7; - intros; split with (Rmin x x1); split. -elim (Rmin_Rgt x x1 0); intros a b; apply (b (conj H9 H5)); clear a b. -intros; elim H11; clear H11; intros; elim (Rmin_Rgt x x1 (R_dist x2 x0)); - intros a b; clear b; unfold Rgt in a; elim (a H12); - clear H5 a; intros; unfold D_x, Dgf in H11, H7, H10; - clear H12; elim (classic (f x2 = f x0)); intro. -elim H11; clear H11; intros; elim H11; clear H11; intros; - generalize (H10 x2 (conj (conj H11 H14) H5)); intro; - rewrite (Rminus_diag_eq (f x2) (f x0) H12) in H16; - rewrite (Rmult_0_l (/ (x2 - x0))) in H16; - rewrite (Rmult_0_l (dg (f x0))) in H16; rewrite H12; - rewrite (Rminus_diag_eq (g (f x0)) (g (f x0)) (refl_equal (g (f x0)))); - rewrite (Rmult_0_l (/ (x2 - x0))); assumption. -clear H10 H5; elim H11; clear H11; intros; elim H5; clear H5; intros; - cut - (((Df x2 /\ x0 <> x2) /\ Dg (f x2) /\ f x0 <> f x2) /\ R_dist x2 x0 < x1); - auto; intro; generalize (H7 x2 H14); intro; - generalize (Rminus_eq_contra (f x2) (f x0) H12); intro; - rewrite - (Rmult_assoc (g (f x2) - g (f x0)) (/ (f x2 - f x0)) - ((f x2 - f x0) * / (x2 - x0))) in H15; - rewrite <- (Rmult_assoc (/ (f x2 - f x0)) (f x2 - f x0) (/ (x2 - x0))) - in H15; rewrite (Rinv_l (f x2 - f x0) H16) in H15; - rewrite (let (H1, H2) := Rmult_ne (/ (x2 - x0)) in H2) in H15; - rewrite (Rmult_comm (df x0) (dg (f x0))); assumption. -clear H5 H3 H4 H2; unfold limit1_in in |- *; unfold limit_in in |- *; - simpl in |- *; unfold limit1_in in H1; unfold limit_in in H1; - simpl in H1; intros; elim (H1 eps H2); clear H1; intros; - elim H1; clear H1; intros; split with x; split; auto; - intros; unfold D_x, Dgf in H4, H3; elim H4; clear H4; - intros; elim H4; clear H4; intros; exact (H3 x1 (conj H4 H5)). + forall (Df Dg:R -> Prop) (df dg f g:R -> R) (x0:R), + D_in f df Df x0 -> + D_in g dg Dg (f x0) -> + D_in (fun x:R => g (f x)) (fun x:R => df x * dg (f x)) (Dgf Df Dg f) x0. +Proof. + intros Df Dg df dg f g x0 H H0; generalize H H0; unfold D_in in |- *; + unfold Rdiv in |- *; intros; + generalize + (limit_comp f (fun x:R => (g x - g (f x0)) * / (x - f x0)) ( + D_x Df x0) (D_x Dg (f x0)) (f x0) (dg (f x0)) x0); + intro; generalize (cont_deriv f df Df x0 H); intro; + unfold continue_in in H4; generalize (H3 H4 H2); clear H3; + intro; + generalize + (limit_mul (fun x:R => (g (f x) - g (f x0)) * / (f x - f x0)) + (fun x:R => (f x - f x0) * / (x - x0)) + (Dgf (D_x Df x0) (D_x Dg (f x0)) f) (dg (f x0)) ( + df x0) x0 H3); intro; + cut + (limit1_in (fun x:R => (f x - f x0) * / (x - x0)) + (Dgf (D_x Df x0) (D_x Dg (f x0)) f) (df x0) x0). + intro; generalize (H5 H6); clear H5; intro; + generalize + (limit_mul (fun x:R => (f x - f x0) * / (x - x0)) ( + fun x:R => dg (f x0)) (D_x Df x0) (df x0) (dg (f x0)) x0 H1 + (limit_free (fun x:R => dg (f x0)) (D_x Df x0) x0 x0)); + intro; unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold limit1_in in H5, H7; unfold limit_in in H5, H7; + simpl in H5, H7; intros; elim (H5 eps H8); elim (H7 eps H8); + clear H5 H7; intros; elim H5; elim H7; clear H5 H7; + intros; split with (Rmin x x1); split. + elim (Rmin_Rgt x x1 0); intros a b; apply (b (conj H9 H5)); clear a b. + intros; elim H11; clear H11; intros; elim (Rmin_Rgt x x1 (R_dist x2 x0)); + intros a b; clear b; unfold Rgt in a; elim (a H12); + clear H5 a; intros; unfold D_x, Dgf in H11, H7, H10; + clear H12; elim (classic (f x2 = f x0)); intro. + elim H11; clear H11; intros; elim H11; clear H11; intros; + generalize (H10 x2 (conj (conj H11 H14) H5)); intro; + rewrite (Rminus_diag_eq (f x2) (f x0) H12) in H16; + rewrite (Rmult_0_l (/ (x2 - x0))) in H16; + rewrite (Rmult_0_l (dg (f x0))) in H16; rewrite H12; + rewrite (Rminus_diag_eq (g (f x0)) (g (f x0)) (refl_equal (g (f x0)))); + rewrite (Rmult_0_l (/ (x2 - x0))); assumption. + clear H10 H5; elim H11; clear H11; intros; elim H5; clear H5; intros; + cut + (((Df x2 /\ x0 <> x2) /\ Dg (f x2) /\ f x0 <> f x2) /\ R_dist x2 x0 < x1); + auto; intro; generalize (H7 x2 H14); intro; + generalize (Rminus_eq_contra (f x2) (f x0) H12); intro; + rewrite + (Rmult_assoc (g (f x2) - g (f x0)) (/ (f x2 - f x0)) + ((f x2 - f x0) * / (x2 - x0))) in H15; + rewrite <- (Rmult_assoc (/ (f x2 - f x0)) (f x2 - f x0) (/ (x2 - x0))) + in H15; rewrite (Rinv_l (f x2 - f x0) H16) in H15; + rewrite (let (H1, H2) := Rmult_ne (/ (x2 - x0)) in H2) in H15; + rewrite (Rmult_comm (df x0) (dg (f x0))); assumption. + clear H5 H3 H4 H2; unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold limit1_in in H1; unfold limit_in in H1; + simpl in H1; intros; elim (H1 eps H2); clear H1; intros; + elim H1; clear H1; intros; split with x; split; auto; + intros; unfold D_x, Dgf in H4, H3; elim H4; clear H4; + intros; elim H4; clear H4; intros; exact (H3 x1 (conj H4 H5)). Qed. (*********) Lemma D_pow_n : - forall (n:nat) (D:R -> Prop) (x0:R) (expr dexpr:R -> R), - D_in expr dexpr D x0 -> - D_in (fun x:R => expr x ^ n) - (fun x:R => INR n * expr x ^ (n - 1) * dexpr x) ( - Dgf D D expr) x0. -intros n D x0 expr dexpr H; - generalize - (Dcomp D D dexpr (fun x:R => INR n * x ^ (n - 1)) expr ( - fun x:R => x ^ n) x0 H (Dx_pow_n n D (expr x0))); - intro; unfold D_in in |- *; unfold limit1_in in |- *; - unfold limit_in in |- *; simpl in |- *; intros; unfold D_in in H0; - unfold limit1_in in H0; unfold limit_in in H0; simpl in H0; - elim (H0 eps H1); clear H0; intros; elim H0; clear H0; - intros; split with x; split; intros; auto. -cut - (dexpr x0 * (INR n * expr x0 ^ (n - 1)) = - INR n * expr x0 ^ (n - 1) * dexpr x0); - [ intro Rew; rewrite <- Rew; exact (H2 x1 H3) | ring ]. + forall (n:nat) (D:R -> Prop) (x0:R) (expr dexpr:R -> R), + D_in expr dexpr D x0 -> + D_in (fun x:R => expr x ^ n) + (fun x:R => INR n * expr x ^ (n - 1) * dexpr x) ( + Dgf D D expr) x0. +Proof. + intros n D x0 expr dexpr H; + generalize + (Dcomp D D dexpr (fun x:R => INR n * x ^ (n - 1)) expr ( + fun x:R => x ^ n) x0 H (Dx_pow_n n D (expr x0))); + intro; unfold D_in in |- *; unfold limit1_in in |- *; + unfold limit_in in |- *; simpl in |- *; intros; unfold D_in in H0; + unfold limit1_in in H0; unfold limit_in in H0; simpl in H0; + elim (H0 eps H1); clear H0; intros; elim H0; clear H0; + intros; split with x; split; intros; auto. + cut + (dexpr x0 * (INR n * expr x0 ^ (n - 1)) = + INR n * expr x0 ^ (n - 1) * dexpr x0); + [ intro Rew; rewrite <- Rew; exact (H2 x1 H3) | ring ]. Qed. diff --git a/theories/Reals/Reals.v b/theories/Reals/Reals.v index c9cd189d..906f4977 100644 --- a/theories/Reals/Reals.v +++ b/theories/Reals/Reals.v @@ -6,9 +6,9 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Reals.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Reals.v 9245 2006-10-17 12:53:34Z notin $ i*) -(* The library REALS is divided in 6 parts : +(** The library REALS is divided in 6 parts : - Rbase: basic lemmas on R equalities and inequalities Ring and Field are instantiated on R diff --git a/theories/Reals/Rfunctions.v b/theories/Reals/Rfunctions.v index 0ab93229..c727623c 100644 --- a/theories/Reals/Rfunctions.v +++ b/theories/Reals/Rfunctions.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Rfunctions.v 6338 2004-11-22 09:10:51Z gregoire $ i*) +(*i $Id: Rfunctions.v 9302 2006-10-27 21:21:17Z barras $ i*) (*i Some properties about pow and sum have been made with John Harrison i*) (*i Some Lemmas (about pow and powerRZ) have been done by Laurent Thery i*) @@ -15,6 +15,8 @@ (** Definition of the sum functions *) (* *) (********************************************************) +Require Export LegacyArithRing. (* for ring_nat... *) +Require Export ArithRing. Require Import Rbase. Require Export R_Ifp. @@ -29,498 +31,496 @@ Open Local Scope nat_scope. Open Local Scope R_scope. (*******************************) -(** Lemmas about factorial *) +(** * Lemmas about factorial *) (*******************************) (*********) Lemma INR_fact_neq_0 : forall n:nat, INR (fact n) <> 0. Proof. -intro; red in |- *; intro; apply (not_O_INR (fact n) (fact_neq_0 n)); - assumption. + intro; red in |- *; intro; apply (not_O_INR (fact n) (fact_neq_0 n)); + assumption. Qed. (*********) Lemma fact_simpl : forall n:nat, fact (S n) = (S n * fact n)%nat. Proof. -intro; reflexivity. + intro; reflexivity. Qed. (*********) Lemma simpl_fact : - forall n:nat, / INR (fact (S n)) * / / INR (fact n) = / INR (S n). + forall n:nat, / INR (fact (S n)) * / / INR (fact n) = / INR (S n). Proof. -intro; rewrite (Rinv_involutive (INR (fact n)) (INR_fact_neq_0 n)); - unfold fact at 1 in |- *; cbv beta iota in |- *; fold fact in |- *; - rewrite (mult_INR (S n) (fact n)); - rewrite (Rinv_mult_distr (INR (S n)) (INR (fact n))). -rewrite (Rmult_assoc (/ INR (S n)) (/ INR (fact n)) (INR (fact n))); - rewrite (Rinv_l (INR (fact n)) (INR_fact_neq_0 n)); - apply (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1). -apply not_O_INR; auto. -apply INR_fact_neq_0. + intro; rewrite (Rinv_involutive (INR (fact n)) (INR_fact_neq_0 n)); + unfold fact at 1 in |- *; cbv beta iota in |- *; fold fact in |- *; + rewrite (mult_INR (S n) (fact n)); + rewrite (Rinv_mult_distr (INR (S n)) (INR (fact n))). + rewrite (Rmult_assoc (/ INR (S n)) (/ INR (fact n)) (INR (fact n))); + rewrite (Rinv_l (INR (fact n)) (INR_fact_neq_0 n)); + apply (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1). + apply not_O_INR; auto. + apply INR_fact_neq_0. Qed. (*******************************) -(* Power *) +(** * Power *) (*******************************) (*********) Boxed Fixpoint pow (r:R) (n:nat) {struct n} : R := match n with - | O => 1 - | S n => r * pow r n + | O => 1 + | S n => r * pow r n end. Infix "^" := pow : R_scope. Lemma pow_O : forall x:R, x ^ 0 = 1. Proof. -reflexivity. + reflexivity. Qed. - + Lemma pow_1 : forall x:R, x ^ 1 = x. Proof. -simpl in |- *; auto with real. + simpl in |- *; auto with real. Qed. - + Lemma pow_add : forall (x:R) (n m:nat), x ^ (n + m) = x ^ n * x ^ m. Proof. -intros x n; elim n; simpl in |- *; auto with real. -intros n0 H' m; rewrite H'; auto with real. + intros x n; elim n; simpl in |- *; auto with real. + intros n0 H' m; rewrite H'; auto with real. Qed. Lemma pow_nonzero : forall (x:R) (n:nat), x <> 0 -> x ^ n <> 0. Proof. -intro; simple induction n; simpl in |- *. -intro; red in |- *; intro; apply R1_neq_R0; assumption. -intros; red in |- *; intro; elim (Rmult_integral x (x ^ n0) H1). -intro; auto. -apply H; assumption. + intro; simple induction n; simpl in |- *. + intro; red in |- *; intro; apply R1_neq_R0; assumption. + intros; red in |- *; intro; elim (Rmult_integral x (x ^ n0) H1). + intro; auto. + apply H; assumption. Qed. Hint Resolve pow_O pow_1 pow_add pow_nonzero: real. - + Lemma pow_RN_plus : - forall (x:R) (n m:nat), x <> 0 -> x ^ n = x ^ (n + m) * / x ^ m. + forall (x:R) (n m:nat), x <> 0 -> x ^ n = x ^ (n + m) * / x ^ m. Proof. -intros x n; elim n; simpl in |- *; auto with real. -intros n0 H' m H'0. -rewrite Rmult_assoc; rewrite <- H'; auto. + intros x n; elim n; simpl in |- *; auto with real. + intros n0 H' m H'0. + rewrite Rmult_assoc; rewrite <- H'; auto. Qed. Lemma pow_lt : forall (x:R) (n:nat), 0 < x -> 0 < x ^ n. Proof. -intros x n; elim n; simpl in |- *; auto with real. -intros n0 H' H'0; replace 0 with (x * 0); auto with real. + intros x n; elim n; simpl in |- *; auto with real. + intros n0 H' H'0; replace 0 with (x * 0); auto with real. Qed. Hint Resolve pow_lt: real. Lemma Rlt_pow_R1 : forall (x:R) (n:nat), 1 < x -> (0 < n)%nat -> 1 < x ^ n. Proof. -intros x n; elim n; simpl in |- *; auto with real. -intros H' H'0; elimtype False; omega. -intros n0; case n0. -simpl in |- *; rewrite Rmult_1_r; auto. -intros n1 H' H'0 H'1. -replace 1 with (1 * 1); auto with real. -apply Rlt_trans with (r2 := x * 1); auto with real. -apply Rmult_lt_compat_l; auto with real. -apply Rlt_trans with (r2 := 1); auto with real. -apply H'; auto with arith. + intros x n; elim n; simpl in |- *; auto with real. + intros H' H'0; elimtype False; omega. + intros n0; case n0. + simpl in |- *; rewrite Rmult_1_r; auto. + intros n1 H' H'0 H'1. + replace 1 with (1 * 1); auto with real. + apply Rlt_trans with (r2 := x * 1); auto with real. + apply Rmult_lt_compat_l; auto with real. + apply Rlt_trans with (r2 := 1); auto with real. + apply H'; auto with arith. Qed. Hint Resolve Rlt_pow_R1: real. Lemma Rlt_pow : forall (x:R) (n m:nat), 1 < x -> (n < m)%nat -> x ^ n < x ^ m. Proof. -intros x n m H' H'0; replace m with (m - n + n)%nat. -rewrite pow_add. -pattern (x ^ n) at 1 in |- *; replace (x ^ n) with (1 * x ^ n); - auto with real. -apply Rminus_lt. -repeat rewrite (fun y:R => Rmult_comm y (x ^ n)); - rewrite <- Rmult_minus_distr_l. -replace 0 with (x ^ n * 0); auto with real. -apply Rmult_lt_compat_l; auto with real. -apply pow_lt; auto with real. -apply Rlt_trans with (r2 := 1); auto with real. -apply Rlt_minus; auto with real. -apply Rlt_pow_R1; auto with arith. -apply plus_lt_reg_l with (p := n); auto with arith. -rewrite le_plus_minus_r; auto with arith; rewrite <- plus_n_O; auto. -rewrite plus_comm; auto with arith. + intros x n m H' H'0; replace m with (m - n + n)%nat. + rewrite pow_add. + pattern (x ^ n) at 1 in |- *; replace (x ^ n) with (1 * x ^ n); + auto with real. + apply Rminus_lt. + repeat rewrite (fun y:R => Rmult_comm y (x ^ n)); + rewrite <- Rmult_minus_distr_l. + replace 0 with (x ^ n * 0); auto with real. + apply Rmult_lt_compat_l; auto with real. + apply pow_lt; auto with real. + apply Rlt_trans with (r2 := 1); auto with real. + apply Rlt_minus; auto with real. + apply Rlt_pow_R1; auto with arith. + apply plus_lt_reg_l with (p := n); auto with arith. + rewrite le_plus_minus_r; auto with arith; rewrite <- plus_n_O; auto. + rewrite plus_comm; auto with arith. Qed. Hint Resolve Rlt_pow: real. (*********) Lemma tech_pow_Rmult : forall (x:R) (n:nat), x * x ^ n = x ^ S n. Proof. -simple induction n; simpl in |- *; trivial. + simple induction n; simpl in |- *; trivial. Qed. (*********) Lemma tech_pow_Rplus : - forall (x:R) (a n:nat), x ^ a + INR n * x ^ a = INR (S n) * x ^ a. + forall (x:R) (a n:nat), x ^ a + INR n * x ^ a = INR (S n) * x ^ a. Proof. -intros; pattern (x ^ a) at 1 in |- *; - rewrite <- (let (H1, H2) := Rmult_ne (x ^ a) in H1); - rewrite (Rmult_comm (INR n) (x ^ a)); - rewrite <- (Rmult_plus_distr_l (x ^ a) 1 (INR n)); - rewrite (Rplus_comm 1 (INR n)); rewrite <- (S_INR n); - apply Rmult_comm. + intros; pattern (x ^ a) at 1 in |- *; + rewrite <- (let (H1, H2) := Rmult_ne (x ^ a) in H1); + rewrite (Rmult_comm (INR n) (x ^ a)); + rewrite <- (Rmult_plus_distr_l (x ^ a) 1 (INR n)); + rewrite (Rplus_comm 1 (INR n)); rewrite <- (S_INR n); + apply Rmult_comm. Qed. Lemma poly : forall (n:nat) (x:R), 0 < x -> 1 + INR n * x <= (1 + x) ^ n. Proof. -intros; elim n. -simpl in |- *; cut (1 + 0 * x = 1). -intro; rewrite H0; unfold Rle in |- *; right; reflexivity. -ring. -intros; unfold pow in |- *; fold pow in |- *; - apply - (Rle_trans (1 + INR (S n0) * x) ((1 + x) * (1 + INR n0 * x)) - ((1 + x) * (1 + x) ^ n0)). -cut ((1 + x) * (1 + INR n0 * x) = 1 + INR (S n0) * x + INR n0 * (x * x)). -intro; rewrite H1; pattern (1 + INR (S n0) * x) at 1 in |- *; - rewrite <- (let (H1, H2) := Rplus_ne (1 + INR (S n0) * x) in H1); - apply Rplus_le_compat_l; elim n0; intros. -simpl in |- *; rewrite Rmult_0_l; unfold Rle in |- *; right; auto. -unfold Rle in |- *; left; generalize Rmult_gt_0_compat; unfold Rgt in |- *; - intro; fold (Rsqr x) in |- *; - apply (H3 (INR (S n1)) (Rsqr x) (lt_INR_0 (S n1) (lt_O_Sn n1))); - fold (x > 0) in H; - apply (Rlt_0_sqr x (Rlt_dichotomy_converse x 0 (or_intror (x < 0) H))). -rewrite (S_INR n0); ring. -unfold Rle in H0; elim H0; intro. -unfold Rle in |- *; left; apply Rmult_lt_compat_l. -rewrite Rplus_comm; apply (Rle_lt_0_plus_1 x (Rlt_le 0 x H)). -assumption. -rewrite H1; unfold Rle in |- *; right; trivial. + intros; elim n. + simpl in |- *; cut (1 + 0 * x = 1). + intro; rewrite H0; unfold Rle in |- *; right; reflexivity. + ring. + intros; unfold pow in |- *; fold pow in |- *; + apply + (Rle_trans (1 + INR (S n0) * x) ((1 + x) * (1 + INR n0 * x)) + ((1 + x) * (1 + x) ^ n0)). + cut ((1 + x) * (1 + INR n0 * x) = 1 + INR (S n0) * x + INR n0 * (x * x)). + intro; rewrite H1; pattern (1 + INR (S n0) * x) at 1 in |- *; + rewrite <- (let (H1, H2) := Rplus_ne (1 + INR (S n0) * x) in H1); + apply Rplus_le_compat_l; elim n0; intros. + simpl in |- *; rewrite Rmult_0_l; unfold Rle in |- *; right; auto. + unfold Rle in |- *; left; generalize Rmult_gt_0_compat; unfold Rgt in |- *; + intro; fold (Rsqr x) in |- *; + apply (H3 (INR (S n1)) (Rsqr x) (lt_INR_0 (S n1) (lt_O_Sn n1))); + fold (x > 0) in H; + apply (Rlt_0_sqr x (Rlt_dichotomy_converse x 0 (or_intror (x < 0) H))). + rewrite (S_INR n0); ring. + unfold Rle in H0; elim H0; intro. + unfold Rle in |- *; left; apply Rmult_lt_compat_l. + rewrite Rplus_comm; apply (Rle_lt_0_plus_1 x (Rlt_le 0 x H)). + assumption. + rewrite H1; unfold Rle in |- *; right; trivial. Qed. Lemma Power_monotonic : - forall (x:R) (m n:nat), - Rabs x > 1 -> (m <= n)%nat -> Rabs (x ^ m) <= Rabs (x ^ n). -Proof. -intros x m n H; induction n as [| n Hrecn]; intros; inversion H0. -unfold Rle in |- *; right; reflexivity. -unfold Rle in |- *; right; reflexivity. -apply (Rle_trans (Rabs (x ^ m)) (Rabs (x ^ n)) (Rabs (x ^ S n))). -apply Hrecn; assumption. -simpl in |- *; rewrite Rabs_mult. -pattern (Rabs (x ^ n)) at 1 in |- *. -rewrite <- Rmult_1_r. -rewrite (Rmult_comm (Rabs x) (Rabs (x ^ n))). -apply Rmult_le_compat_l. -apply Rabs_pos. -unfold Rgt in H. -apply Rlt_le; assumption. + forall (x:R) (m n:nat), + Rabs x > 1 -> (m <= n)%nat -> Rabs (x ^ m) <= Rabs (x ^ n). +Proof. + intros x m n H; induction n as [| n Hrecn]; intros; inversion H0. + unfold Rle in |- *; right; reflexivity. + unfold Rle in |- *; right; reflexivity. + apply (Rle_trans (Rabs (x ^ m)) (Rabs (x ^ n)) (Rabs (x ^ S n))). + apply Hrecn; assumption. + simpl in |- *; rewrite Rabs_mult. + pattern (Rabs (x ^ n)) at 1 in |- *. + rewrite <- Rmult_1_r. + rewrite (Rmult_comm (Rabs x) (Rabs (x ^ n))). + apply Rmult_le_compat_l. + apply Rabs_pos. + unfold Rgt in H. + apply Rlt_le; assumption. Qed. Lemma RPow_abs : forall (x:R) (n:nat), Rabs x ^ n = Rabs (x ^ n). Proof. -intro; simple induction n; simpl in |- *. -apply sym_eq; apply Rabs_pos_eq; apply Rlt_le; apply Rlt_0_1. -intros; rewrite H; apply sym_eq; apply Rabs_mult. + intro; simple induction n; simpl in |- *. + apply sym_eq; apply Rabs_pos_eq; apply Rlt_le; apply Rlt_0_1. + intros; rewrite H; apply sym_eq; apply Rabs_mult. Qed. Lemma Pow_x_infinity : - forall x:R, - Rabs x > 1 -> - forall b:R, + forall x:R, + Rabs x > 1 -> + forall b:R, exists N : nat, (forall n:nat, (n >= N)%nat -> Rabs (x ^ n) >= b). Proof. -intros; elim (archimed (b * / (Rabs x - 1))); intros; clear H1; - cut (exists N : nat, INR N >= b * / (Rabs x - 1)). -intro; elim H1; clear H1; intros; exists x0; intros; - apply (Rge_trans (Rabs (x ^ n)) (Rabs (x ^ x0)) b). -apply Rle_ge; apply Power_monotonic; assumption. -rewrite <- RPow_abs; cut (Rabs x = 1 + (Rabs x - 1)). -intro; rewrite H3; - apply (Rge_trans ((1 + (Rabs x - 1)) ^ x0) (1 + INR x0 * (Rabs x - 1)) b). -apply Rle_ge; apply poly; fold (Rabs x - 1 > 0) in |- *; apply Rgt_minus; - assumption. -apply (Rge_trans (1 + INR x0 * (Rabs x - 1)) (INR x0 * (Rabs x - 1)) b). -apply Rle_ge; apply Rlt_le; rewrite (Rplus_comm 1 (INR x0 * (Rabs x - 1))); - pattern (INR x0 * (Rabs x - 1)) at 1 in |- *; - rewrite <- (let (H1, H2) := Rplus_ne (INR x0 * (Rabs x - 1)) in H1); - apply Rplus_lt_compat_l; apply Rlt_0_1. -cut (b = b * / (Rabs x - 1) * (Rabs x - 1)). -intros; rewrite H4; apply Rmult_ge_compat_r. -apply Rge_minus; unfold Rge in |- *; left; assumption. -assumption. -rewrite Rmult_assoc; rewrite Rinv_l. -ring. -apply Rlt_dichotomy_converse; right; apply Rgt_minus; assumption. -ring. -cut ((0 <= up (b * / (Rabs x - 1)))%Z \/ (up (b * / (Rabs x - 1)) <= 0)%Z). -intros; elim H1; intro. -elim (IZN (up (b * / (Rabs x - 1))) H2); intros; exists x0; - apply - (Rge_trans (INR x0) (IZR (up (b * / (Rabs x - 1)))) (b * / (Rabs x - 1))). -rewrite INR_IZR_INZ; apply IZR_ge; omega. -unfold Rge in |- *; left; assumption. -exists 0%nat; - apply - (Rge_trans (INR 0) (IZR (up (b * / (Rabs x - 1)))) (b * / (Rabs x - 1))). -rewrite INR_IZR_INZ; apply IZR_ge; simpl in |- *; omega. -unfold Rge in |- *; left; assumption. -omega. + intros; elim (archimed (b * / (Rabs x - 1))); intros; clear H1; + cut (exists N : nat, INR N >= b * / (Rabs x - 1)). + intro; elim H1; clear H1; intros; exists x0; intros; + apply (Rge_trans (Rabs (x ^ n)) (Rabs (x ^ x0)) b). + apply Rle_ge; apply Power_monotonic; assumption. + rewrite <- RPow_abs; cut (Rabs x = 1 + (Rabs x - 1)). + intro; rewrite H3; + apply (Rge_trans ((1 + (Rabs x - 1)) ^ x0) (1 + INR x0 * (Rabs x - 1)) b). + apply Rle_ge; apply poly; fold (Rabs x - 1 > 0) in |- *; apply Rgt_minus; + assumption. + apply (Rge_trans (1 + INR x0 * (Rabs x - 1)) (INR x0 * (Rabs x - 1)) b). + apply Rle_ge; apply Rlt_le; rewrite (Rplus_comm 1 (INR x0 * (Rabs x - 1))); + pattern (INR x0 * (Rabs x - 1)) at 1 in |- *; + rewrite <- (let (H1, H2) := Rplus_ne (INR x0 * (Rabs x - 1)) in H1); + apply Rplus_lt_compat_l; apply Rlt_0_1. + cut (b = b * / (Rabs x - 1) * (Rabs x - 1)). + intros; rewrite H4; apply Rmult_ge_compat_r. + apply Rge_minus; unfold Rge in |- *; left; assumption. + assumption. + rewrite Rmult_assoc; rewrite Rinv_l. + ring. + apply Rlt_dichotomy_converse; right; apply Rgt_minus; assumption. + ring. + cut ((0 <= up (b * / (Rabs x - 1)))%Z \/ (up (b * / (Rabs x - 1)) <= 0)%Z). + intros; elim H1; intro. + elim (IZN (up (b * / (Rabs x - 1))) H2); intros; exists x0; + apply + (Rge_trans (INR x0) (IZR (up (b * / (Rabs x - 1)))) (b * / (Rabs x - 1))). + rewrite INR_IZR_INZ; apply IZR_ge; omega. + unfold Rge in |- *; left; assumption. + exists 0%nat; + apply + (Rge_trans (INR 0) (IZR (up (b * / (Rabs x - 1)))) (b * / (Rabs x - 1))). + rewrite INR_IZR_INZ; apply IZR_ge; simpl in |- *; omega. + unfold Rge in |- *; left; assumption. + omega. Qed. Lemma pow_ne_zero : forall n:nat, n <> 0%nat -> 0 ^ n = 0. Proof. -simple induction n. -simpl in |- *; auto. -intros; elim H; reflexivity. -intros; simpl in |- *; apply Rmult_0_l. + simple induction n. + simpl in |- *; auto. + intros; elim H; reflexivity. + intros; simpl in |- *; apply Rmult_0_l. Qed. Lemma Rinv_pow : forall (x:R) (n:nat), x <> 0 -> / x ^ n = (/ x) ^ n. Proof. -intros; elim n; simpl in |- *. -apply Rinv_1. -intro m; intro; rewrite Rinv_mult_distr. -rewrite H0; reflexivity; assumption. -assumption. -apply pow_nonzero; assumption. + intros; elim n; simpl in |- *. + apply Rinv_1. + intro m; intro; rewrite Rinv_mult_distr. + rewrite H0; reflexivity; assumption. + assumption. + apply pow_nonzero; assumption. Qed. Lemma pow_lt_1_zero : - forall x:R, - Rabs x < 1 -> - forall y:R, - 0 < y -> + forall x:R, + Rabs x < 1 -> + forall y:R, + 0 < y -> exists N : nat, (forall n:nat, (n >= N)%nat -> Rabs (x ^ n) < y). Proof. -intros; elim (Req_dec x 0); intro. -exists 1%nat; rewrite H1; intros n GE; rewrite pow_ne_zero. -rewrite Rabs_R0; assumption. -inversion GE; auto. -cut (Rabs (/ x) > 1). -intros; elim (Pow_x_infinity (/ x) H2 (/ y + 1)); intros N. -exists N; intros; rewrite <- (Rinv_involutive y). -rewrite <- (Rinv_involutive (Rabs (x ^ n))). -apply Rinv_lt_contravar. -apply Rmult_lt_0_compat. -apply Rinv_0_lt_compat. -assumption. -apply Rinv_0_lt_compat. -apply Rabs_pos_lt. -apply pow_nonzero. -assumption. -rewrite <- Rabs_Rinv. -rewrite Rinv_pow. -apply (Rlt_le_trans (/ y) (/ y + 1) (Rabs ((/ x) ^ n))). -pattern (/ y) at 1 in |- *. -rewrite <- (let (H1, H2) := Rplus_ne (/ y) in H1). -apply Rplus_lt_compat_l. -apply Rlt_0_1. -apply Rge_le. -apply H3. -assumption. -assumption. -apply pow_nonzero. -assumption. -apply Rabs_no_R0. -apply pow_nonzero. -assumption. -apply Rlt_dichotomy_converse. -right; unfold Rgt in |- *; assumption. -rewrite <- (Rinv_involutive 1). -rewrite Rabs_Rinv. -unfold Rgt in |- *; apply Rinv_lt_contravar. -apply Rmult_lt_0_compat. -apply Rabs_pos_lt. -assumption. -rewrite Rinv_1; apply Rlt_0_1. -rewrite Rinv_1; assumption. -assumption. -red in |- *; intro; apply R1_neq_R0; assumption. + intros; elim (Req_dec x 0); intro. + exists 1%nat; rewrite H1; intros n GE; rewrite pow_ne_zero. + rewrite Rabs_R0; assumption. + inversion GE; auto. + cut (Rabs (/ x) > 1). + intros; elim (Pow_x_infinity (/ x) H2 (/ y + 1)); intros N. + exists N; intros; rewrite <- (Rinv_involutive y). + rewrite <- (Rinv_involutive (Rabs (x ^ n))). + apply Rinv_lt_contravar. + apply Rmult_lt_0_compat. + apply Rinv_0_lt_compat. + assumption. + apply Rinv_0_lt_compat. + apply Rabs_pos_lt. + apply pow_nonzero. + assumption. + rewrite <- Rabs_Rinv. + rewrite Rinv_pow. + apply (Rlt_le_trans (/ y) (/ y + 1) (Rabs ((/ x) ^ n))). + pattern (/ y) at 1 in |- *. + rewrite <- (let (H1, H2) := Rplus_ne (/ y) in H1). + apply Rplus_lt_compat_l. + apply Rlt_0_1. + apply Rge_le. + apply H3. + assumption. + assumption. + apply pow_nonzero. + assumption. + apply Rabs_no_R0. + apply pow_nonzero. + assumption. + apply Rlt_dichotomy_converse. + right; unfold Rgt in |- *; assumption. + rewrite <- (Rinv_involutive 1). + rewrite Rabs_Rinv. + unfold Rgt in |- *; apply Rinv_lt_contravar. + apply Rmult_lt_0_compat. + apply Rabs_pos_lt. + assumption. + rewrite Rinv_1; apply Rlt_0_1. + rewrite Rinv_1; assumption. + assumption. + red in |- *; intro; apply R1_neq_R0; assumption. Qed. Lemma pow_R1 : forall (r:R) (n:nat), r ^ n = 1 -> Rabs r = 1 \/ n = 0%nat. Proof. -intros r n H'. -case (Req_dec (Rabs r) 1); auto; intros H'1. -case (Rdichotomy _ _ H'1); intros H'2. -generalize H'; case n; auto. -intros n0 H'0. -cut (r <> 0); [ intros Eq1 | idtac ]. -cut (Rabs r <> 0); [ intros Eq2 | apply Rabs_no_R0 ]; auto. -absurd (Rabs (/ r) ^ 0 < Rabs (/ r) ^ S n0); auto. -replace (Rabs (/ r) ^ S n0) with 1. -simpl in |- *; apply Rlt_irrefl; auto. -rewrite Rabs_Rinv; auto. -rewrite <- Rinv_pow; auto. -rewrite RPow_abs; auto. -rewrite H'0; rewrite Rabs_right; auto with real. -apply Rle_ge; auto with real. -apply Rlt_pow; auto with arith. -rewrite Rabs_Rinv; auto. -apply Rmult_lt_reg_l with (r := Rabs r). -case (Rabs_pos r); auto. -intros H'3; case Eq2; auto. -rewrite Rmult_1_r; rewrite Rinv_r; auto with real. -red in |- *; intro; absurd (r ^ S n0 = 1); auto. -simpl in |- *; rewrite H; rewrite Rmult_0_l; auto with real. -generalize H'; case n; auto. -intros n0 H'0. -cut (r <> 0); [ intros Eq1 | auto with real ]. -cut (Rabs r <> 0); [ intros Eq2 | apply Rabs_no_R0 ]; auto. -absurd (Rabs r ^ 0 < Rabs r ^ S n0); auto with real arith. -repeat rewrite RPow_abs; rewrite H'0; simpl in |- *; auto with real. -red in |- *; intro; absurd (r ^ S n0 = 1); auto. -simpl in |- *; rewrite H; rewrite Rmult_0_l; auto with real. + intros r n H'. + case (Req_dec (Rabs r) 1); auto; intros H'1. + case (Rdichotomy _ _ H'1); intros H'2. + generalize H'; case n; auto. + intros n0 H'0. + cut (r <> 0); [ intros Eq1 | idtac ]. + cut (Rabs r <> 0); [ intros Eq2 | apply Rabs_no_R0 ]; auto. + absurd (Rabs (/ r) ^ 0 < Rabs (/ r) ^ S n0); auto. + replace (Rabs (/ r) ^ S n0) with 1. + simpl in |- *; apply Rlt_irrefl; auto. + rewrite Rabs_Rinv; auto. + rewrite <- Rinv_pow; auto. + rewrite RPow_abs; auto. + rewrite H'0; rewrite Rabs_right; auto with real. + apply Rle_ge; auto with real. + apply Rlt_pow; auto with arith. + rewrite Rabs_Rinv; auto. + apply Rmult_lt_reg_l with (r := Rabs r). + case (Rabs_pos r); auto. + intros H'3; case Eq2; auto. + rewrite Rmult_1_r; rewrite Rinv_r; auto with real. + red in |- *; intro; absurd (r ^ S n0 = 1); auto. + simpl in |- *; rewrite H; rewrite Rmult_0_l; auto with real. + generalize H'; case n; auto. + intros n0 H'0. + cut (r <> 0); [ intros Eq1 | auto with real ]. + cut (Rabs r <> 0); [ intros Eq2 | apply Rabs_no_R0 ]; auto. + absurd (Rabs r ^ 0 < Rabs r ^ S n0); auto with real arith. + repeat rewrite RPow_abs; rewrite H'0; simpl in |- *; auto with real. + red in |- *; intro; absurd (r ^ S n0 = 1); auto. + simpl in |- *; rewrite H; rewrite Rmult_0_l; auto with real. Qed. Lemma pow_Rsqr : forall (x:R) (n:nat), x ^ (2 * n) = Rsqr x ^ n. Proof. -intros; induction n as [| n Hrecn]. -reflexivity. -replace (2 * S n)%nat with (S (S (2 * n))). -replace (x ^ S (S (2 * n))) with (x * x * x ^ (2 * n)). -rewrite Hrecn; reflexivity. -simpl in |- *; ring. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. + intros; induction n as [| n Hrecn]. + reflexivity. + replace (2 * S n)%nat with (S (S (2 * n))). + replace (x ^ S (S (2 * n))) with (x * x * x ^ (2 * n)). + rewrite Hrecn; reflexivity. + simpl in |- *; ring. + ring_nat. Qed. Lemma pow_le : forall (a:R) (n:nat), 0 <= a -> 0 <= a ^ n. Proof. -intros; induction n as [| n Hrecn]. -simpl in |- *; left; apply Rlt_0_1. -simpl in |- *; apply Rmult_le_pos; assumption. + intros; induction n as [| n Hrecn]. + simpl in |- *; left; apply Rlt_0_1. + simpl in |- *; apply Rmult_le_pos; assumption. Qed. (**********) Lemma pow_1_even : forall n:nat, (-1) ^ (2 * n) = 1. Proof. -intro; induction n as [| n Hrecn]. -reflexivity. -replace (2 * S n)%nat with (2 + 2 * n)%nat. -rewrite pow_add; rewrite Hrecn; simpl in |- *; ring. -replace (S n) with (n + 1)%nat; [ ring | ring ]. + intro; induction n as [| n Hrecn]. + reflexivity. + replace (2 * S n)%nat with (2 + 2 * n)%nat by ring. + rewrite pow_add; rewrite Hrecn; simpl in |- *; ring. Qed. (**********) Lemma pow_1_odd : forall n:nat, (-1) ^ S (2 * n) = -1. Proof. -intro; replace (S (2 * n)) with (2 * n + 1)%nat; [ idtac | ring ]. -rewrite pow_add; rewrite pow_1_even; simpl in |- *; ring. + intro; replace (S (2 * n)) with (2 * n + 1)%nat by ring. + rewrite pow_add; rewrite pow_1_even; simpl in |- *; ring. Qed. (**********) Lemma pow_1_abs : forall n:nat, Rabs ((-1) ^ n) = 1. Proof. -intro; induction n as [| n Hrecn]. -simpl in |- *; apply Rabs_R1. -replace (S n) with (n + 1)%nat; [ rewrite pow_add | ring ]. -rewrite Rabs_mult. -rewrite Hrecn; rewrite Rmult_1_l; simpl in |- *; rewrite Rmult_1_r; - rewrite Rabs_Ropp; apply Rabs_R1. + intro; induction n as [| n Hrecn]. + simpl in |- *; apply Rabs_R1. + replace (S n) with (n + 1)%nat; [ rewrite pow_add | ring ]. + rewrite Rabs_mult. + rewrite Hrecn; rewrite Rmult_1_l; simpl in |- *; rewrite Rmult_1_r; + rewrite Rabs_Ropp; apply Rabs_R1. Qed. Lemma pow_mult : forall (x:R) (n1 n2:nat), x ^ (n1 * n2) = (x ^ n1) ^ n2. Proof. -intros; induction n2 as [| n2 Hrecn2]. -simpl in |- *; replace (n1 * 0)%nat with 0%nat; [ reflexivity | ring ]. -replace (n1 * S n2)%nat with (n1 * n2 + n1)%nat. -replace (S n2) with (n2 + 1)%nat; [ idtac | ring ]. -do 2 rewrite pow_add. -rewrite Hrecn2. -simpl in |- *. -ring. -apply INR_eq; rewrite plus_INR; do 2 rewrite mult_INR; rewrite S_INR; ring. + intros; induction n2 as [| n2 Hrecn2]. + simpl in |- *; replace (n1 * 0)%nat with 0%nat; [ reflexivity | ring ]. + replace (n1 * S n2)%nat with (n1 * n2 + n1)%nat. + replace (S n2) with (n2 + 1)%nat by ring. + do 2 rewrite pow_add. + rewrite Hrecn2. + simpl in |- *. + ring. + ring_nat. Qed. Lemma pow_incr : forall (x y:R) (n:nat), 0 <= x <= y -> x ^ n <= y ^ n. Proof. -intros. -induction n as [| n Hrecn]. -right; reflexivity. -simpl in |- *. -elim H; intros. -apply Rle_trans with (y * x ^ n). -do 2 rewrite <- (Rmult_comm (x ^ n)). -apply Rmult_le_compat_l. -apply pow_le; assumption. -assumption. -apply Rmult_le_compat_l. -apply Rle_trans with x; assumption. -apply Hrecn. + intros. + induction n as [| n Hrecn]. + right; reflexivity. + simpl in |- *. + elim H; intros. + apply Rle_trans with (y * x ^ n). + do 2 rewrite <- (Rmult_comm (x ^ n)). + apply Rmult_le_compat_l. + apply pow_le; assumption. + assumption. + apply Rmult_le_compat_l. + apply Rle_trans with x; assumption. + apply Hrecn. Qed. Lemma pow_R1_Rle : forall (x:R) (k:nat), 1 <= x -> 1 <= x ^ k. Proof. -intros. -induction k as [| k Hreck]. -right; reflexivity. -simpl in |- *. -apply Rle_trans with (x * 1). -rewrite Rmult_1_r; assumption. -apply Rmult_le_compat_l. -left; apply Rlt_le_trans with 1; [ apply Rlt_0_1 | assumption ]. -exact Hreck. + intros. + induction k as [| k Hreck]. + right; reflexivity. + simpl in |- *. + apply Rle_trans with (x * 1). + rewrite Rmult_1_r; assumption. + apply Rmult_le_compat_l. + left; apply Rlt_le_trans with 1; [ apply Rlt_0_1 | assumption ]. + exact Hreck. Qed. Lemma Rle_pow : - forall (x:R) (m n:nat), 1 <= x -> (m <= n)%nat -> x ^ m <= x ^ n. + forall (x:R) (m n:nat), 1 <= x -> (m <= n)%nat -> x ^ m <= x ^ n. Proof. -intros. -replace n with (n - m + m)%nat. -rewrite pow_add. -rewrite Rmult_comm. -pattern (x ^ m) at 1 in |- *; rewrite <- Rmult_1_r. -apply Rmult_le_compat_l. -apply pow_le; left; apply Rlt_le_trans with 1; [ apply Rlt_0_1 | assumption ]. -apply pow_R1_Rle; assumption. -rewrite plus_comm. -symmetry in |- *; apply le_plus_minus; assumption. + intros. + replace n with (n - m + m)%nat. + rewrite pow_add. + rewrite Rmult_comm. + pattern (x ^ m) at 1 in |- *; rewrite <- Rmult_1_r. + apply Rmult_le_compat_l. + apply pow_le; left; apply Rlt_le_trans with 1; [ apply Rlt_0_1 | assumption ]. + apply pow_R1_Rle; assumption. + rewrite plus_comm. + symmetry in |- *; apply le_plus_minus; assumption. Qed. Lemma pow1 : forall n:nat, 1 ^ n = 1. Proof. -intro; induction n as [| n Hrecn]. -reflexivity. -simpl in |- *; rewrite Hrecn; rewrite Rmult_1_r; reflexivity. + intro; induction n as [| n Hrecn]. + reflexivity. + simpl in |- *; rewrite Hrecn; rewrite Rmult_1_r; reflexivity. Qed. Lemma pow_Rabs : forall (x:R) (n:nat), x ^ n <= Rabs x ^ n. Proof. -intros; induction n as [| n Hrecn]. -right; reflexivity. -simpl in |- *; case (Rcase_abs x); intro. -apply Rle_trans with (Rabs (x * x ^ n)). -apply RRle_abs. -rewrite Rabs_mult. -apply Rmult_le_compat_l. -apply Rabs_pos. -right; symmetry in |- *; apply RPow_abs. -pattern (Rabs x) at 1 in |- *; rewrite (Rabs_right x r); - apply Rmult_le_compat_l. -apply Rge_le; exact r. -apply Hrecn. + intros; induction n as [| n Hrecn]. + right; reflexivity. + simpl in |- *; case (Rcase_abs x); intro. + apply Rle_trans with (Rabs (x * x ^ n)). + apply RRle_abs. + rewrite Rabs_mult. + apply Rmult_le_compat_l. + apply Rabs_pos. + right; symmetry in |- *; apply RPow_abs. + pattern (Rabs x) at 1 in |- *; rewrite (Rabs_right x r); + apply Rmult_le_compat_l. + apply Rge_le; exact r. + apply Hrecn. Qed. Lemma pow_maj_Rabs : forall (x y:R) (n:nat), Rabs y <= x -> y ^ n <= x ^ n. Proof. -intros; cut (0 <= x). -intro; apply Rle_trans with (Rabs y ^ n). -apply pow_Rabs. -induction n as [| n Hrecn]. -right; reflexivity. -simpl in |- *; apply Rle_trans with (x * Rabs y ^ n). -do 2 rewrite <- (Rmult_comm (Rabs y ^ n)). -apply Rmult_le_compat_l. -apply pow_le; apply Rabs_pos. -assumption. -apply Rmult_le_compat_l. -apply H0. -apply Hrecn. -apply Rle_trans with (Rabs y); [ apply Rabs_pos | exact H ]. + intros; cut (0 <= x). + intro; apply Rle_trans with (Rabs y ^ n). + apply pow_Rabs. + induction n as [| n Hrecn]. + right; reflexivity. + simpl in |- *; apply Rle_trans with (x * Rabs y ^ n). + do 2 rewrite <- (Rmult_comm (Rabs y ^ n)). + apply Rmult_le_compat_l. + apply pow_le; apply Rabs_pos. + assumption. + apply Rmult_le_compat_l. + apply H0. + apply Hrecn. + apply Rle_trans with (Rabs y); [ apply Rabs_pos | exact H ]. Qed. (*******************************) -(** PowerRZ *) +(** * PowerRZ *) (*******************************) (*i Due to L.Thery i*) @@ -529,151 +529,151 @@ Ltac case_eq name := Definition powerRZ (x:R) (n:Z) := match n with - | Z0 => 1 - | Zpos p => x ^ nat_of_P p - | Zneg p => / x ^ nat_of_P p + | Z0 => 1 + | Zpos p => x ^ nat_of_P p + | Zneg p => / x ^ nat_of_P p end. Infix Local "^Z" := powerRZ (at level 30, right associativity) : R_scope. Lemma Zpower_NR0 : - forall (x:Z) (n:nat), (0 <= x)%Z -> (0 <= Zpower_nat x n)%Z. + forall (x:Z) (n:nat), (0 <= x)%Z -> (0 <= Zpower_nat x n)%Z. Proof. -induction n; unfold Zpower_nat in |- *; simpl in |- *; auto with zarith. + induction n; unfold Zpower_nat in |- *; simpl in |- *; auto with zarith. Qed. Lemma powerRZ_O : forall x:R, x ^Z 0 = 1. Proof. -reflexivity. + reflexivity. Qed. - + Lemma powerRZ_1 : forall x:R, x ^Z Zsucc 0 = x. Proof. -simpl in |- *; auto with real. + simpl in |- *; auto with real. Qed. - + Lemma powerRZ_NOR : forall (x:R) (z:Z), x <> 0 -> x ^Z z <> 0. Proof. -destruct z; simpl in |- *; auto with real. + destruct z; simpl in |- *; auto with real. Qed. - + Lemma powerRZ_add : - forall (x:R) (n m:Z), x <> 0 -> x ^Z (n + m) = x ^Z n * x ^Z m. + forall (x:R) (n m:Z), x <> 0 -> x ^Z (n + m) = x ^Z n * x ^Z m. Proof. -intro x; destruct n as [| n1| n1]; destruct m as [| m1| m1]; simpl in |- *; - auto with real. + intro x; destruct n as [| n1| n1]; destruct m as [| m1| m1]; simpl in |- *; + auto with real. (* POS/POS *) -rewrite nat_of_P_plus_morphism; auto with real. + rewrite nat_of_P_plus_morphism; auto with real. (* POS/NEG *) -case_eq ((n1 ?= m1)%positive Datatypes.Eq); simpl in |- *; auto with real. -intros H' H'0; rewrite Pcompare_Eq_eq with (1 := H'); auto with real. -intros H' H'0; rewrite (nat_of_P_minus_morphism m1 n1); auto with real. -rewrite (pow_RN_plus x (nat_of_P m1 - nat_of_P n1) (nat_of_P n1)); - auto with real. -rewrite plus_comm; rewrite le_plus_minus_r; auto with real. -rewrite Rinv_mult_distr; auto with real. -rewrite Rinv_involutive; auto with real. -apply lt_le_weak. -apply nat_of_P_lt_Lt_compare_morphism; auto. -apply ZC2; auto. -intros H' H'0; rewrite (nat_of_P_minus_morphism n1 m1); auto with real. -rewrite (pow_RN_plus x (nat_of_P n1 - nat_of_P m1) (nat_of_P m1)); - auto with real. -rewrite plus_comm; rewrite le_plus_minus_r; auto with real. -apply lt_le_weak. -change (nat_of_P n1 > nat_of_P m1)%nat in |- *. -apply nat_of_P_gt_Gt_compare_morphism; auto. + case_eq ((n1 ?= m1)%positive Datatypes.Eq); simpl in |- *; auto with real. + intros H' H'0; rewrite Pcompare_Eq_eq with (1 := H'); auto with real. + intros H' H'0; rewrite (nat_of_P_minus_morphism m1 n1); auto with real. + rewrite (pow_RN_plus x (nat_of_P m1 - nat_of_P n1) (nat_of_P n1)); + auto with real. + rewrite plus_comm; rewrite le_plus_minus_r; auto with real. + rewrite Rinv_mult_distr; auto with real. + rewrite Rinv_involutive; auto with real. + apply lt_le_weak. + apply nat_of_P_lt_Lt_compare_morphism; auto. + apply ZC2; auto. + intros H' H'0; rewrite (nat_of_P_minus_morphism n1 m1); auto with real. + rewrite (pow_RN_plus x (nat_of_P n1 - nat_of_P m1) (nat_of_P m1)); + auto with real. + rewrite plus_comm; rewrite le_plus_minus_r; auto with real. + apply lt_le_weak. + change (nat_of_P n1 > nat_of_P m1)%nat in |- *. + apply nat_of_P_gt_Gt_compare_morphism; auto. (* NEG/POS *) -case_eq ((n1 ?= m1)%positive Datatypes.Eq); simpl in |- *; auto with real. -intros H' H'0; rewrite Pcompare_Eq_eq with (1 := H'); auto with real. -intros H' H'0; rewrite (nat_of_P_minus_morphism m1 n1); auto with real. -rewrite (pow_RN_plus x (nat_of_P m1 - nat_of_P n1) (nat_of_P n1)); - auto with real. -rewrite plus_comm; rewrite le_plus_minus_r; auto with real. -apply lt_le_weak. -apply nat_of_P_lt_Lt_compare_morphism; auto. -apply ZC2; auto. -intros H' H'0; rewrite (nat_of_P_minus_morphism n1 m1); auto with real. -rewrite (pow_RN_plus x (nat_of_P n1 - nat_of_P m1) (nat_of_P m1)); - auto with real. -rewrite plus_comm; rewrite le_plus_minus_r; auto with real. -rewrite Rinv_mult_distr; auto with real. -apply lt_le_weak. -change (nat_of_P n1 > nat_of_P m1)%nat in |- *. -apply nat_of_P_gt_Gt_compare_morphism; auto. + case_eq ((n1 ?= m1)%positive Datatypes.Eq); simpl in |- *; auto with real. + intros H' H'0; rewrite Pcompare_Eq_eq with (1 := H'); auto with real. + intros H' H'0; rewrite (nat_of_P_minus_morphism m1 n1); auto with real. + rewrite (pow_RN_plus x (nat_of_P m1 - nat_of_P n1) (nat_of_P n1)); + auto with real. + rewrite plus_comm; rewrite le_plus_minus_r; auto with real. + apply lt_le_weak. + apply nat_of_P_lt_Lt_compare_morphism; auto. + apply ZC2; auto. + intros H' H'0; rewrite (nat_of_P_minus_morphism n1 m1); auto with real. + rewrite (pow_RN_plus x (nat_of_P n1 - nat_of_P m1) (nat_of_P m1)); + auto with real. + rewrite plus_comm; rewrite le_plus_minus_r; auto with real. + rewrite Rinv_mult_distr; auto with real. + apply lt_le_weak. + change (nat_of_P n1 > nat_of_P m1)%nat in |- *. + apply nat_of_P_gt_Gt_compare_morphism; auto. (* NEG/NEG *) -rewrite nat_of_P_plus_morphism; auto with real. -intros H'; rewrite pow_add; auto with real. -apply Rinv_mult_distr; auto. -apply pow_nonzero; auto. -apply pow_nonzero; auto. + rewrite nat_of_P_plus_morphism; auto with real. + intros H'; rewrite pow_add; auto with real. + apply Rinv_mult_distr; auto. + apply pow_nonzero; auto. + apply pow_nonzero; auto. Qed. Hint Resolve powerRZ_O powerRZ_1 powerRZ_NOR powerRZ_add: real. - + Lemma Zpower_nat_powerRZ : - forall n m:nat, IZR (Zpower_nat (Z_of_nat n) m) = INR n ^Z Z_of_nat m. -Proof. -intros n m; elim m; simpl in |- *; auto with real. -intros m1 H'; rewrite nat_of_P_o_P_of_succ_nat_eq_succ; simpl in |- *. -replace (Zpower_nat (Z_of_nat n) (S m1)) with - (Z_of_nat n * Zpower_nat (Z_of_nat n) m1)%Z. -rewrite mult_IZR; auto with real. -repeat rewrite <- INR_IZR_INZ; simpl in |- *. -rewrite H'; simpl in |- *. -case m1; simpl in |- *; auto with real. -intros m2; rewrite nat_of_P_o_P_of_succ_nat_eq_succ; auto. -unfold Zpower_nat in |- *; auto. -Qed. - + forall n m:nat, IZR (Zpower_nat (Z_of_nat n) m) = INR n ^Z Z_of_nat m. +Proof. + intros n m; elim m; simpl in |- *; auto with real. + intros m1 H'; rewrite nat_of_P_o_P_of_succ_nat_eq_succ; simpl in |- *. + replace (Zpower_nat (Z_of_nat n) (S m1)) with + (Z_of_nat n * Zpower_nat (Z_of_nat n) m1)%Z. + rewrite mult_IZR; auto with real. + repeat rewrite <- INR_IZR_INZ; simpl in |- *. + rewrite H'; simpl in |- *. + case m1; simpl in |- *; auto with real. + intros m2; rewrite nat_of_P_o_P_of_succ_nat_eq_succ; auto. + unfold Zpower_nat in |- *; auto. +Qed. + Lemma powerRZ_lt : forall (x:R) (z:Z), 0 < x -> 0 < x ^Z z. Proof. -intros x z; case z; simpl in |- *; auto with real. + intros x z; case z; simpl in |- *; auto with real. Qed. Hint Resolve powerRZ_lt: real. - + Lemma powerRZ_le : forall (x:R) (z:Z), 0 < x -> 0 <= x ^Z z. Proof. -intros x z H'; apply Rlt_le; auto with real. + intros x z H'; apply Rlt_le; auto with real. Qed. Hint Resolve powerRZ_le: real. - + Lemma Zpower_nat_powerRZ_absolu : - forall n m:Z, (0 <= m)%Z -> IZR (Zpower_nat n (Zabs_nat m)) = IZR n ^Z m. + forall n m:Z, (0 <= m)%Z -> IZR (Zpower_nat n (Zabs_nat m)) = IZR n ^Z m. Proof. -intros n m; case m; simpl in |- *; auto with zarith. -intros p H'; elim (nat_of_P p); simpl in |- *; auto with zarith. -intros n0 H'0; rewrite <- H'0; simpl in |- *; auto with zarith. -rewrite <- mult_IZR; auto. -intros p H'; absurd (0 <= Zneg p)%Z; auto with zarith. + intros n m; case m; simpl in |- *; auto with zarith. + intros p H'; elim (nat_of_P p); simpl in |- *; auto with zarith. + intros n0 H'0; rewrite <- H'0; simpl in |- *; auto with zarith. + rewrite <- mult_IZR; auto. + intros p H'; absurd (0 <= Zneg p)%Z; auto with zarith. Qed. Lemma powerRZ_R1 : forall n:Z, 1 ^Z n = 1. Proof. -intros n; case n; simpl in |- *; auto. -intros p; elim (nat_of_P p); simpl in |- *; auto; intros n0 H'; rewrite H'; - ring. -intros p; elim (nat_of_P p); simpl in |- *. -exact Rinv_1. -intros n1 H'; rewrite Rinv_mult_distr; try rewrite Rinv_1; try rewrite H'; - auto with real. + intros n; case n; simpl in |- *; auto. + intros p; elim (nat_of_P p); simpl in |- *; auto; intros n0 H'; rewrite H'; + ring. + intros p; elim (nat_of_P p); simpl in |- *. + exact Rinv_1. + intros n1 H'; rewrite Rinv_mult_distr; try rewrite Rinv_1; try rewrite H'; + auto with real. Qed. (*******************************) (* For easy interface *) (*******************************) (* decimal_exp r z is defined as r 10^z *) - + Definition decimal_exp (r:R) (z:Z) : R := (r * 10 ^Z z). (*******************************) -(** Sum of n first naturals *) +(** * Sum of n first naturals *) (*******************************) (*********) Boxed Fixpoint sum_nat_f_O (f:nat -> nat) (n:nat) {struct n} : nat := match n with - | O => f 0%nat - | S n' => (sum_nat_f_O f n' + f (S n'))%nat + | O => f 0%nat + | S n' => (sum_nat_f_O f n' + f (S n'))%nat end. (*********) @@ -687,13 +687,13 @@ Definition sum_nat_O (n:nat) : nat := sum_nat_f_O (fun x:nat => x) n. Definition sum_nat (s n:nat) : nat := sum_nat_f s n (fun x:nat => x). (*******************************) -(** Sum *) +(** * Sum *) (*******************************) (*********) Fixpoint sum_f_R0 (f:nat -> R) (N:nat) {struct N} : R := match N with - | O => f 0%nat - | S i => sum_f_R0 f i + f (S i) + | O => f 0%nat + | S i => sum_f_R0 f i + f (S i) end. (*********) @@ -701,35 +701,35 @@ Definition sum_f (s n:nat) (f:nat -> R) : R := sum_f_R0 (fun x:nat => f (x + s)%nat) (n - s). Lemma GP_finite : - forall (x:R) (n:nat), - sum_f_R0 (fun n:nat => x ^ n) n * (x - 1) = x ^ (n + 1) - 1. + forall (x:R) (n:nat), + sum_f_R0 (fun n:nat => x ^ n) n * (x - 1) = x ^ (n + 1) - 1. Proof. -intros; induction n as [| n Hrecn]; simpl in |- *. -ring. -rewrite Rmult_plus_distr_r; rewrite Hrecn; cut ((n + 1)%nat = S n). -intro H; rewrite H; simpl in |- *; ring. -omega. + intros; induction n as [| n Hrecn]; simpl in |- *. + ring. + rewrite Rmult_plus_distr_r; rewrite Hrecn; cut ((n + 1)%nat = S n). + intro H; rewrite H; simpl in |- *; ring. + omega. Qed. Lemma sum_f_R0_triangle : - forall (x:nat -> R) (n:nat), - Rabs (sum_f_R0 x n) <= sum_f_R0 (fun i:nat => Rabs (x i)) n. -Proof. -intro; simple induction n; simpl in |- *. -unfold Rle in |- *; right; reflexivity. -intro m; intro; - apply - (Rle_trans (Rabs (sum_f_R0 x m + x (S m))) - (Rabs (sum_f_R0 x m) + Rabs (x (S m))) - (sum_f_R0 (fun i:nat => Rabs (x i)) m + Rabs (x (S m)))). -apply Rabs_triang. -rewrite Rplus_comm; - rewrite (Rplus_comm (sum_f_R0 (fun i:nat => Rabs (x i)) m) (Rabs (x (S m)))); - apply Rplus_le_compat_l; assumption. + forall (x:nat -> R) (n:nat), + Rabs (sum_f_R0 x n) <= sum_f_R0 (fun i:nat => Rabs (x i)) n. +Proof. + intro; simple induction n; simpl in |- *. + unfold Rle in |- *; right; reflexivity. + intro m; intro; + apply + (Rle_trans (Rabs (sum_f_R0 x m + x (S m))) + (Rabs (sum_f_R0 x m) + Rabs (x (S m))) + (sum_f_R0 (fun i:nat => Rabs (x i)) m + Rabs (x (S m)))). + apply Rabs_triang. + rewrite Rplus_comm; + rewrite (Rplus_comm (sum_f_R0 (fun i:nat => Rabs (x i)) m) (Rabs (x (S m)))); + apply Rplus_le_compat_l; assumption. Qed. (*******************************) -(* Distance in R *) +(** * Distance in R *) (*******************************) (*********) @@ -738,64 +738,64 @@ Definition R_dist (x y:R) : R := Rabs (x - y). (*********) Lemma R_dist_pos : forall x y:R, R_dist x y >= 0. Proof. -intros; unfold R_dist in |- *; unfold Rabs in |- *; case (Rcase_abs (x - y)); - intro l. -unfold Rge in |- *; left; apply (Ropp_gt_lt_0_contravar (x - y) l). -trivial. + intros; unfold R_dist in |- *; unfold Rabs in |- *; case (Rcase_abs (x - y)); + intro l. + unfold Rge in |- *; left; apply (Ropp_gt_lt_0_contravar (x - y) l). + trivial. Qed. (*********) Lemma R_dist_sym : forall x y:R, R_dist x y = R_dist y x. Proof. -unfold R_dist in |- *; intros; split_Rabs; ring. -generalize (Ropp_gt_lt_0_contravar (y - x) r); intro; - rewrite (Ropp_minus_distr y x) in H; generalize (Rlt_asym (x - y) 0 r0); - intro; unfold Rgt in H; elimtype False; auto. -generalize (minus_Rge y x r); intro; generalize (minus_Rge x y r0); intro; - generalize (Rge_antisym x y H0 H); intro; rewrite H1; - ring. + unfold R_dist in |- *; intros; split_Rabs; try ring. + generalize (Ropp_gt_lt_0_contravar (y - x) r); intro; + rewrite (Ropp_minus_distr y x) in H; generalize (Rlt_asym (x - y) 0 r0); + intro; unfold Rgt in H; elimtype False; auto. + generalize (minus_Rge y x r); intro; generalize (minus_Rge x y r0); intro; + generalize (Rge_antisym x y H0 H); intro; rewrite H1; + ring. Qed. (*********) Lemma R_dist_refl : forall x y:R, R_dist x y = 0 <-> x = y. Proof. -unfold R_dist in |- *; intros; split_Rabs; split; intros. -rewrite (Ropp_minus_distr x y) in H; apply sym_eq; - apply (Rminus_diag_uniq y x H). -rewrite (Ropp_minus_distr x y); generalize (sym_eq H); intro; - apply (Rminus_diag_eq y x H0). -apply (Rminus_diag_uniq x y H). -apply (Rminus_diag_eq x y H). + unfold R_dist in |- *; intros; split_Rabs; split; intros. + rewrite (Ropp_minus_distr x y) in H; apply sym_eq; + apply (Rminus_diag_uniq y x H). + rewrite (Ropp_minus_distr x y); generalize (sym_eq H); intro; + apply (Rminus_diag_eq y x H0). + apply (Rminus_diag_uniq x y H). + apply (Rminus_diag_eq x y H). Qed. Lemma R_dist_eq : forall x:R, R_dist x x = 0. Proof. -unfold R_dist in |- *; intros; split_Rabs; intros; ring. + unfold R_dist in |- *; intros; split_Rabs; intros; ring. Qed. (***********) Lemma R_dist_tri : forall x y z:R, R_dist x y <= R_dist x z + R_dist z y. Proof. -intros; unfold R_dist in |- *; replace (x - y) with (x - z + (z - y)); - [ apply (Rabs_triang (x - z) (z - y)) | ring ]. + intros; unfold R_dist in |- *; replace (x - y) with (x - z + (z - y)); + [ apply (Rabs_triang (x - z) (z - y)) | ring ]. Qed. (*********) Lemma R_dist_plus : - forall a b c d:R, R_dist (a + c) (b + d) <= R_dist a b + R_dist c d. + forall a b c d:R, R_dist (a + c) (b + d) <= R_dist a b + R_dist c d. Proof. -intros; unfold R_dist in |- *; - replace (a + c - (b + d)) with (a - b + (c - d)). -exact (Rabs_triang (a - b) (c - d)). -ring. + intros; unfold R_dist in |- *; + replace (a + c - (b + d)) with (a - b + (c - d)). + exact (Rabs_triang (a - b) (c - d)). + ring. Qed. (*******************************) -(** Infinit Sum *) +(** * Infinit Sum *) (*******************************) (*********) Definition infinit_sum (s:nat -> R) (l:R) : Prop := forall eps:R, eps > 0 -> - exists N : nat, + exists N : nat, (forall n:nat, (n >= N)%nat -> R_dist (sum_f_R0 s n) l < eps). diff --git a/theories/Reals/Rgeom.v b/theories/Reals/Rgeom.v index 9ce20839..8ac9c07f 100644 --- a/theories/Reals/Rgeom.v +++ b/theories/Reals/Rgeom.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Rgeom.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Rgeom.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -14,174 +14,188 @@ Require Import SeqSeries. Require Import Rtrigo. Require Import R_sqrt. Open Local Scope R_scope. +(** * Distance *) + Definition dist_euc (x0 y0 x1 y1:R) : R := sqrt (Rsqr (x0 - x1) + Rsqr (y0 - y1)). Lemma distance_refl : forall x0 y0:R, dist_euc x0 y0 x0 y0 = 0. -intros x0 y0; unfold dist_euc in |- *; apply Rsqr_inj; - [ apply sqrt_positivity; apply Rplus_le_le_0_compat; - [ apply Rle_0_sqr | apply Rle_0_sqr ] - | right; reflexivity - | rewrite Rsqr_0; rewrite Rsqr_sqrt; - [ unfold Rsqr in |- *; ring - | apply Rplus_le_le_0_compat; [ apply Rle_0_sqr | apply Rle_0_sqr ] ] ]. +Proof. + intros x0 y0; unfold dist_euc in |- *; apply Rsqr_inj; + [ apply sqrt_positivity; apply Rplus_le_le_0_compat; + [ apply Rle_0_sqr | apply Rle_0_sqr ] + | right; reflexivity + | rewrite Rsqr_0; rewrite Rsqr_sqrt; + [ unfold Rsqr in |- *; ring + | apply Rplus_le_le_0_compat; [ apply Rle_0_sqr | apply Rle_0_sqr ] ] ]. Qed. Lemma distance_symm : - forall x0 y0 x1 y1:R, dist_euc x0 y0 x1 y1 = dist_euc x1 y1 x0 y0. -intros x0 y0 x1 y1; unfold dist_euc in |- *; apply Rsqr_inj; - [ apply sqrt_positivity; apply Rplus_le_le_0_compat - | apply sqrt_positivity; apply Rplus_le_le_0_compat - | repeat rewrite Rsqr_sqrt; - [ unfold Rsqr in |- *; ring - | apply Rplus_le_le_0_compat - | apply Rplus_le_le_0_compat ] ]; apply Rle_0_sqr. + forall x0 y0 x1 y1:R, dist_euc x0 y0 x1 y1 = dist_euc x1 y1 x0 y0. +Proof. + intros x0 y0 x1 y1; unfold dist_euc in |- *; apply Rsqr_inj; + [ apply sqrt_positivity; apply Rplus_le_le_0_compat + | apply sqrt_positivity; apply Rplus_le_le_0_compat + | repeat rewrite Rsqr_sqrt; + [ unfold Rsqr in |- *; ring + | apply Rplus_le_le_0_compat + | apply Rplus_le_le_0_compat ] ]; apply Rle_0_sqr. Qed. Lemma law_cosines : - forall x0 y0 x1 y1 x2 y2 ac:R, - let a := dist_euc x1 y1 x0 y0 in - let b := dist_euc x2 y2 x0 y0 in - let c := dist_euc x2 y2 x1 y1 in - a * c * cos ac = (x0 - x1) * (x2 - x1) + (y0 - y1) * (y2 - y1) -> - Rsqr b = Rsqr c + Rsqr a - 2 * (a * c * cos ac). -unfold dist_euc in |- *; intros; repeat rewrite Rsqr_sqrt; - [ rewrite H; unfold Rsqr in |- *; ring - | apply Rplus_le_le_0_compat - | apply Rplus_le_le_0_compat - | apply Rplus_le_le_0_compat ]; apply Rle_0_sqr. + forall x0 y0 x1 y1 x2 y2 ac:R, + let a := dist_euc x1 y1 x0 y0 in + let b := dist_euc x2 y2 x0 y0 in + let c := dist_euc x2 y2 x1 y1 in + a * c * cos ac = (x0 - x1) * (x2 - x1) + (y0 - y1) * (y2 - y1) -> + Rsqr b = Rsqr c + Rsqr a - 2 * (a * c * cos ac). +Proof. + unfold dist_euc in |- *; intros; repeat rewrite Rsqr_sqrt; + [ rewrite H; unfold Rsqr in |- *; ring + | apply Rplus_le_le_0_compat + | apply Rplus_le_le_0_compat + | apply Rplus_le_le_0_compat ]; apply Rle_0_sqr. Qed. Lemma triangle : - forall x0 y0 x1 y1 x2 y2:R, - dist_euc x0 y0 x1 y1 <= dist_euc x0 y0 x2 y2 + dist_euc x2 y2 x1 y1. -intros; unfold dist_euc in |- *; apply Rsqr_incr_0; - [ rewrite Rsqr_plus; repeat rewrite Rsqr_sqrt; - [ replace (Rsqr (x0 - x1)) with - (Rsqr (x0 - x2) + Rsqr (x2 - x1) + 2 * (x0 - x2) * (x2 - x1)); - [ replace (Rsqr (y0 - y1)) with + forall x0 y0 x1 y1 x2 y2:R, + dist_euc x0 y0 x1 y1 <= dist_euc x0 y0 x2 y2 + dist_euc x2 y2 x1 y1. +Proof. + intros; unfold dist_euc in |- *; apply Rsqr_incr_0; + [ rewrite Rsqr_plus; repeat rewrite Rsqr_sqrt; + [ replace (Rsqr (x0 - x1)) with + (Rsqr (x0 - x2) + Rsqr (x2 - x1) + 2 * (x0 - x2) * (x2 - x1)); + [ replace (Rsqr (y0 - y1)) with (Rsqr (y0 - y2) + Rsqr (y2 - y1) + 2 * (y0 - y2) * (y2 - y1)); [ apply Rplus_le_reg_l with - (- Rsqr (x0 - x2) - Rsqr (x2 - x1) - Rsqr (y0 - y2) - + (- Rsqr (x0 - x2) - Rsqr (x2 - x1) - Rsqr (y0 - y2) - Rsqr (y2 - y1)); - replace - (- Rsqr (x0 - x2) - Rsqr (x2 - x1) - Rsqr (y0 - y2) - - Rsqr (y2 - y1) + - (Rsqr (x0 - x2) + Rsqr (x2 - x1) + 2 * (x0 - x2) * (x2 - x1) + + replace + (- Rsqr (x0 - x2) - Rsqr (x2 - x1) - Rsqr (y0 - y2) - + Rsqr (y2 - y1) + + (Rsqr (x0 - x2) + Rsqr (x2 - x1) + 2 * (x0 - x2) * (x2 - x1) + (Rsqr (y0 - y2) + Rsqr (y2 - y1) + 2 * (y0 - y2) * (y2 - y1)))) - with (2 * ((x0 - x2) * (x2 - x1) + (y0 - y2) * (y2 - y1))); - [ replace + with (2 * ((x0 - x2) * (x2 - x1) + (y0 - y2) * (y2 - y1))); + [ replace (- Rsqr (x0 - x2) - Rsqr (x2 - x1) - Rsqr (y0 - y2) - - Rsqr (y2 - y1) + - (Rsqr (x0 - x2) + Rsqr (y0 - y2) + - (Rsqr (x2 - x1) + Rsqr (y2 - y1)) + - 2 * sqrt (Rsqr (x0 - x2) + Rsqr (y0 - y2)) * - sqrt (Rsqr (x2 - x1) + Rsqr (y2 - y1)))) with + Rsqr (y2 - y1) + + (Rsqr (x0 - x2) + Rsqr (y0 - y2) + + (Rsqr (x2 - x1) + Rsqr (y2 - y1)) + + 2 * sqrt (Rsqr (x0 - x2) + Rsqr (y0 - y2)) * + sqrt (Rsqr (x2 - x1) + Rsqr (y2 - y1)))) with (2 * - (sqrt (Rsqr (x0 - x2) + Rsqr (y0 - y2)) * - sqrt (Rsqr (x2 - x1) + Rsqr (y2 - y1)))); + (sqrt (Rsqr (x0 - x2) + Rsqr (y0 - y2)) * + sqrt (Rsqr (x2 - x1) + Rsqr (y2 - y1)))); [ apply Rmult_le_compat_l; - [ left; cut (0%nat <> 2%nat); - [ intros; generalize (lt_INR_0 2 (neq_O_lt 2 H)); - intro H0; assumption + [ left; cut (0%nat <> 2%nat); + [ intros; generalize (lt_INR_0 2 (neq_O_lt 2 H)); + intro H0; assumption | discriminate ] - | apply sqrt_cauchy ] + | apply sqrt_cauchy ] + | ring ] | ring ] - | ring ] + | ring_Rsqr ] | ring_Rsqr ] - | ring_Rsqr ] - | apply Rplus_le_le_0_compat; apply Rle_0_sqr - | apply Rplus_le_le_0_compat; apply Rle_0_sqr - | apply Rplus_le_le_0_compat; apply Rle_0_sqr ] - | apply sqrt_positivity; apply Rplus_le_le_0_compat; apply Rle_0_sqr - | apply Rplus_le_le_0_compat; apply sqrt_positivity; - apply Rplus_le_le_0_compat; apply Rle_0_sqr ]. + | apply Rplus_le_le_0_compat; apply Rle_0_sqr + | apply Rplus_le_le_0_compat; apply Rle_0_sqr + | apply Rplus_le_le_0_compat; apply Rle_0_sqr ] + | apply sqrt_positivity; apply Rplus_le_le_0_compat; apply Rle_0_sqr + | apply Rplus_le_le_0_compat; apply sqrt_positivity; + apply Rplus_le_le_0_compat; apply Rle_0_sqr ]. Qed. (******************************************************************) -(** Translation *) +(** * Translation *) (******************************************************************) Definition xt (x tx:R) : R := x + tx. Definition yt (y ty:R) : R := y + ty. Lemma translation_0 : forall x y:R, xt x 0 = x /\ yt y 0 = y. -intros x y; split; [ unfold xt in |- * | unfold yt in |- * ]; ring. +Proof. + intros x y; split; [ unfold xt in |- * | unfold yt in |- * ]; ring. Qed. Lemma isometric_translation : - forall x1 x2 y1 y2 tx ty:R, - Rsqr (x1 - x2) + Rsqr (y1 - y2) = - Rsqr (xt x1 tx - xt x2 tx) + Rsqr (yt y1 ty - yt y2 ty). -intros; unfold Rsqr, xt, yt in |- *; ring. + forall x1 x2 y1 y2 tx ty:R, + Rsqr (x1 - x2) + Rsqr (y1 - y2) = + Rsqr (xt x1 tx - xt x2 tx) + Rsqr (yt y1 ty - yt y2 ty). +Proof. + intros; unfold Rsqr, xt, yt in |- *; ring. Qed. (******************************************************************) -(** Rotation *) +(** * Rotation *) (******************************************************************) Definition xr (x y theta:R) : R := x * cos theta + y * sin theta. Definition yr (x y theta:R) : R := - x * sin theta + y * cos theta. Lemma rotation_0 : forall x y:R, xr x y 0 = x /\ yr x y 0 = y. -intros x y; unfold xr, yr in |- *; split; rewrite cos_0; rewrite sin_0; ring. +Proof. + intros x y; unfold xr, yr in |- *; split; rewrite cos_0; rewrite sin_0; ring. Qed. Lemma rotation_PI2 : - forall x y:R, xr x y (PI / 2) = y /\ yr x y (PI / 2) = - x. -intros x y; unfold xr, yr in |- *; split; rewrite cos_PI2; rewrite sin_PI2; - ring. + forall x y:R, xr x y (PI / 2) = y /\ yr x y (PI / 2) = - x. +Proof. + intros x y; unfold xr, yr in |- *; split; rewrite cos_PI2; rewrite sin_PI2; + ring. Qed. Lemma isometric_rotation_0 : - forall x1 y1 x2 y2 theta:R, - Rsqr (x1 - x2) + Rsqr (y1 - y2) = - Rsqr (xr x1 y1 theta - xr x2 y2 theta) + - Rsqr (yr x1 y1 theta - yr x2 y2 theta). -intros; unfold xr, yr in |- *; - replace - (x1 * cos theta + y1 * sin theta - (x2 * cos theta + y2 * sin theta)) with - (cos theta * (x1 - x2) + sin theta * (y1 - y2)); - [ replace - (- x1 * sin theta + y1 * cos theta - (- x2 * sin theta + y2 * cos theta)) - with (cos theta * (y1 - y2) + sin theta * (x2 - x1)); - [ repeat rewrite Rsqr_plus; repeat rewrite Rsqr_mult; repeat rewrite cos2; - ring; replace (x2 - x1) with (- (x1 - x2)); - [ rewrite <- Rsqr_neg; ring | ring ] - | ring ] - | ring ]. + forall x1 y1 x2 y2 theta:R, + Rsqr (x1 - x2) + Rsqr (y1 - y2) = + Rsqr (xr x1 y1 theta - xr x2 y2 theta) + + Rsqr (yr x1 y1 theta - yr x2 y2 theta). +Proof. + intros; unfold xr, yr in |- *; + replace + (x1 * cos theta + y1 * sin theta - (x2 * cos theta + y2 * sin theta)) with + (cos theta * (x1 - x2) + sin theta * (y1 - y2)); + [ replace + (- x1 * sin theta + y1 * cos theta - (- x2 * sin theta + y2 * cos theta)) + with (cos theta * (y1 - y2) + sin theta * (x2 - x1)); + [ repeat rewrite Rsqr_plus; repeat rewrite Rsqr_mult; repeat rewrite cos2; + ring_simplify; replace (x2 - x1) with (- (x1 - x2)); + [ rewrite <- Rsqr_neg; ring | ring ] + | ring ] + | ring ]. Qed. Lemma isometric_rotation : - forall x1 y1 x2 y2 theta:R, - dist_euc x1 y1 x2 y2 = - dist_euc (xr x1 y1 theta) (yr x1 y1 theta) (xr x2 y2 theta) - (yr x2 y2 theta). -unfold dist_euc in |- *; intros; apply Rsqr_inj; - [ apply sqrt_positivity; apply Rplus_le_le_0_compat - | apply sqrt_positivity; apply Rplus_le_le_0_compat - | repeat rewrite Rsqr_sqrt; - [ apply isometric_rotation_0 - | apply Rplus_le_le_0_compat - | apply Rplus_le_le_0_compat ] ]; apply Rle_0_sqr. + forall x1 y1 x2 y2 theta:R, + dist_euc x1 y1 x2 y2 = + dist_euc (xr x1 y1 theta) (yr x1 y1 theta) (xr x2 y2 theta) + (yr x2 y2 theta). +Proof. + unfold dist_euc in |- *; intros; apply Rsqr_inj; + [ apply sqrt_positivity; apply Rplus_le_le_0_compat + | apply sqrt_positivity; apply Rplus_le_le_0_compat + | repeat rewrite Rsqr_sqrt; + [ apply isometric_rotation_0 + | apply Rplus_le_le_0_compat + | apply Rplus_le_le_0_compat ] ]; apply Rle_0_sqr. Qed. (******************************************************************) -(** Similarity *) +(** * Similarity *) (******************************************************************) Lemma isometric_rot_trans : - forall x1 y1 x2 y2 tx ty theta:R, - Rsqr (x1 - x2) + Rsqr (y1 - y2) = - Rsqr (xr (xt x1 tx) (yt y1 ty) theta - xr (xt x2 tx) (yt y2 ty) theta) + - Rsqr (yr (xt x1 tx) (yt y1 ty) theta - yr (xt x2 tx) (yt y2 ty) theta). -intros; rewrite <- isometric_rotation_0; apply isometric_translation. + forall x1 y1 x2 y2 tx ty theta:R, + Rsqr (x1 - x2) + Rsqr (y1 - y2) = + Rsqr (xr (xt x1 tx) (yt y1 ty) theta - xr (xt x2 tx) (yt y2 ty) theta) + + Rsqr (yr (xt x1 tx) (yt y1 ty) theta - yr (xt x2 tx) (yt y2 ty) theta). +Proof. + intros; rewrite <- isometric_rotation_0; apply isometric_translation. Qed. Lemma isometric_trans_rot : - forall x1 y1 x2 y2 tx ty theta:R, - Rsqr (x1 - x2) + Rsqr (y1 - y2) = - Rsqr (xt (xr x1 y1 theta) tx - xt (xr x2 y2 theta) tx) + - Rsqr (yt (yr x1 y1 theta) ty - yt (yr x2 y2 theta) ty). -intros; rewrite <- isometric_translation; apply isometric_rotation_0. -Qed.
\ No newline at end of file + forall x1 y1 x2 y2 tx ty theta:R, + Rsqr (x1 - x2) + Rsqr (y1 - y2) = + Rsqr (xt (xr x1 y1 theta) tx - xt (xr x2 y2 theta) tx) + + Rsqr (yt (yr x1 y1 theta) ty - yt (yr x2 y2 theta) ty). +Proof. + intros; rewrite <- isometric_translation; apply isometric_rotation_0. +Qed. diff --git a/theories/Reals/RiemannInt.v b/theories/Reals/RiemannInt.v index 79cb7797..1cba821e 100644 --- a/theories/Reals/RiemannInt.v +++ b/theories/Reals/RiemannInt.v @@ -5,8 +5,8 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) - -(*i $Id: RiemannInt.v 7223 2005-07-13 23:43:54Z herbelin $ i*) + +(*i $Id: RiemannInt.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rfunctions. Require Import SeqSeries. @@ -20,3244 +20,3298 @@ Require Import Max. Open Local Scope R_scope. Set Implicit Arguments. (********************************************) -(* Riemann's Integral *) +(** Riemann's Integral *) (********************************************) Definition Riemann_integrable (f:R -> R) (a b:R) : Type := forall eps:posreal, sigT - (fun phi:StepFun a b => - sigT - (fun psi:StepFun a b => - (forall t:R, - Rmin a b <= t <= Rmax a b -> Rabs (f t - phi t) <= psi t) /\ - Rabs (RiemannInt_SF psi) < eps)). + (fun phi:StepFun a b => + sigT + (fun psi:StepFun a b => + (forall t:R, + Rmin a b <= t <= Rmax a b -> Rabs (f t - phi t) <= psi t) /\ + Rabs (RiemannInt_SF psi) < eps)). Definition phi_sequence (un:nat -> posreal) (f:R -> R) (a b:R) (pr:Riemann_integrable f a b) (n:nat) := projT1 (pr (un n)). Lemma phi_sequence_prop : - forall (un:nat -> posreal) (f:R -> R) (a b:R) (pr:Riemann_integrable f a b) - (N:nat), - sigT - (fun psi:StepFun a b => - (forall t:R, - Rmin a b <= t <= Rmax a b -> - Rabs (f t - phi_sequence un pr N t) <= psi t) /\ - Rabs (RiemannInt_SF psi) < un N). -intros; apply (projT2 (pr (un N))). + forall (un:nat -> posreal) (f:R -> R) (a b:R) (pr:Riemann_integrable f a b) + (N:nat), + sigT + (fun psi:StepFun a b => + (forall t:R, + Rmin a b <= t <= Rmax a b -> + Rabs (f t - phi_sequence un pr N t) <= psi t) /\ + Rabs (RiemannInt_SF psi) < un N). +Proof. + intros; apply (projT2 (pr (un N))). Qed. Lemma RiemannInt_P1 : - forall (f:R -> R) (a b:R), - Riemann_integrable f a b -> Riemann_integrable f b a. -unfold Riemann_integrable in |- *; intros; elim (X eps); clear X; intros; - elim p; clear p; intros; apply existT with (mkStepFun (StepFun_P6 (pre x))); - apply existT with (mkStepFun (StepFun_P6 (pre x0))); - elim p; clear p; intros; split. -intros; apply (H t); elim H1; clear H1; intros; split; - [ apply Rle_trans with (Rmin b a); try assumption; right; - unfold Rmin in |- * - | apply Rle_trans with (Rmax b a); try assumption; right; - unfold Rmax in |- * ]; - (case (Rle_dec a b); case (Rle_dec b a); intros; - try reflexivity || apply Rle_antisym; - [ assumption | assumption | auto with real | auto with real ]). -generalize H0; unfold RiemannInt_SF in |- *; case (Rle_dec a b); - case (Rle_dec b a); intros; - (replace - (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre x0)))) - (subdivision (mkStepFun (StepFun_P6 (pre x0))))) with - (Int_SF (subdivision_val x0) (subdivision x0)); - [ idtac - | apply StepFun_P17 with (fe x0) a b; - [ apply StepFun_P1 - | apply StepFun_P2; - apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre x0)))) ] ]). -apply H1. -rewrite Rabs_Ropp; apply H1. -rewrite Rabs_Ropp in H1; apply H1. -apply H1. + forall (f:R -> R) (a b:R), + Riemann_integrable f a b -> Riemann_integrable f b a. +Proof. + unfold Riemann_integrable in |- *; intros; elim (X eps); clear X; intros; + elim p; clear p; intros; apply existT with (mkStepFun (StepFun_P6 (pre x))); + apply existT with (mkStepFun (StepFun_P6 (pre x0))); + elim p; clear p; intros; split. + intros; apply (H t); elim H1; clear H1; intros; split; + [ apply Rle_trans with (Rmin b a); try assumption; right; + unfold Rmin in |- * + | apply Rle_trans with (Rmax b a); try assumption; right; + unfold Rmax in |- * ]; + (case (Rle_dec a b); case (Rle_dec b a); intros; + try reflexivity || apply Rle_antisym; + [ assumption | assumption | auto with real | auto with real ]). + generalize H0; unfold RiemannInt_SF in |- *; case (Rle_dec a b); + case (Rle_dec b a); intros; + (replace + (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre x0)))) + (subdivision (mkStepFun (StepFun_P6 (pre x0))))) with + (Int_SF (subdivision_val x0) (subdivision x0)); + [ idtac + | apply StepFun_P17 with (fe x0) a b; + [ apply StepFun_P1 + | apply StepFun_P2; + apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre x0)))) ] ]). + apply H1. + rewrite Rabs_Ropp; apply H1. + rewrite Rabs_Ropp in H1; apply H1. + apply H1. Qed. Lemma RiemannInt_P2 : - forall (f:R -> R) (a b:R) (un:nat -> posreal) (vn wn:nat -> StepFun a b), - Un_cv un 0 -> - a <= b -> - (forall n:nat, + forall (f:R -> R) (a b:R) (un:nat -> posreal) (vn wn:nat -> StepFun a b), + Un_cv un 0 -> + a <= b -> + (forall n:nat, (forall t:R, Rmin a b <= t <= Rmax a b -> Rabs (f t - vn n t) <= wn n t) /\ Rabs (RiemannInt_SF (wn n)) < un n) -> - sigT (fun l:R => Un_cv (fun N:nat => RiemannInt_SF (vn N)) l). -intros; apply R_complete; unfold Un_cv in H; unfold Cauchy_crit in |- *; - intros; assert (H3 : 0 < eps / 2). -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. -elim (H _ H3); intros N0 H4; exists N0; intros; unfold R_dist in |- *; - unfold R_dist in H4; elim (H1 n); elim (H1 m); intros; - replace (RiemannInt_SF (vn n) - RiemannInt_SF (vn m)) with - (RiemannInt_SF (vn n) + -1 * RiemannInt_SF (vn m)); - [ idtac | ring ]; rewrite <- StepFun_P30; - apply Rle_lt_trans with - (RiemannInt_SF - (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (vn n) (vn m)))))). -apply StepFun_P34; assumption. -apply Rle_lt_trans with - (RiemannInt_SF (mkStepFun (StepFun_P28 1 (wn n) (wn m)))). -apply StepFun_P37; try assumption. -intros; simpl in |- *; - apply Rle_trans with (Rabs (vn n x - f x) + Rabs (f x - vn m x)). -replace (vn n x + -1 * vn m x) with (vn n x - f x + (f x - vn m x)); - [ apply Rabs_triang | ring ]. -assert (H12 : Rmin a b = a). -unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n0; assumption ]. -assert (H13 : Rmax a b = b). -unfold Rmax in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n0; assumption ]. -rewrite <- H12 in H11; pattern b at 2 in H11; rewrite <- H13 in H11; - rewrite Rmult_1_l; apply Rplus_le_compat. -rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H9. -elim H11; intros; split; left; assumption. -apply H7. -elim H11; intros; split; left; assumption. -rewrite StepFun_P30; rewrite Rmult_1_l; apply Rlt_trans with (un n + un m). -apply Rle_lt_trans with - (Rabs (RiemannInt_SF (wn n)) + Rabs (RiemannInt_SF (wn m))). -apply Rplus_le_compat; apply RRle_abs. -apply Rplus_lt_compat; assumption. -apply Rle_lt_trans with (Rabs (un n) + Rabs (un m)). -apply Rplus_le_compat; apply RRle_abs. -replace (pos (un n)) with (un n - 0); [ idtac | ring ]; - replace (pos (un m)) with (un m - 0); [ idtac | ring ]; - rewrite (double_var eps); apply Rplus_lt_compat; apply H4; - assumption. + sigT (fun l:R => Un_cv (fun N:nat => RiemannInt_SF (vn N)) l). +Proof. + intros; apply R_complete; unfold Un_cv in H; unfold Cauchy_crit in |- *; + intros; assert (H3 : 0 < eps / 2). + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. + elim (H _ H3); intros N0 H4; exists N0; intros; unfold R_dist in |- *; + unfold R_dist in H4; elim (H1 n); elim (H1 m); intros; + replace (RiemannInt_SF (vn n) - RiemannInt_SF (vn m)) with + (RiemannInt_SF (vn n) + -1 * RiemannInt_SF (vn m)); + [ idtac | ring ]; rewrite <- StepFun_P30; + apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (vn n) (vn m)))))). + apply StepFun_P34; assumption. + apply Rle_lt_trans with + (RiemannInt_SF (mkStepFun (StepFun_P28 1 (wn n) (wn m)))). + apply StepFun_P37; try assumption. + intros; simpl in |- *; + apply Rle_trans with (Rabs (vn n x - f x) + Rabs (f x - vn m x)). + replace (vn n x + -1 * vn m x) with (vn n x - f x + (f x - vn m x)); + [ apply Rabs_triang | ring ]. + assert (H12 : Rmin a b = a). + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. + assert (H13 : Rmax a b = b). + unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. + rewrite <- H12 in H11; pattern b at 2 in H11; rewrite <- H13 in H11; + rewrite Rmult_1_l; apply Rplus_le_compat. + rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H9. + elim H11; intros; split; left; assumption. + apply H7. + elim H11; intros; split; left; assumption. + rewrite StepFun_P30; rewrite Rmult_1_l; apply Rlt_trans with (un n + un m). + apply Rle_lt_trans with + (Rabs (RiemannInt_SF (wn n)) + Rabs (RiemannInt_SF (wn m))). + apply Rplus_le_compat; apply RRle_abs. + apply Rplus_lt_compat; assumption. + apply Rle_lt_trans with (Rabs (un n) + Rabs (un m)). + apply Rplus_le_compat; apply RRle_abs. + replace (pos (un n)) with (un n - 0); [ idtac | ring ]; + replace (pos (un m)) with (un m - 0); [ idtac | ring ]; + rewrite (double_var eps); apply Rplus_lt_compat; apply H4; + assumption. Qed. Lemma RiemannInt_P3 : - forall (f:R -> R) (a b:R) (un:nat -> posreal) (vn wn:nat -> StepFun a b), - Un_cv un 0 -> - (forall n:nat, + forall (f:R -> R) (a b:R) (un:nat -> posreal) (vn wn:nat -> StepFun a b), + Un_cv un 0 -> + (forall n:nat, (forall t:R, Rmin a b <= t <= Rmax a b -> Rabs (f t - vn n t) <= wn n t) /\ Rabs (RiemannInt_SF (wn n)) < un n) -> - sigT (fun l:R => Un_cv (fun N:nat => RiemannInt_SF (vn N)) l). -intros; case (Rle_dec a b); intro. -apply RiemannInt_P2 with f un wn; assumption. -assert (H1 : b <= a); auto with real. -set (vn' := fun n:nat => mkStepFun (StepFun_P6 (pre (vn n)))); - set (wn' := fun n:nat => mkStepFun (StepFun_P6 (pre (wn n)))); - assert - (H2 : - forall n:nat, - (forall t:R, - Rmin b a <= t <= Rmax b a -> Rabs (f t - vn' n t) <= wn' n t) /\ - Rabs (RiemannInt_SF (wn' n)) < un n). -intro; elim (H0 n0); intros; split. -intros; apply (H2 t); elim H4; clear H4; intros; split; - [ apply Rle_trans with (Rmin b a); try assumption; right; - unfold Rmin in |- * - | apply Rle_trans with (Rmax b a); try assumption; right; - unfold Rmax in |- * ]; - (case (Rle_dec a b); case (Rle_dec b a); intros; - try reflexivity || apply Rle_antisym; - [ assumption | assumption | auto with real | auto with real ]). -generalize H3; unfold RiemannInt_SF in |- *; case (Rle_dec a b); - case (Rle_dec b a); unfold wn' in |- *; intros; - (replace - (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre (wn n0))))) - (subdivision (mkStepFun (StepFun_P6 (pre (wn n0)))))) with - (Int_SF (subdivision_val (wn n0)) (subdivision (wn n0))); - [ idtac - | apply StepFun_P17 with (fe (wn n0)) a b; - [ apply StepFun_P1 - | apply StepFun_P2; - apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre (wn n0))))) ] ]). -apply H4. -rewrite Rabs_Ropp; apply H4. -rewrite Rabs_Ropp in H4; apply H4. -apply H4. -assert (H3 := RiemannInt_P2 _ _ _ _ H H1 H2); elim H3; intros; - apply existT with (- x); unfold Un_cv in |- *; unfold Un_cv in p; - intros; elim (p _ H4); intros; exists x0; intros; - generalize (H5 _ H6); unfold R_dist, RiemannInt_SF in |- *; - case (Rle_dec b a); case (Rle_dec a b); intros. -elim n; assumption. -unfold vn' in H7; - replace (Int_SF (subdivision_val (vn n0)) (subdivision (vn n0))) with - (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre (vn n0))))) - (subdivision (mkStepFun (StepFun_P6 (pre (vn n0)))))); - [ unfold Rminus in |- *; rewrite Ropp_involutive; rewrite <- Rabs_Ropp; - rewrite Ropp_plus_distr; rewrite Ropp_involutive; - apply H7 - | symmetry in |- *; apply StepFun_P17 with (fe (vn n0)) a b; - [ apply StepFun_P1 - | apply StepFun_P2; - apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre (vn n0))))) ] ]. -elim n1; assumption. -elim n2; assumption. + sigT (fun l:R => Un_cv (fun N:nat => RiemannInt_SF (vn N)) l). +Proof. + intros; case (Rle_dec a b); intro. + apply RiemannInt_P2 with f un wn; assumption. + assert (H1 : b <= a); auto with real. + set (vn' := fun n:nat => mkStepFun (StepFun_P6 (pre (vn n)))); + set (wn' := fun n:nat => mkStepFun (StepFun_P6 (pre (wn n)))); + assert + (H2 : + forall n:nat, + (forall t:R, + Rmin b a <= t <= Rmax b a -> Rabs (f t - vn' n t) <= wn' n t) /\ + Rabs (RiemannInt_SF (wn' n)) < un n). + intro; elim (H0 n0); intros; split. + intros; apply (H2 t); elim H4; clear H4; intros; split; + [ apply Rle_trans with (Rmin b a); try assumption; right; + unfold Rmin in |- * + | apply Rle_trans with (Rmax b a); try assumption; right; + unfold Rmax in |- * ]; + (case (Rle_dec a b); case (Rle_dec b a); intros; + try reflexivity || apply Rle_antisym; + [ assumption | assumption | auto with real | auto with real ]). + generalize H3; unfold RiemannInt_SF in |- *; case (Rle_dec a b); + case (Rle_dec b a); unfold wn' in |- *; intros; + (replace + (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre (wn n0))))) + (subdivision (mkStepFun (StepFun_P6 (pre (wn n0)))))) with + (Int_SF (subdivision_val (wn n0)) (subdivision (wn n0))); + [ idtac + | apply StepFun_P17 with (fe (wn n0)) a b; + [ apply StepFun_P1 + | apply StepFun_P2; + apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre (wn n0))))) ] ]). + apply H4. + rewrite Rabs_Ropp; apply H4. + rewrite Rabs_Ropp in H4; apply H4. + apply H4. + assert (H3 := RiemannInt_P2 _ _ _ _ H H1 H2); elim H3; intros; + apply existT with (- x); unfold Un_cv in |- *; unfold Un_cv in p; + intros; elim (p _ H4); intros; exists x0; intros; + generalize (H5 _ H6); unfold R_dist, RiemannInt_SF in |- *; + case (Rle_dec b a); case (Rle_dec a b); intros. + elim n; assumption. + unfold vn' in H7; + replace (Int_SF (subdivision_val (vn n0)) (subdivision (vn n0))) with + (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre (vn n0))))) + (subdivision (mkStepFun (StepFun_P6 (pre (vn n0)))))); + [ unfold Rminus in |- *; rewrite Ropp_involutive; rewrite <- Rabs_Ropp; + rewrite Ropp_plus_distr; rewrite Ropp_involutive; + apply H7 + | symmetry in |- *; apply StepFun_P17 with (fe (vn n0)) a b; + [ apply StepFun_P1 + | apply StepFun_P2; + apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre (vn n0))))) ] ]. + elim n1; assumption. + elim n2; assumption. Qed. Lemma RiemannInt_exists : - forall (f:R -> R) (a b:R) (pr:Riemann_integrable f a b) - (un:nat -> posreal), - Un_cv un 0 -> - sigT - (fun l:R => Un_cv (fun N:nat => RiemannInt_SF (phi_sequence un pr N)) l). -intros f; intros; - apply RiemannInt_P3 with - f un (fun n:nat => projT1 (phi_sequence_prop un pr n)); - [ apply H | intro; apply (projT2 (phi_sequence_prop un pr n)) ]. + forall (f:R -> R) (a b:R) (pr:Riemann_integrable f a b) + (un:nat -> posreal), + Un_cv un 0 -> + sigT + (fun l:R => Un_cv (fun N:nat => RiemannInt_SF (phi_sequence un pr N)) l). +Proof. + intros f; intros; + apply RiemannInt_P3 with + f un (fun n:nat => projT1 (phi_sequence_prop un pr n)); + [ apply H | intro; apply (projT2 (phi_sequence_prop un pr n)) ]. Qed. Lemma RiemannInt_P4 : - forall (f:R -> R) (a b l:R) (pr1 pr2:Riemann_integrable f a b) - (un vn:nat -> posreal), - Un_cv un 0 -> - Un_cv vn 0 -> - Un_cv (fun N:nat => RiemannInt_SF (phi_sequence un pr1 N)) l -> - Un_cv (fun N:nat => RiemannInt_SF (phi_sequence vn pr2 N)) l. -unfold Un_cv in |- *; unfold R_dist in |- *; intros f; intros; - assert (H3 : 0 < eps / 3). -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. -elim (H _ H3); clear H; intros N0 H; elim (H0 _ H3); clear H0; intros N1 H0; - elim (H1 _ H3); clear H1; intros N2 H1; set (N := max (max N0 N1) N2); - exists N; intros; - apply Rle_lt_trans with - (Rabs - (RiemannInt_SF (phi_sequence vn pr2 n) - - RiemannInt_SF (phi_sequence un pr1 n)) + - Rabs (RiemannInt_SF (phi_sequence un pr1 n) - l)). -replace (RiemannInt_SF (phi_sequence vn pr2 n) - l) with - (RiemannInt_SF (phi_sequence vn pr2 n) - - RiemannInt_SF (phi_sequence un pr1 n) + - (RiemannInt_SF (phi_sequence un pr1 n) - l)); [ apply Rabs_triang | ring ]. -replace eps with (2 * (eps / 3) + eps / 3). -apply Rplus_lt_compat. -elim (phi_sequence_prop vn pr2 n); intros psi_vn H5; - elim (phi_sequence_prop un pr1 n); intros psi_un H6; - replace + forall (f:R -> R) (a b l:R) (pr1 pr2:Riemann_integrable f a b) + (un vn:nat -> posreal), + Un_cv un 0 -> + Un_cv vn 0 -> + Un_cv (fun N:nat => RiemannInt_SF (phi_sequence un pr1 N)) l -> + Un_cv (fun N:nat => RiemannInt_SF (phi_sequence vn pr2 N)) l. +Proof. + unfold Un_cv in |- *; unfold R_dist in |- *; intros f; intros; + assert (H3 : 0 < eps / 3). + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. + elim (H _ H3); clear H; intros N0 H; elim (H0 _ H3); clear H0; intros N1 H0; + elim (H1 _ H3); clear H1; intros N2 H1; set (N := max (max N0 N1) N2); + exists N; intros; + apply Rle_lt_trans with + (Rabs + (RiemannInt_SF (phi_sequence vn pr2 n) - + RiemannInt_SF (phi_sequence un pr1 n)) + + Rabs (RiemannInt_SF (phi_sequence un pr1 n) - l)). + replace (RiemannInt_SF (phi_sequence vn pr2 n) - l) with (RiemannInt_SF (phi_sequence vn pr2 n) - - RiemannInt_SF (phi_sequence un pr1 n)) with - (RiemannInt_SF (phi_sequence vn pr2 n) + - -1 * RiemannInt_SF (phi_sequence un pr1 n)); [ idtac | ring ]; - rewrite <- StepFun_P30. -case (Rle_dec a b); intro. -apply Rle_lt_trans with - (RiemannInt_SF - (mkStepFun - (StepFun_P32 + RiemannInt_SF (phi_sequence un pr1 n) + + (RiemannInt_SF (phi_sequence un pr1 n) - l)); [ apply Rabs_triang | ring ]. + replace eps with (2 * (eps / 3) + eps / 3). + apply Rplus_lt_compat. + elim (phi_sequence_prop vn pr2 n); intros psi_vn H5; + elim (phi_sequence_prop un pr1 n); intros psi_un H6; + replace + (RiemannInt_SF (phi_sequence vn pr2 n) - + RiemannInt_SF (phi_sequence un pr1 n)) with + (RiemannInt_SF (phi_sequence vn pr2 n) + + -1 * RiemannInt_SF (phi_sequence un pr1 n)); [ idtac | ring ]; + rewrite <- StepFun_P30. + case (Rle_dec a b); intro. + apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P32 (mkStepFun - (StepFun_P28 (-1) (phi_sequence vn pr2 n) - (phi_sequence un pr1 n)))))). -apply StepFun_P34; assumption. -apply Rle_lt_trans with - (RiemannInt_SF (mkStepFun (StepFun_P28 1 psi_un psi_vn))). -apply StepFun_P37; try assumption; intros; simpl in |- *; rewrite Rmult_1_l; - apply Rle_trans with - (Rabs (phi_sequence vn pr2 n x - f x) + - Rabs (f x - phi_sequence un pr1 n x)). -replace (phi_sequence vn pr2 n x + -1 * phi_sequence un pr1 n x) with - (phi_sequence vn pr2 n x - f x + (f x - phi_sequence un pr1 n x)); - [ apply Rabs_triang | ring ]. -assert (H10 : Rmin a b = a). -unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n0; assumption ]. -assert (H11 : Rmax a b = b). -unfold Rmax in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n0; assumption ]. -rewrite (Rplus_comm (psi_un x)); apply Rplus_le_compat. -rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim H5; intros; apply H8. -rewrite H10; rewrite H11; elim H7; intros; split; left; assumption. -elim H6; intros; apply H8. -rewrite H10; rewrite H11; elim H7; intros; split; left; assumption. -rewrite StepFun_P30; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat. -apply Rlt_trans with (pos (un n)). -elim H6; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_un)). -apply RRle_abs. -assumption. -replace (pos (un n)) with (Rabs (un n - 0)); - [ apply H; unfold ge in |- *; apply le_trans with N; try assumption; + (StepFun_P28 (-1) (phi_sequence vn pr2 n) + (phi_sequence un pr1 n)))))). + apply StepFun_P34; assumption. + apply Rle_lt_trans with + (RiemannInt_SF (mkStepFun (StepFun_P28 1 psi_un psi_vn))). + apply StepFun_P37; try assumption; intros; simpl in |- *; rewrite Rmult_1_l; + apply Rle_trans with + (Rabs (phi_sequence vn pr2 n x - f x) + + Rabs (f x - phi_sequence un pr1 n x)). + replace (phi_sequence vn pr2 n x + -1 * phi_sequence un pr1 n x) with + (phi_sequence vn pr2 n x - f x + (f x - phi_sequence un pr1 n x)); + [ apply Rabs_triang | ring ]. + assert (H10 : Rmin a b = a). + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. + assert (H11 : Rmax a b = b). + unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. + rewrite (Rplus_comm (psi_un x)); apply Rplus_le_compat. + rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim H5; intros; apply H8. + rewrite H10; rewrite H11; elim H7; intros; split; left; assumption. + elim H6; intros; apply H8. + rewrite H10; rewrite H11; elim H7; intros; split; left; assumption. + rewrite StepFun_P30; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat. + apply Rlt_trans with (pos (un n)). + elim H6; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_un)). + apply RRle_abs. + assumption. + replace (pos (un n)) with (Rabs (un n - 0)); + [ apply H; unfold ge in |- *; apply le_trans with N; try assumption; unfold N in |- *; apply le_trans with (max N0 N1); - apply le_max_l - | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; - apply Rle_ge; left; apply (cond_pos (un n)) ]. -apply Rlt_trans with (pos (vn n)). -elim H5; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_vn)). -apply RRle_abs; assumption. -assumption. -replace (pos (vn n)) with (Rabs (vn n - 0)); - [ apply H0; unfold ge in |- *; apply le_trans with N; try assumption; + apply le_max_l + | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; + apply Rle_ge; left; apply (cond_pos (un n)) ]. + apply Rlt_trans with (pos (vn n)). + elim H5; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_vn)). + apply RRle_abs; assumption. + assumption. + replace (pos (vn n)) with (Rabs (vn n - 0)); + [ apply H0; unfold ge in |- *; apply le_trans with N; try assumption; unfold N in |- *; apply le_trans with (max N0 N1); - [ apply le_max_r | apply le_max_l ] - | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; - apply Rle_ge; left; apply (cond_pos (vn n)) ]. -rewrite StepFun_P39; rewrite Rabs_Ropp; - apply Rle_lt_trans with - (RiemannInt_SF - (mkStepFun - (StepFun_P32 - (mkStepFun + [ apply le_max_r | apply le_max_l ] + | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; + apply Rle_ge; left; apply (cond_pos (vn n)) ]. + rewrite StepFun_P39; rewrite Rabs_Ropp; + apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P32 + (mkStepFun (StepFun_P6 - (pre - (mkStepFun - (StepFun_P28 (-1) (phi_sequence vn pr2 n) - (phi_sequence un pr1 n))))))))). -apply StepFun_P34; try auto with real. -apply Rle_lt_trans with - (RiemannInt_SF - (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 psi_vn psi_un)))))). -apply StepFun_P37. -auto with real. -intros; simpl in |- *; rewrite Rmult_1_l; - apply Rle_trans with - (Rabs (phi_sequence vn pr2 n x - f x) + - Rabs (f x - phi_sequence un pr1 n x)). -replace (phi_sequence vn pr2 n x + -1 * phi_sequence un pr1 n x) with - (phi_sequence vn pr2 n x - f x + (f x - phi_sequence un pr1 n x)); - [ apply Rabs_triang | ring ]. -assert (H10 : Rmin a b = b). -unfold Rmin in |- *; case (Rle_dec a b); intro; - [ elim n0; assumption | reflexivity ]. -assert (H11 : Rmax a b = a). -unfold Rmax in |- *; case (Rle_dec a b); intro; - [ elim n0; assumption | reflexivity ]. -apply Rplus_le_compat. -rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim H5; intros; apply H8. -rewrite H10; rewrite H11; elim H7; intros; split; left; assumption. -elim H6; intros; apply H8. -rewrite H10; rewrite H11; elim H7; intros; split; left; assumption. -rewrite <- - (Ropp_involutive + (pre + (mkStepFun + (StepFun_P28 (-1) (phi_sequence vn pr2 n) + (phi_sequence un pr1 n))))))))). + apply StepFun_P34; try auto with real. + apply Rle_lt_trans with (RiemannInt_SF - (mkStepFun + (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 psi_vn psi_un)))))). + apply StepFun_P37. + auto with real. + intros; simpl in |- *; rewrite Rmult_1_l; + apply Rle_trans with + (Rabs (phi_sequence vn pr2 n x - f x) + + Rabs (f x - phi_sequence un pr1 n x)). + replace (phi_sequence vn pr2 n x + -1 * phi_sequence un pr1 n x) with + (phi_sequence vn pr2 n x - f x + (f x - phi_sequence un pr1 n x)); + [ apply Rabs_triang | ring ]. + assert (H10 : Rmin a b = b). + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ elim n0; assumption | reflexivity ]. + assert (H11 : Rmax a b = a). + unfold Rmax in |- *; case (Rle_dec a b); intro; + [ elim n0; assumption | reflexivity ]. + apply Rplus_le_compat. + rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim H5; intros; apply H8. + rewrite H10; rewrite H11; elim H7; intros; split; left; assumption. + elim H6; intros; apply H8. + rewrite H10; rewrite H11; elim H7; intros; split; left; assumption. + rewrite <- + (Ropp_involutive + (RiemannInt_SF + (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 psi_vn psi_un))))))) - ; rewrite <- StepFun_P39; rewrite StepFun_P30; rewrite Rmult_1_l; - rewrite double; rewrite Ropp_plus_distr; apply Rplus_lt_compat. -apply Rlt_trans with (pos (vn n)). -elim H5; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_vn)). -rewrite <- Rabs_Ropp; apply RRle_abs. -assumption. -replace (pos (vn n)) with (Rabs (vn n - 0)); - [ apply H0; unfold ge in |- *; apply le_trans with N; try assumption; + ; rewrite <- StepFun_P39; rewrite StepFun_P30; rewrite Rmult_1_l; + rewrite double; rewrite Ropp_plus_distr; apply Rplus_lt_compat. + apply Rlt_trans with (pos (vn n)). + elim H5; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_vn)). + rewrite <- Rabs_Ropp; apply RRle_abs. + assumption. + replace (pos (vn n)) with (Rabs (vn n - 0)); + [ apply H0; unfold ge in |- *; apply le_trans with N; try assumption; unfold N in |- *; apply le_trans with (max N0 N1); - [ apply le_max_r | apply le_max_l ] - | unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; - rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; - left; apply (cond_pos (vn n)) ]. -apply Rlt_trans with (pos (un n)). -elim H6; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_un)). -rewrite <- Rabs_Ropp; apply RRle_abs; assumption. -assumption. -replace (pos (un n)) with (Rabs (un n - 0)); - [ apply H; unfold ge in |- *; apply le_trans with N; try assumption; + [ apply le_max_r | apply le_max_l ] + | unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; + left; apply (cond_pos (vn n)) ]. + apply Rlt_trans with (pos (un n)). + elim H6; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_un)). + rewrite <- Rabs_Ropp; apply RRle_abs; assumption. + assumption. + replace (pos (un n)) with (Rabs (un n - 0)); + [ apply H; unfold ge in |- *; apply le_trans with N; try assumption; unfold N in |- *; apply le_trans with (max N0 N1); - apply le_max_l - | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; - apply Rle_ge; left; apply (cond_pos (un n)) ]. -apply H1; unfold ge in |- *; apply le_trans with N; try assumption; - unfold N in |- *; apply le_max_r. -apply Rmult_eq_reg_l with 3; - [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l; - do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; - rewrite <- Rinv_l_sym; [ ring | discrR ] - | discrR ]. + apply le_max_l + | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; + apply Rle_ge; left; apply (cond_pos (un n)) ]. + apply H1; unfold ge in |- *; apply le_trans with N; try assumption; + unfold N in |- *; apply le_max_r. + apply Rmult_eq_reg_l with 3; + [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l; + do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ ring | discrR ] + | discrR ]. Qed. Lemma RinvN_pos : forall n:nat, 0 < / (INR n + 1). -intro; apply Rinv_0_lt_compat; apply Rplus_le_lt_0_compat; - [ apply pos_INR | apply Rlt_0_1 ]. +Proof. + intro; apply Rinv_0_lt_compat; apply Rplus_le_lt_0_compat; + [ apply pos_INR | apply Rlt_0_1 ]. Qed. Definition RinvN (N:nat) : posreal := mkposreal _ (RinvN_pos N). - + Lemma RinvN_cv : Un_cv RinvN 0. -unfold Un_cv in |- *; intros; assert (H0 := archimed (/ eps)); elim H0; - clear H0; intros; assert (H2 : (0 <= up (/ eps))%Z). -apply le_IZR; left; apply Rlt_trans with (/ eps); - [ apply Rinv_0_lt_compat; assumption | assumption ]. -elim (IZN _ H2); intros; exists x; intros; unfold R_dist in |- *; - simpl in |- *; unfold Rminus in |- *; rewrite Ropp_0; - rewrite Rplus_0_r; assert (H5 : 0 < INR n + 1). -apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ]. -rewrite Rabs_right; - [ idtac - | left; change (0 < / (INR n + 1)) in |- *; apply Rinv_0_lt_compat; - assumption ]; apply Rle_lt_trans with (/ (INR x + 1)). -apply Rle_Rinv. -apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ]. -assumption. -do 2 rewrite <- (Rplus_comm 1); apply Rplus_le_compat_l; apply le_INR; - apply H4. -rewrite <- (Rinv_involutive eps). -apply Rinv_lt_contravar. -apply Rmult_lt_0_compat. -apply Rinv_0_lt_compat; assumption. -apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ]. -apply Rlt_trans with (INR x); - [ rewrite INR_IZR_INZ; rewrite <- H3; apply H0 - | pattern (INR x) at 1 in |- *; rewrite <- Rplus_0_r; - apply Rplus_lt_compat_l; apply Rlt_0_1 ]. -red in |- *; intro; rewrite H6 in H; elim (Rlt_irrefl _ H). +Proof. + unfold Un_cv in |- *; intros; assert (H0 := archimed (/ eps)); elim H0; + clear H0; intros; assert (H2 : (0 <= up (/ eps))%Z). + apply le_IZR; left; apply Rlt_trans with (/ eps); + [ apply Rinv_0_lt_compat; assumption | assumption ]. + elim (IZN _ H2); intros; exists x; intros; unfold R_dist in |- *; + simpl in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; assert (H5 : 0 < INR n + 1). + apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ]. + rewrite Rabs_right; + [ idtac + | left; change (0 < / (INR n + 1)) in |- *; apply Rinv_0_lt_compat; + assumption ]; apply Rle_lt_trans with (/ (INR x + 1)). + apply Rle_Rinv. + apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ]. + assumption. + do 2 rewrite <- (Rplus_comm 1); apply Rplus_le_compat_l; apply le_INR; + apply H4. + rewrite <- (Rinv_involutive eps). + apply Rinv_lt_contravar. + apply Rmult_lt_0_compat. + apply Rinv_0_lt_compat; assumption. + apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ]. + apply Rlt_trans with (INR x); + [ rewrite INR_IZR_INZ; rewrite <- H3; apply H0 + | pattern (INR x) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_lt_compat_l; apply Rlt_0_1 ]. + red in |- *; intro; rewrite H6 in H; elim (Rlt_irrefl _ H). Qed. (**********) Definition RiemannInt (f:R -> R) (a b:R) (pr:Riemann_integrable f a b) : R := match RiemannInt_exists pr RinvN RinvN_cv with - | existT a' b' => a' + | existT a' b' => a' end. Lemma RiemannInt_P5 : - forall (f:R -> R) (a b:R) (pr1 pr2:Riemann_integrable f a b), - RiemannInt pr1 = RiemannInt pr2. -intros; unfold RiemannInt in |- *; - case (RiemannInt_exists pr1 RinvN RinvN_cv); - case (RiemannInt_exists pr2 RinvN RinvN_cv); intros; - eapply UL_sequence; - [ apply u0 - | apply RiemannInt_P4 with pr2 RinvN; apply RinvN_cv || assumption ]. + forall (f:R -> R) (a b:R) (pr1 pr2:Riemann_integrable f a b), + RiemannInt pr1 = RiemannInt pr2. +Proof. + intros; unfold RiemannInt in |- *; + case (RiemannInt_exists pr1 RinvN RinvN_cv); + case (RiemannInt_exists pr2 RinvN RinvN_cv); intros; + eapply UL_sequence; + [ apply u0 + | apply RiemannInt_P4 with pr2 RinvN; apply RinvN_cv || assumption ]. Qed. -(**************************************) -(* C°([a,b]) is included in L1([a,b]) *) -(**************************************) +(***************************************) +(** C°([a,b]) is included in L1([a,b]) *) +(***************************************) Lemma maxN : - forall (a b:R) (del:posreal), - a < b -> - sigT (fun n:nat => a + INR n * del < b /\ b <= a + INR (S n) * del). -intros; set (I := fun n:nat => a + INR n * del < b); - assert (H0 : exists n : nat, I n). -exists 0%nat; unfold I in |- *; rewrite Rmult_0_l; rewrite Rplus_0_r; - assumption. -cut (Nbound I). -intro; assert (H2 := Nzorn H0 H1); elim H2; intros; exists x; elim p; intros; - split. -apply H3. -case (total_order_T (a + INR (S x) * del) b); intro. -elim s; intro. -assert (H5 := H4 (S x) a0); elim (le_Sn_n _ H5). -right; symmetry in |- *; assumption. -left; apply r. -assert (H1 : 0 <= (b - a) / del). -unfold Rdiv in |- *; apply Rmult_le_pos; - [ apply Rge_le; apply Rge_minus; apply Rle_ge; left; apply H - | left; apply Rinv_0_lt_compat; apply (cond_pos del) ]. -elim (archimed ((b - a) / del)); intros; - assert (H4 : (0 <= up ((b - a) / del))%Z). -apply le_IZR; simpl in |- *; left; apply Rle_lt_trans with ((b - a) / del); - assumption. -assert (H5 := IZN _ H4); elim H5; clear H5; intros N H5; - unfold Nbound in |- *; exists N; intros; unfold I in H6; - apply INR_le; rewrite H5 in H2; rewrite <- INR_IZR_INZ in H2; - left; apply Rle_lt_trans with ((b - a) / del); try assumption; - apply Rmult_le_reg_l with (pos del); - [ apply (cond_pos del) - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ del)); - rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; rewrite Rmult_comm; apply Rplus_le_reg_l with a; - replace (a + (b - a)) with b; [ left; assumption | ring ] - | assert (H7 := cond_pos del); red in |- *; intro; rewrite H8 in H7; - elim (Rlt_irrefl _ H7) ] ]. + forall (a b:R) (del:posreal), + a < b -> + sigT (fun n:nat => a + INR n * del < b /\ b <= a + INR (S n) * del). +Proof. + intros; set (I := fun n:nat => a + INR n * del < b); + assert (H0 : exists n : nat, I n). + exists 0%nat; unfold I in |- *; rewrite Rmult_0_l; rewrite Rplus_0_r; + assumption. + cut (Nbound I). + intro; assert (H2 := Nzorn H0 H1); elim H2; intros; exists x; elim p; intros; + split. + apply H3. + case (total_order_T (a + INR (S x) * del) b); intro. + elim s; intro. + assert (H5 := H4 (S x) a0); elim (le_Sn_n _ H5). + right; symmetry in |- *; assumption. + left; apply r. + assert (H1 : 0 <= (b - a) / del). + unfold Rdiv in |- *; apply Rmult_le_pos; + [ apply Rge_le; apply Rge_minus; apply Rle_ge; left; apply H + | left; apply Rinv_0_lt_compat; apply (cond_pos del) ]. + elim (archimed ((b - a) / del)); intros; + assert (H4 : (0 <= up ((b - a) / del))%Z). + apply le_IZR; simpl in |- *; left; apply Rle_lt_trans with ((b - a) / del); + assumption. + assert (H5 := IZN _ H4); elim H5; clear H5; intros N H5; + unfold Nbound in |- *; exists N; intros; unfold I in H6; + apply INR_le; rewrite H5 in H2; rewrite <- INR_IZR_INZ in H2; + left; apply Rle_lt_trans with ((b - a) / del); try assumption; + apply Rmult_le_reg_l with (pos del); + [ apply (cond_pos del) + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ del)); + rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite Rmult_comm; apply Rplus_le_reg_l with a; + replace (a + (b - a)) with b; [ left; assumption | ring ] + | assert (H7 := cond_pos del); red in |- *; intro; rewrite H8 in H7; + elim (Rlt_irrefl _ H7) ] ]. Qed. Fixpoint SubEquiN (N:nat) (x y:R) (del:posreal) {struct N} : Rlist := match N with - | O => cons y nil - | S p => cons x (SubEquiN p (x + del) y del) + | O => cons y nil + | S p => cons x (SubEquiN p (x + del) y del) end. Definition max_N (a b:R) (del:posreal) (h:a < b) : nat := match maxN del h with - | existT N H0 => N + | existT N H0 => N end. Definition SubEqui (a b:R) (del:posreal) (h:a < b) : Rlist := SubEquiN (S (max_N del h)) a b del. Lemma Heine_cor1 : - forall (f:R -> R) (a b:R), - a < b -> - (forall x:R, a <= x <= b -> continuity_pt f x) -> - forall eps:posreal, - sigT - (fun delta:posreal => - delta <= b - a /\ + forall (f:R -> R) (a b:R), + a < b -> + (forall x:R, a <= x <= b -> continuity_pt f x) -> + forall eps:posreal, + sigT + (fun delta:posreal => + delta <= b - a /\ + (forall x y:R, + a <= x <= b -> + a <= y <= b -> Rabs (x - y) < delta -> Rabs (f x - f y) < eps)). +Proof. + intro f; intros; + set + (E := + fun l:R => + 0 < l <= b - a /\ (forall x y:R, - a <= x <= b -> - a <= y <= b -> Rabs (x - y) < delta -> Rabs (f x - f y) < eps)). -intro f; intros; - set - (E := - fun l:R => - 0 < l <= b - a /\ - (forall x y:R, - a <= x <= b -> - a <= y <= b -> Rabs (x - y) < l -> Rabs (f x - f y) < eps)); - assert (H1 : bound E). -unfold bound in |- *; exists (b - a); unfold is_upper_bound in |- *; intros; - unfold E in H1; elim H1; clear H1; intros H1 _; elim H1; - intros; assumption. -assert (H2 : exists x : R, E x). -assert (H2 := Heine f (fun x:R => a <= x <= b) (compact_P3 a b) H0 eps); - elim H2; intros; exists (Rmin x (b - a)); unfold E in |- *; - split; - [ split; - [ unfold Rmin in |- *; case (Rle_dec x (b - a)); intro; - [ apply (cond_pos x) | apply Rlt_Rminus; assumption ] - | apply Rmin_r ] - | intros; apply H3; try assumption; apply Rlt_le_trans with (Rmin x (b - a)); - [ assumption | apply Rmin_l ] ]. -assert (H3 := completeness E H1 H2); elim H3; intros; cut (0 < x <= b - a). -intro; elim H4; clear H4; intros; apply existT with (mkposreal _ H4); split. -apply H5. -unfold is_lub in p; elim p; intros; unfold is_upper_bound in H6; - set (D := Rabs (x0 - y)); elim (classic (exists y : R, D < y /\ E y)); - intro. -elim H11; intros; elim H12; clear H12; intros; unfold E in H13; elim H13; - intros; apply H15; assumption. -assert (H12 := not_ex_all_not _ (fun y:R => D < y /\ E y) H11); - assert (H13 : is_upper_bound E D). -unfold is_upper_bound in |- *; intros; assert (H14 := H12 x1); - elim (not_and_or (D < x1) (E x1) H14); intro. -case (Rle_dec x1 D); intro. -assumption. -elim H15; auto with real. -elim H15; assumption. -assert (H14 := H7 _ H13); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H14 H10)). -unfold is_lub in p; unfold is_upper_bound in p; elim p; clear p; intros; - split. -elim H2; intros; assert (H7 := H4 _ H6); unfold E in H6; elim H6; clear H6; - intros H6 _; elim H6; intros; apply Rlt_le_trans with x0; - assumption. -apply H5; intros; unfold E in H6; elim H6; clear H6; intros H6 _; elim H6; - intros; assumption. + a <= x <= b -> + a <= y <= b -> Rabs (x - y) < l -> Rabs (f x - f y) < eps)); + assert (H1 : bound E). + unfold bound in |- *; exists (b - a); unfold is_upper_bound in |- *; intros; + unfold E in H1; elim H1; clear H1; intros H1 _; elim H1; + intros; assumption. + assert (H2 : exists x : R, E x). + assert (H2 := Heine f (fun x:R => a <= x <= b) (compact_P3 a b) H0 eps); + elim H2; intros; exists (Rmin x (b - a)); unfold E in |- *; + split; + [ split; + [ unfold Rmin in |- *; case (Rle_dec x (b - a)); intro; + [ apply (cond_pos x) | apply Rlt_Rminus; assumption ] + | apply Rmin_r ] + | intros; apply H3; try assumption; apply Rlt_le_trans with (Rmin x (b - a)); + [ assumption | apply Rmin_l ] ]. + assert (H3 := completeness E H1 H2); elim H3; intros; cut (0 < x <= b - a). + intro; elim H4; clear H4; intros; apply existT with (mkposreal _ H4); split. + apply H5. + unfold is_lub in p; elim p; intros; unfold is_upper_bound in H6; + set (D := Rabs (x0 - y)); elim (classic (exists y : R, D < y /\ E y)); + intro. + elim H11; intros; elim H12; clear H12; intros; unfold E in H13; elim H13; + intros; apply H15; assumption. + assert (H12 := not_ex_all_not _ (fun y:R => D < y /\ E y) H11); + assert (H13 : is_upper_bound E D). + unfold is_upper_bound in |- *; intros; assert (H14 := H12 x1); + elim (not_and_or (D < x1) (E x1) H14); intro. + case (Rle_dec x1 D); intro. + assumption. + elim H15; auto with real. + elim H15; assumption. + assert (H14 := H7 _ H13); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H14 H10)). + unfold is_lub in p; unfold is_upper_bound in p; elim p; clear p; intros; + split. + elim H2; intros; assert (H7 := H4 _ H6); unfold E in H6; elim H6; clear H6; + intros H6 _; elim H6; intros; apply Rlt_le_trans with x0; + assumption. + apply H5; intros; unfold E in H6; elim H6; clear H6; intros H6 _; elim H6; + intros; assumption. Qed. Lemma Heine_cor2 : - forall (f:R -> R) (a b:R), - (forall x:R, a <= x <= b -> continuity_pt f x) -> - forall eps:posreal, - sigT - (fun delta:posreal => - forall x y:R, - a <= x <= b -> - a <= y <= b -> Rabs (x - y) < delta -> Rabs (f x - f y) < eps). -intro f; intros; case (total_order_T a b); intro. -elim s; intro. -assert (H0 := Heine_cor1 a0 H eps); elim H0; intros; apply existT with x; - elim p; intros; apply H2; assumption. -apply existT with (mkposreal _ Rlt_0_1); intros; assert (H3 : x = y); - [ elim H0; elim H1; intros; rewrite b0 in H3; rewrite b0 in H5; - apply Rle_antisym; apply Rle_trans with b; assumption - | rewrite H3; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; - apply (cond_pos eps) ]. -apply existT with (mkposreal _ Rlt_0_1); intros; elim H0; intros; - elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H3 H4) r)). + forall (f:R -> R) (a b:R), + (forall x:R, a <= x <= b -> continuity_pt f x) -> + forall eps:posreal, + sigT + (fun delta:posreal => + forall x y:R, + a <= x <= b -> + a <= y <= b -> Rabs (x - y) < delta -> Rabs (f x - f y) < eps). +Proof. + intro f; intros; case (total_order_T a b); intro. + elim s; intro. + assert (H0 := Heine_cor1 a0 H eps); elim H0; intros; apply existT with x; + elim p; intros; apply H2; assumption. + apply existT with (mkposreal _ Rlt_0_1); intros; assert (H3 : x = y); + [ elim H0; elim H1; intros; rewrite b0 in H3; rewrite b0 in H5; + apply Rle_antisym; apply Rle_trans with b; assumption + | rewrite H3; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + apply (cond_pos eps) ]. + apply existT with (mkposreal _ Rlt_0_1); intros; elim H0; intros; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H3 H4) r)). Qed. Lemma SubEqui_P1 : - forall (a b:R) (del:posreal) (h:a < b), pos_Rl (SubEqui del h) 0 = a. -intros; unfold SubEqui in |- *; case (maxN del h); intros; reflexivity. + forall (a b:R) (del:posreal) (h:a < b), pos_Rl (SubEqui del h) 0 = a. +Proof. + intros; unfold SubEqui in |- *; case (maxN del h); intros; reflexivity. Qed. Lemma SubEqui_P2 : - forall (a b:R) (del:posreal) (h:a < b), - pos_Rl (SubEqui del h) (pred (Rlength (SubEqui del h))) = b. -intros; unfold SubEqui in |- *; case (maxN del h); intros; clear a0; - cut - (forall (x:nat) (a:R) (del:posreal), - pos_Rl (SubEquiN (S x) a b del) - (pred (Rlength (SubEquiN (S x) a b del))) = b); - [ intro; apply H - | simple induction x0; - [ intros; reflexivity - | intros; - change - (pos_Rl (SubEquiN (S n) (a0 + del0) b del0) - (pred (Rlength (SubEquiN (S n) (a0 + del0) b del0))) = b) - in |- *; apply H ] ]. + forall (a b:R) (del:posreal) (h:a < b), + pos_Rl (SubEqui del h) (pred (Rlength (SubEqui del h))) = b. +Proof. + intros; unfold SubEqui in |- *; case (maxN del h); intros; clear a0; + cut + (forall (x:nat) (a:R) (del:posreal), + pos_Rl (SubEquiN (S x) a b del) + (pred (Rlength (SubEquiN (S x) a b del))) = b); + [ intro; apply H + | simple induction x0; + [ intros; reflexivity + | intros; + change + (pos_Rl (SubEquiN (S n) (a0 + del0) b del0) + (pred (Rlength (SubEquiN (S n) (a0 + del0) b del0))) = b) + in |- *; apply H ] ]. Qed. Lemma SubEqui_P3 : - forall (N:nat) (a b:R) (del:posreal), Rlength (SubEquiN N a b del) = S N. -simple induction N; intros; - [ reflexivity | simpl in |- *; rewrite H; reflexivity ]. + forall (N:nat) (a b:R) (del:posreal), Rlength (SubEquiN N a b del) = S N. +Proof. + simple induction N; intros; + [ reflexivity | simpl in |- *; rewrite H; reflexivity ]. Qed. Lemma SubEqui_P4 : - forall (N:nat) (a b:R) (del:posreal) (i:nat), - (i < S N)%nat -> pos_Rl (SubEquiN (S N) a b del) i = a + INR i * del. -simple induction N; - [ intros; inversion H; [ simpl in |- *; ring | elim (le_Sn_O _ H1) ] - | intros; induction i as [| i Hreci]; - [ simpl in |- *; ring - | change - (pos_Rl (SubEquiN (S n) (a + del) b del) i = a + INR (S i) * del) - in |- *; rewrite H; [ rewrite S_INR; ring | apply lt_S_n; apply H0 ] ] ]. + forall (N:nat) (a b:R) (del:posreal) (i:nat), + (i < S N)%nat -> pos_Rl (SubEquiN (S N) a b del) i = a + INR i * del. +Proof. + simple induction N; + [ intros; inversion H; [ simpl in |- *; ring | elim (le_Sn_O _ H1) ] + | intros; induction i as [| i Hreci]; + [ simpl in |- *; ring + | change + (pos_Rl (SubEquiN (S n) (a + del) b del) i = a + INR (S i) * del) + in |- *; rewrite H; [ rewrite S_INR; ring | apply lt_S_n; apply H0 ] ] ]. Qed. Lemma SubEqui_P5 : - forall (a b:R) (del:posreal) (h:a < b), - Rlength (SubEqui del h) = S (S (max_N del h)). -intros; unfold SubEqui in |- *; apply SubEqui_P3. + forall (a b:R) (del:posreal) (h:a < b), + Rlength (SubEqui del h) = S (S (max_N del h)). +Proof. + intros; unfold SubEqui in |- *; apply SubEqui_P3. Qed. Lemma SubEqui_P6 : - forall (a b:R) (del:posreal) (h:a < b) (i:nat), - (i < S (max_N del h))%nat -> pos_Rl (SubEqui del h) i = a + INR i * del. -intros; unfold SubEqui in |- *; apply SubEqui_P4; assumption. + forall (a b:R) (del:posreal) (h:a < b) (i:nat), + (i < S (max_N del h))%nat -> pos_Rl (SubEqui del h) i = a + INR i * del. +Proof. + intros; unfold SubEqui in |- *; apply SubEqui_P4; assumption. Qed. Lemma SubEqui_P7 : - forall (a b:R) (del:posreal) (h:a < b), ordered_Rlist (SubEqui del h). -intros; unfold ordered_Rlist in |- *; intros; rewrite SubEqui_P5 in H; - simpl in H; inversion H. -rewrite (SubEqui_P6 del h (i:=(max_N del h))). -replace (S (max_N del h)) with (pred (Rlength (SubEqui del h))). -rewrite SubEqui_P2; unfold max_N in |- *; case (maxN del h); intros; left; - elim a0; intros; assumption. -rewrite SubEqui_P5; reflexivity. -apply lt_n_Sn. -repeat rewrite SubEqui_P6. -3: assumption. -2: apply le_lt_n_Sm; assumption. -apply Rplus_le_compat_l; rewrite S_INR; rewrite Rmult_plus_distr_r; - pattern (INR i * del) at 1 in |- *; rewrite <- Rplus_0_r; - apply Rplus_le_compat_l; rewrite Rmult_1_l; left; - apply (cond_pos del). + forall (a b:R) (del:posreal) (h:a < b), ordered_Rlist (SubEqui del h). +Proof. + intros; unfold ordered_Rlist in |- *; intros; rewrite SubEqui_P5 in H; + simpl in H; inversion H. + rewrite (SubEqui_P6 del h (i:=(max_N del h))). + replace (S (max_N del h)) with (pred (Rlength (SubEqui del h))). + rewrite SubEqui_P2; unfold max_N in |- *; case (maxN del h); intros; left; + elim a0; intros; assumption. + rewrite SubEqui_P5; reflexivity. + apply lt_n_Sn. + repeat rewrite SubEqui_P6. + 3: assumption. + 2: apply le_lt_n_Sm; assumption. + apply Rplus_le_compat_l; rewrite S_INR; rewrite Rmult_plus_distr_r; + pattern (INR i * del) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l; rewrite Rmult_1_l; left; + apply (cond_pos del). Qed. Lemma SubEqui_P8 : - forall (a b:R) (del:posreal) (h:a < b) (i:nat), - (i < Rlength (SubEqui del h))%nat -> a <= pos_Rl (SubEqui del h) i <= b. -intros; split. -pattern a at 1 in |- *; rewrite <- (SubEqui_P1 del h); apply RList_P5. -apply SubEqui_P7. -elim (RList_P3 (SubEqui del h) (pos_Rl (SubEqui del h) i)); intros; apply H1; - exists i; split; [ reflexivity | assumption ]. -pattern b at 2 in |- *; rewrite <- (SubEqui_P2 del h); apply RList_P7; - [ apply SubEqui_P7 - | elim (RList_P3 (SubEqui del h) (pos_Rl (SubEqui del h) i)); intros; - apply H1; exists i; split; [ reflexivity | assumption ] ]. + forall (a b:R) (del:posreal) (h:a < b) (i:nat), + (i < Rlength (SubEqui del h))%nat -> a <= pos_Rl (SubEqui del h) i <= b. +Proof. + intros; split. + pattern a at 1 in |- *; rewrite <- (SubEqui_P1 del h); apply RList_P5. + apply SubEqui_P7. + elim (RList_P3 (SubEqui del h) (pos_Rl (SubEqui del h) i)); intros; apply H1; + exists i; split; [ reflexivity | assumption ]. + pattern b at 2 in |- *; rewrite <- (SubEqui_P2 del h); apply RList_P7; + [ apply SubEqui_P7 + | elim (RList_P3 (SubEqui del h) (pos_Rl (SubEqui del h) i)); intros; + apply H1; exists i; split; [ reflexivity | assumption ] ]. Qed. Lemma SubEqui_P9 : - forall (a b:R) (del:posreal) (f:R -> R) (h:a < b), - sigT - (fun g:StepFun a b => - g b = f b /\ - (forall i:nat, - (i < pred (Rlength (SubEqui del h)))%nat -> - constant_D_eq g - (co_interval (pos_Rl (SubEqui del h) i) - (pos_Rl (SubEqui del h) (S i))) - (f (pos_Rl (SubEqui del h) i)))). -intros; apply StepFun_P38; - [ apply SubEqui_P7 | apply SubEqui_P1 | apply SubEqui_P2 ]. + forall (a b:R) (del:posreal) (f:R -> R) (h:a < b), + sigT + (fun g:StepFun a b => + g b = f b /\ + (forall i:nat, + (i < pred (Rlength (SubEqui del h)))%nat -> + constant_D_eq g + (co_interval (pos_Rl (SubEqui del h) i) + (pos_Rl (SubEqui del h) (S i))) + (f (pos_Rl (SubEqui del h) i)))). +Proof. + intros; apply StepFun_P38; + [ apply SubEqui_P7 | apply SubEqui_P1 | apply SubEqui_P2 ]. Qed. Lemma RiemannInt_P6 : - forall (f:R -> R) (a b:R), - a < b -> - (forall x:R, a <= x <= b -> continuity_pt f x) -> Riemann_integrable f a b. -intros; unfold Riemann_integrable in |- *; intro; - assert (H1 : 0 < eps / (2 * (b - a))). -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ apply (cond_pos eps) - | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; - [ prove_sup0 | apply Rlt_Rminus; assumption ] ]. -assert (H2 : Rmin a b = a). -unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; left; assumption ]. -assert (H3 : Rmax a b = b). -unfold Rmax in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; left; assumption ]. -elim (Heine_cor2 H0 (mkposreal _ H1)); intros del H4; - elim (SubEqui_P9 del f H); intros phi [H5 H6]; split with phi; - split with (mkStepFun (StepFun_P4 a b (eps / (2 * (b - a))))); - split. -2: rewrite StepFun_P18; unfold Rdiv in |- *; rewrite Rinv_mult_distr. -2: do 2 rewrite Rmult_assoc; rewrite <- Rinv_l_sym. -2: rewrite Rmult_1_r; rewrite Rabs_right. -2: apply Rmult_lt_reg_l with 2. -2: prove_sup0. -2: rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + forall (f:R -> R) (a b:R), + a < b -> + (forall x:R, a <= x <= b -> continuity_pt f x) -> Riemann_integrable f a b. +Proof. + intros; unfold Riemann_integrable in |- *; intro; + assert (H1 : 0 < eps / (2 * (b - a))). + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos eps) + | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; + [ prove_sup0 | apply Rlt_Rminus; assumption ] ]. + assert (H2 : Rmin a b = a). + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; left; assumption ]. + assert (H3 : Rmax a b = b). + unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; left; assumption ]. + elim (Heine_cor2 H0 (mkposreal _ H1)); intros del H4; + elim (SubEqui_P9 del f H); intros phi [H5 H6]; split with phi; + split with (mkStepFun (StepFun_P4 a b (eps / (2 * (b - a))))); + split. + 2: rewrite StepFun_P18; unfold Rdiv in |- *; rewrite Rinv_mult_distr. + 2: do 2 rewrite Rmult_assoc; rewrite <- Rinv_l_sym. + 2: rewrite Rmult_1_r; rewrite Rabs_right. + 2: apply Rmult_lt_reg_l with 2. + 2: prove_sup0. + 2: rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. -2: rewrite Rmult_1_l; pattern (pos eps) at 1 in |- *; rewrite <- Rplus_0_r; + 2: rewrite Rmult_1_l; pattern (pos eps) at 1 in |- *; rewrite <- Rplus_0_r; rewrite double; apply Rplus_lt_compat_l; apply (cond_pos eps). -2: discrR. -2: apply Rle_ge; left; apply Rmult_lt_0_compat. -2: apply (cond_pos eps). -2: apply Rinv_0_lt_compat; prove_sup0. -2: apply Rminus_eq_contra; red in |- *; intro; clear H6; rewrite H7 in H; + 2: discrR. + 2: apply Rle_ge; left; apply Rmult_lt_0_compat. + 2: apply (cond_pos eps). + 2: apply Rinv_0_lt_compat; prove_sup0. + 2: apply Rminus_eq_contra; red in |- *; intro; clear H6; rewrite H7 in H; elim (Rlt_irrefl _ H). -2: discrR. -2: apply Rminus_eq_contra; red in |- *; intro; clear H6; rewrite H7 in H; + 2: discrR. + 2: apply Rminus_eq_contra; red in |- *; intro; clear H6; rewrite H7 in H; elim (Rlt_irrefl _ H). -intros; rewrite H2 in H7; rewrite H3 in H7; simpl in |- *; - unfold fct_cte in |- *; - cut - (forall t:R, - a <= t <= b -> - t = b \/ - (exists i : nat, - (i < pred (Rlength (SubEqui del H)))%nat /\ - co_interval (pos_Rl (SubEqui del H) i) (pos_Rl (SubEqui del H) (S i)) - t)). -intro; elim (H8 _ H7); intro. -rewrite H9; rewrite H5; unfold Rminus in |- *; rewrite Rplus_opp_r; - rewrite Rabs_R0; left; assumption. -elim H9; clear H9; intros I [H9 H10]; assert (H11 := H6 I H9 t H10); - rewrite H11; left; apply H4. -assumption. -apply SubEqui_P8; apply lt_trans with (pred (Rlength (SubEqui del H))). -assumption. -apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H9; - elim (lt_n_O _ H9). -unfold co_interval in H10; elim H10; clear H10; intros; rewrite Rabs_right. -rewrite SubEqui_P5 in H9; simpl in H9; inversion H9. -apply Rplus_lt_reg_r with (pos_Rl (SubEqui del H) (max_N del H)). -replace - (pos_Rl (SubEqui del H) (max_N del H) + - (t - pos_Rl (SubEqui del H) (max_N del H))) with t; - [ idtac | ring ]; apply Rlt_le_trans with b. -rewrite H14 in H12; - assert (H13 : S (max_N del H) = pred (Rlength (SubEqui del H))). -rewrite SubEqui_P5; reflexivity. -rewrite H13 in H12; rewrite SubEqui_P2 in H12; apply H12. -rewrite SubEqui_P6. -2: apply lt_n_Sn. -unfold max_N in |- *; case (maxN del H); intros; elim a0; clear a0; - intros _ H13; replace (a + INR x * del + del) with (a + INR (S x) * del); - [ assumption | rewrite S_INR; ring ]. -apply Rplus_lt_reg_r with (pos_Rl (SubEqui del H) I); - replace (pos_Rl (SubEqui del H) I + (t - pos_Rl (SubEqui del H) I)) with t; - [ idtac | ring ]; - replace (pos_Rl (SubEqui del H) I + del) with (pos_Rl (SubEqui del H) (S I)). -assumption. -repeat rewrite SubEqui_P6. -rewrite S_INR; ring. -assumption. -apply le_lt_n_Sm; assumption. -apply Rge_minus; apply Rle_ge; assumption. -intros; clear H0 H1 H4 phi H5 H6 t H7; case (Req_dec t0 b); intro. -left; assumption. -right; set (I := fun j:nat => a + INR j * del <= t0); - assert (H1 : exists n : nat, I n). -exists 0%nat; unfold I in |- *; rewrite Rmult_0_l; rewrite Rplus_0_r; elim H8; - intros; assumption. -assert (H4 : Nbound I). -unfold Nbound in |- *; exists (S (max_N del H)); intros; unfold max_N in |- *; - case (maxN del H); intros; elim a0; clear a0; intros _ H5; - apply INR_le; apply Rmult_le_reg_l with (pos del). -apply (cond_pos del). -apply Rplus_le_reg_l with a; do 2 rewrite (Rmult_comm del); - apply Rle_trans with t0; unfold I in H4; try assumption; - apply Rle_trans with b; try assumption; elim H8; intros; - assumption. -elim (Nzorn H1 H4); intros N [H5 H6]; assert (H7 : (N < S (max_N del H))%nat). -unfold max_N in |- *; case (maxN del H); intros; apply INR_lt; - apply Rmult_lt_reg_l with (pos del). -apply (cond_pos del). -apply Rplus_lt_reg_r with a; do 2 rewrite (Rmult_comm del); - apply Rle_lt_trans with t0; unfold I in H5; try assumption; - elim a0; intros; apply Rlt_le_trans with b; try assumption; - elim H8; intros. -elim H11; intro. -assumption. -elim H0; assumption. -exists N; split. -rewrite SubEqui_P5; simpl in |- *; assumption. -unfold co_interval in |- *; split. -rewrite SubEqui_P6. -apply H5. -assumption. -inversion H7. -replace (S (max_N del H)) with (pred (Rlength (SubEqui del H))). -rewrite (SubEqui_P2 del H); elim H8; intros. -elim H11; intro. -assumption. -elim H0; assumption. -rewrite SubEqui_P5; reflexivity. -rewrite SubEqui_P6. -case (Rle_dec (a + INR (S N) * del) t0); intro. -assert (H11 := H6 (S N) r); elim (le_Sn_n _ H11). -auto with real. -apply le_lt_n_Sm; assumption. + intros; rewrite H2 in H7; rewrite H3 in H7; simpl in |- *; + unfold fct_cte in |- *; + cut + (forall t:R, + a <= t <= b -> + t = b \/ + (exists i : nat, + (i < pred (Rlength (SubEqui del H)))%nat /\ + co_interval (pos_Rl (SubEqui del H) i) (pos_Rl (SubEqui del H) (S i)) + t)). + intro; elim (H8 _ H7); intro. + rewrite H9; rewrite H5; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; left; assumption. + elim H9; clear H9; intros I [H9 H10]; assert (H11 := H6 I H9 t H10); + rewrite H11; left; apply H4. + assumption. + apply SubEqui_P8; apply lt_trans with (pred (Rlength (SubEqui del H))). + assumption. + apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H9; + elim (lt_n_O _ H9). + unfold co_interval in H10; elim H10; clear H10; intros; rewrite Rabs_right. + rewrite SubEqui_P5 in H9; simpl in H9; inversion H9. + apply Rplus_lt_reg_r with (pos_Rl (SubEqui del H) (max_N del H)). + replace + (pos_Rl (SubEqui del H) (max_N del H) + + (t - pos_Rl (SubEqui del H) (max_N del H))) with t; + [ idtac | ring ]; apply Rlt_le_trans with b. + rewrite H14 in H12; + assert (H13 : S (max_N del H) = pred (Rlength (SubEqui del H))). + rewrite SubEqui_P5; reflexivity. + rewrite H13 in H12; rewrite SubEqui_P2 in H12; apply H12. + rewrite SubEqui_P6. + 2: apply lt_n_Sn. + unfold max_N in |- *; case (maxN del H); intros; elim a0; clear a0; + intros _ H13; replace (a + INR x * del + del) with (a + INR (S x) * del); + [ assumption | rewrite S_INR; ring ]. + apply Rplus_lt_reg_r with (pos_Rl (SubEqui del H) I); + replace (pos_Rl (SubEqui del H) I + (t - pos_Rl (SubEqui del H) I)) with t; + [ idtac | ring ]; + replace (pos_Rl (SubEqui del H) I + del) with (pos_Rl (SubEqui del H) (S I)). + assumption. + repeat rewrite SubEqui_P6. + rewrite S_INR; ring. + assumption. + apply le_lt_n_Sm; assumption. + apply Rge_minus; apply Rle_ge; assumption. + intros; clear H0 H1 H4 phi H5 H6 t H7; case (Req_dec t0 b); intro. + left; assumption. + right; set (I := fun j:nat => a + INR j * del <= t0); + assert (H1 : exists n : nat, I n). + exists 0%nat; unfold I in |- *; rewrite Rmult_0_l; rewrite Rplus_0_r; elim H8; + intros; assumption. + assert (H4 : Nbound I). + unfold Nbound in |- *; exists (S (max_N del H)); intros; unfold max_N in |- *; + case (maxN del H); intros; elim a0; clear a0; intros _ H5; + apply INR_le; apply Rmult_le_reg_l with (pos del). + apply (cond_pos del). + apply Rplus_le_reg_l with a; do 2 rewrite (Rmult_comm del); + apply Rle_trans with t0; unfold I in H4; try assumption; + apply Rle_trans with b; try assumption; elim H8; intros; + assumption. + elim (Nzorn H1 H4); intros N [H5 H6]; assert (H7 : (N < S (max_N del H))%nat). + unfold max_N in |- *; case (maxN del H); intros; apply INR_lt; + apply Rmult_lt_reg_l with (pos del). + apply (cond_pos del). + apply Rplus_lt_reg_r with a; do 2 rewrite (Rmult_comm del); + apply Rle_lt_trans with t0; unfold I in H5; try assumption; + elim a0; intros; apply Rlt_le_trans with b; try assumption; + elim H8; intros. + elim H11; intro. + assumption. + elim H0; assumption. + exists N; split. + rewrite SubEqui_P5; simpl in |- *; assumption. + unfold co_interval in |- *; split. + rewrite SubEqui_P6. + apply H5. + assumption. + inversion H7. + replace (S (max_N del H)) with (pred (Rlength (SubEqui del H))). + rewrite (SubEqui_P2 del H); elim H8; intros. + elim H11; intro. + assumption. + elim H0; assumption. + rewrite SubEqui_P5; reflexivity. + rewrite SubEqui_P6. + case (Rle_dec (a + INR (S N) * del) t0); intro. + assert (H11 := H6 (S N) r); elim (le_Sn_n _ H11). + auto with real. + apply le_lt_n_Sm; assumption. Qed. Lemma RiemannInt_P7 : forall (f:R -> R) (a:R), Riemann_integrable f a a. -unfold Riemann_integrable in |- *; intro f; intros; - split with (mkStepFun (StepFun_P4 a a (f a))); - split with (mkStepFun (StepFun_P4 a a 0)); split. -intros; simpl in |- *; unfold fct_cte in |- *; replace t with a. -unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; right; - reflexivity. -generalize H; unfold Rmin, Rmax in |- *; case (Rle_dec a a); intros; elim H0; - intros; apply Rle_antisym; assumption. -rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0; apply (cond_pos eps). +Proof. + unfold Riemann_integrable in |- *; intro f; intros; + split with (mkStepFun (StepFun_P4 a a (f a))); + split with (mkStepFun (StepFun_P4 a a 0)); split. + intros; simpl in |- *; unfold fct_cte in |- *; replace t with a. + unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; right; + reflexivity. + generalize H; unfold Rmin, Rmax in |- *; case (Rle_dec a a); intros; elim H0; + intros; apply Rle_antisym; assumption. + rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0; apply (cond_pos eps). Qed. Lemma continuity_implies_RiemannInt : - forall (f:R -> R) (a b:R), - a <= b -> - (forall x:R, a <= x <= b -> continuity_pt f x) -> Riemann_integrable f a b. -intros; case (total_order_T a b); intro; - [ elim s; intro; - [ apply RiemannInt_P6; assumption | rewrite b0; apply RiemannInt_P7 ] - | elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)) ]. + forall (f:R -> R) (a b:R), + a <= b -> + (forall x:R, a <= x <= b -> continuity_pt f x) -> Riemann_integrable f a b. +Proof. + intros; case (total_order_T a b); intro; + [ elim s; intro; + [ apply RiemannInt_P6; assumption | rewrite b0; apply RiemannInt_P7 ] + | elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)) ]. Qed. Lemma RiemannInt_P8 : - forall (f:R -> R) (a b:R) (pr1:Riemann_integrable f a b) - (pr2:Riemann_integrable f b a), RiemannInt pr1 = - RiemannInt pr2. -intro f; intros; eapply UL_sequence. -unfold RiemannInt in |- *; case (RiemannInt_exists pr1 RinvN RinvN_cv); - intros; apply u. -unfold RiemannInt in |- *; case (RiemannInt_exists pr2 RinvN RinvN_cv); - intros; - cut - (exists psi1 : nat -> StepFun a b, - (forall n:nat, + forall (f:R -> R) (a b:R) (pr1:Riemann_integrable f a b) + (pr2:Riemann_integrable f b a), RiemannInt pr1 = - RiemannInt pr2. +Proof. + intro f; intros; eapply UL_sequence. + unfold RiemannInt in |- *; case (RiemannInt_exists pr1 RinvN RinvN_cv); + intros; apply u. + unfold RiemannInt in |- *; case (RiemannInt_exists pr2 RinvN RinvN_cv); + intros; + cut + (exists psi1 : nat -> StepFun a b, + (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (f t - phi_sequence RinvN pr1 n t) <= psi1 n t) /\ + Rabs (RiemannInt_SF (psi1 n)) < RinvN n)). + cut + (exists psi2 : nat -> StepFun b a, + (forall n:nat, (forall t:R, - Rmin a b <= t /\ t <= Rmax a b -> - Rabs (f t - phi_sequence RinvN pr1 n t) <= psi1 n t) /\ - Rabs (RiemannInt_SF (psi1 n)) < RinvN n)). -cut - (exists psi2 : nat -> StepFun b a, - (forall n:nat, - (forall t:R, Rmin a b <= t /\ t <= Rmax a b -> Rabs (f t - phi_sequence RinvN pr2 n t) <= psi2 n t) /\ - Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). -intros; elim H; clear H; intros psi2 H; elim H0; clear H0; intros psi1 H0; - assert (H1 := RinvN_cv); unfold Un_cv in |- *; intros; - assert (H3 : 0 < eps / 3). -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. -unfold Un_cv in H1; elim (H1 _ H3); clear H1; intros N0 H1; - unfold R_dist in H1; simpl in H1; - assert (H4 : forall n:nat, (n >= N0)%nat -> RinvN n < eps / 3). -intros; assert (H5 := H1 _ H4); - replace (pos (RinvN n)) with (Rabs (/ (INR n + 1) - 0)); - [ assumption - | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; - left; apply (cond_pos (RinvN n)) ]. -clear H1; unfold Un_cv in u; elim (u _ H3); clear u; intros N1 H1; - exists (max N0 N1); intros; unfold R_dist in |- *; - apply Rle_lt_trans with - (Rabs - (RiemannInt_SF (phi_sequence RinvN pr1 n) + - RiemannInt_SF (phi_sequence RinvN pr2 n)) + - Rabs (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)). -rewrite <- (Rabs_Ropp (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)); - replace (RiemannInt_SF (phi_sequence RinvN pr1 n) - - x) with - (RiemannInt_SF (phi_sequence RinvN pr1 n) + - RiemannInt_SF (phi_sequence RinvN pr2 n) + - - (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)); - [ apply Rabs_triang | ring ]. -replace eps with (2 * (eps / 3) + eps / 3). -apply Rplus_lt_compat. -rewrite (StepFun_P39 (phi_sequence RinvN pr2 n)); - replace - (RiemannInt_SF (phi_sequence RinvN pr1 n) + - - RiemannInt_SF (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n))))) - with - (RiemannInt_SF (phi_sequence RinvN pr1 n) + - -1 * - RiemannInt_SF (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n))))); - [ idtac | ring ]; rewrite <- StepFun_P30. -case (Rle_dec a b); intro. -apply Rle_lt_trans with - (RiemannInt_SF - (mkStepFun - (StepFun_P32 - (mkStepFun - (StepFun_P28 (-1) (phi_sequence RinvN pr1 n) - (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n))))))))). -apply StepFun_P34; assumption. -apply Rle_lt_trans with - (RiemannInt_SF - (mkStepFun - (StepFun_P28 1 (psi1 n) (mkStepFun (StepFun_P6 (pre (psi2 n))))))). -apply StepFun_P37; try assumption. -intros; simpl in |- *; rewrite Rmult_1_l; - apply Rle_trans with - (Rabs (phi_sequence RinvN pr1 n x0 - f x0) + - Rabs (f x0 - phi_sequence RinvN pr2 n x0)). -replace (phi_sequence RinvN pr1 n x0 + -1 * phi_sequence RinvN pr2 n x0) with - (phi_sequence RinvN pr1 n x0 - f x0 + (f x0 - phi_sequence RinvN pr2 n x0)); - [ apply Rabs_triang | ring ]. -assert (H7 : Rmin a b = a). -unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n0; assumption ]. -assert (H8 : Rmax a b = b). -unfold Rmax in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n0; assumption ]. -apply Rplus_le_compat. -elim (H0 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H9; - rewrite H7; rewrite H8. -elim H6; intros; split; left; assumption. -elim (H n); intros; apply H9; rewrite H7; rewrite H8. -elim H6; intros; split; left; assumption. -rewrite StepFun_P30; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat. -elim (H0 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))); - [ apply RRle_abs - | apply Rlt_trans with (pos (RinvN n)); - [ assumption - | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1); - [ apply le_max_l | assumption ] ] ]. -elim (H n); intros; - rewrite <- - (Ropp_involutive (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (psi2 n)))))) - ; rewrite <- StepFun_P39; - apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))); - [ rewrite <- Rabs_Ropp; apply RRle_abs - | apply Rlt_trans with (pos (RinvN n)); + Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). + intros; elim H; clear H; intros psi2 H; elim H0; clear H0; intros psi1 H0; + assert (H1 := RinvN_cv); unfold Un_cv in |- *; intros; + assert (H3 : 0 < eps / 3). + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. + unfold Un_cv in H1; elim (H1 _ H3); clear H1; intros N0 H1; + unfold R_dist in H1; simpl in H1; + assert (H4 : forall n:nat, (n >= N0)%nat -> RinvN n < eps / 3). + intros; assert (H5 := H1 _ H4); + replace (pos (RinvN n)) with (Rabs (/ (INR n + 1) - 0)); [ assumption - | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1); - [ apply le_max_l | assumption ] ] ]. -assert (Hyp : b <= a). -auto with real. -rewrite StepFun_P39; rewrite Rabs_Ropp; - apply Rle_lt_trans with - (RiemannInt_SF - (mkStepFun + | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; + left; apply (cond_pos (RinvN n)) ]. + clear H1; unfold Un_cv in u; elim (u _ H3); clear u; intros N1 H1; + exists (max N0 N1); intros; unfold R_dist in |- *; + apply Rle_lt_trans with + (Rabs + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + RiemannInt_SF (phi_sequence RinvN pr2 n)) + + Rabs (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)). + rewrite <- (Rabs_Ropp (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)); + replace (RiemannInt_SF (phi_sequence RinvN pr1 n) - - x) with + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + RiemannInt_SF (phi_sequence RinvN pr2 n) + + - (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)); + [ apply Rabs_triang | ring ]. + replace eps with (2 * (eps / 3) + eps / 3). + apply Rplus_lt_compat. + rewrite (StepFun_P39 (phi_sequence RinvN pr2 n)); + replace + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + - RiemannInt_SF (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n))))) + with + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + -1 * + RiemannInt_SF (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n))))); + [ idtac | ring ]; rewrite <- StepFun_P30. + case (Rle_dec a b); intro. + apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun (StepFun_P32 - (mkStepFun + (mkStepFun + (StepFun_P28 (-1) (phi_sequence RinvN pr1 n) + (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n))))))))). + apply StepFun_P34; assumption. + apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P28 1 (psi1 n) (mkStepFun (StepFun_P6 (pre (psi2 n))))))). + apply StepFun_P37; try assumption. + intros; simpl in |- *; rewrite Rmult_1_l; + apply Rle_trans with + (Rabs (phi_sequence RinvN pr1 n x0 - f x0) + + Rabs (f x0 - phi_sequence RinvN pr2 n x0)). + replace (phi_sequence RinvN pr1 n x0 + -1 * phi_sequence RinvN pr2 n x0) with + (phi_sequence RinvN pr1 n x0 - f x0 + (f x0 - phi_sequence RinvN pr2 n x0)); + [ apply Rabs_triang | ring ]. + assert (H7 : Rmin a b = a). + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. + assert (H8 : Rmax a b = b). + unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. + apply Rplus_le_compat. + elim (H0 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H9; + rewrite H7; rewrite H8. + elim H6; intros; split; left; assumption. + elim (H n); intros; apply H9; rewrite H7; rewrite H8. + elim H6; intros; split; left; assumption. + rewrite StepFun_P30; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat. + elim (H0 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))); + [ apply RRle_abs + | apply Rlt_trans with (pos (RinvN n)); + [ assumption + | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1); + [ apply le_max_l | assumption ] ] ]. + elim (H n); intros; + rewrite <- + (Ropp_involutive (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (psi2 n)))))) + ; rewrite <- StepFun_P39; + apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))); + [ rewrite <- Rabs_Ropp; apply RRle_abs + | apply Rlt_trans with (pos (RinvN n)); + [ assumption + | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1); + [ apply le_max_l | assumption ] ] ]. + assert (Hyp : b <= a). + auto with real. + rewrite StepFun_P39; rewrite Rabs_Ropp; + apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P32 + (mkStepFun (StepFun_P6 - (StepFun_P28 (-1) (phi_sequence RinvN pr1 n) - (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n)))))))))). -apply StepFun_P34; assumption. -apply Rle_lt_trans with - (RiemannInt_SF - (mkStepFun - (StepFun_P28 1 (mkStepFun (StepFun_P6 (pre (psi1 n)))) (psi2 n)))). -apply StepFun_P37; try assumption. -intros; simpl in |- *; rewrite Rmult_1_l; - apply Rle_trans with - (Rabs (phi_sequence RinvN pr1 n x0 - f x0) + - Rabs (f x0 - phi_sequence RinvN pr2 n x0)). -replace (phi_sequence RinvN pr1 n x0 + -1 * phi_sequence RinvN pr2 n x0) with - (phi_sequence RinvN pr1 n x0 - f x0 + (f x0 - phi_sequence RinvN pr2 n x0)); - [ apply Rabs_triang | ring ]. -assert (H7 : Rmin a b = b). -unfold Rmin in |- *; case (Rle_dec a b); intro; - [ elim n0; assumption | reflexivity ]. -assert (H8 : Rmax a b = a). -unfold Rmax in |- *; case (Rle_dec a b); intro; - [ elim n0; assumption | reflexivity ]. -apply Rplus_le_compat. -elim (H0 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H9; - rewrite H7; rewrite H8. -elim H6; intros; split; left; assumption. -elim (H n); intros; apply H9; rewrite H7; rewrite H8; elim H6; intros; split; - left; assumption. -rewrite StepFun_P30; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat. -elim (H0 n); intros; - rewrite <- - (Ropp_involutive (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (psi1 n)))))) - ; rewrite <- StepFun_P39; - apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))); - [ rewrite <- Rabs_Ropp; apply RRle_abs - | apply Rlt_trans with (pos (RinvN n)); - [ assumption - | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1); - [ apply le_max_l | assumption ] ] ]. -elim (H n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))); - [ apply RRle_abs - | apply Rlt_trans with (pos (RinvN n)); - [ assumption - | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1); - [ apply le_max_l | assumption ] ] ]. -unfold R_dist in H1; apply H1; unfold ge in |- *; - apply le_trans with (max N0 N1); [ apply le_max_r | assumption ]. -apply Rmult_eq_reg_l with 3; - [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l; - do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; - rewrite <- Rinv_l_sym; [ ring | discrR ] - | discrR ]. -split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro; - rewrite Rmin_comm; rewrite RmaxSym; - apply (projT2 (phi_sequence_prop RinvN pr2 n)). -split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro; - apply (projT2 (phi_sequence_prop RinvN pr1 n)). + (StepFun_P28 (-1) (phi_sequence RinvN pr1 n) + (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n)))))))))). + apply StepFun_P34; assumption. + apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P28 1 (mkStepFun (StepFun_P6 (pre (psi1 n)))) (psi2 n)))). + apply StepFun_P37; try assumption. + intros; simpl in |- *; rewrite Rmult_1_l; + apply Rle_trans with + (Rabs (phi_sequence RinvN pr1 n x0 - f x0) + + Rabs (f x0 - phi_sequence RinvN pr2 n x0)). + replace (phi_sequence RinvN pr1 n x0 + -1 * phi_sequence RinvN pr2 n x0) with + (phi_sequence RinvN pr1 n x0 - f x0 + (f x0 - phi_sequence RinvN pr2 n x0)); + [ apply Rabs_triang | ring ]. + assert (H7 : Rmin a b = b). + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ elim n0; assumption | reflexivity ]. + assert (H8 : Rmax a b = a). + unfold Rmax in |- *; case (Rle_dec a b); intro; + [ elim n0; assumption | reflexivity ]. + apply Rplus_le_compat. + elim (H0 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H9; + rewrite H7; rewrite H8. + elim H6; intros; split; left; assumption. + elim (H n); intros; apply H9; rewrite H7; rewrite H8; elim H6; intros; split; + left; assumption. + rewrite StepFun_P30; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat. + elim (H0 n); intros; + rewrite <- + (Ropp_involutive (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (psi1 n)))))) + ; rewrite <- StepFun_P39; + apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))); + [ rewrite <- Rabs_Ropp; apply RRle_abs + | apply Rlt_trans with (pos (RinvN n)); + [ assumption + | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1); + [ apply le_max_l | assumption ] ] ]. + elim (H n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))); + [ apply RRle_abs + | apply Rlt_trans with (pos (RinvN n)); + [ assumption + | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1); + [ apply le_max_l | assumption ] ] ]. + unfold R_dist in H1; apply H1; unfold ge in |- *; + apply le_trans with (max N0 N1); [ apply le_max_r | assumption ]. + apply Rmult_eq_reg_l with 3; + [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l; + do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ ring | discrR ] + | discrR ]. + split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro; + rewrite Rmin_comm; rewrite RmaxSym; + apply (projT2 (phi_sequence_prop RinvN pr2 n)). + split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr1 n)). Qed. Lemma RiemannInt_P9 : - forall (f:R -> R) (a:R) (pr:Riemann_integrable f a a), RiemannInt pr = 0. -intros; assert (H := RiemannInt_P8 pr pr); apply Rmult_eq_reg_l with 2; - [ rewrite Rmult_0_r; rewrite double; pattern (RiemannInt pr) at 2 in |- *; - rewrite H; apply Rplus_opp_r - | discrR ]. + forall (f:R -> R) (a:R) (pr:Riemann_integrable f a a), RiemannInt pr = 0. +Proof. + intros; assert (H := RiemannInt_P8 pr pr); apply Rmult_eq_reg_l with 2; + [ rewrite Rmult_0_r; rewrite double; pattern (RiemannInt pr) at 2 in |- *; + rewrite H; apply Rplus_opp_r + | discrR ]. Qed. Lemma Req_EM_T : forall r1 r2:R, {r1 = r2} + {r1 <> r2}. -intros; elim (total_order_T r1 r2); intros; - [ elim a; intro; - [ right; red in |- *; intro; rewrite H in a0; elim (Rlt_irrefl r2 a0) - | left; assumption ] - | right; red in |- *; intro; rewrite H in b; elim (Rlt_irrefl r2 b) ]. +Proof. + intros; elim (total_order_T r1 r2); intros; + [ elim a; intro; + [ right; red in |- *; intro; rewrite H in a0; elim (Rlt_irrefl r2 a0) + | left; assumption ] + | right; red in |- *; intro; rewrite H in b; elim (Rlt_irrefl r2 b) ]. Qed. (* L1([a,b]) is a vectorial space *) Lemma RiemannInt_P10 : - forall (f g:R -> R) (a b l:R), - Riemann_integrable f a b -> - Riemann_integrable g a b -> - Riemann_integrable (fun x:R => f x + l * g x) a b. -unfold Riemann_integrable in |- *; intros f g; intros; case (Req_EM_T l 0); - intro. -elim (X eps); intros; split with x; elim p; intros; split with x0; elim p0; - intros; split; try assumption; rewrite e; intros; - rewrite Rmult_0_l; rewrite Rplus_0_r; apply H; assumption. -assert (H : 0 < eps / 2). -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ]. -assert (H0 : 0 < eps / (2 * Rabs l)). -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ apply (cond_pos eps) - | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; - [ prove_sup0 | apply Rabs_pos_lt; assumption ] ]. -elim (X (mkposreal _ H)); intros; elim (X0 (mkposreal _ H0)); intros; - split with (mkStepFun (StepFun_P28 l x x0)); elim p0; - elim p; intros; split with (mkStepFun (StepFun_P28 (Rabs l) x1 x2)); - elim p1; elim p2; clear p1 p2 p0 p X X0; intros; split. -intros; simpl in |- *; - apply Rle_trans with (Rabs (f t - x t) + Rabs (l * (g t - x0 t))). -replace (f t + l * g t - (x t + l * x0 t)) with - (f t - x t + l * (g t - x0 t)); [ apply Rabs_triang | ring ]. -apply Rplus_le_compat; - [ apply H3; assumption - | rewrite Rabs_mult; apply Rmult_le_compat_l; - [ apply Rabs_pos | apply H1; assumption ] ]. -rewrite StepFun_P30; - apply Rle_lt_trans with - (Rabs (RiemannInt_SF x1) + Rabs (Rabs l * RiemannInt_SF x2)). -apply Rabs_triang. -rewrite (double_var eps); apply Rplus_lt_compat. -apply H4. -rewrite Rabs_mult; rewrite Rabs_Rabsolu; apply Rmult_lt_reg_l with (/ Rabs l). -apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. -rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym; - [ rewrite Rmult_1_l; - replace (/ Rabs l * (eps / 2)) with (eps / (2 * Rabs l)); - [ apply H2 - | unfold Rdiv in |- *; rewrite Rinv_mult_distr; - [ ring | discrR | apply Rabs_no_R0; assumption ] ] - | apply Rabs_no_R0; assumption ]. + forall (f g:R -> R) (a b l:R), + Riemann_integrable f a b -> + Riemann_integrable g a b -> + Riemann_integrable (fun x:R => f x + l * g x) a b. +Proof. + unfold Riemann_integrable in |- *; intros f g; intros; case (Req_EM_T l 0); + intro. + elim (X eps); intros; split with x; elim p; intros; split with x0; elim p0; + intros; split; try assumption; rewrite e; intros; + rewrite Rmult_0_l; rewrite Rplus_0_r; apply H; assumption. + assert (H : 0 < eps / 2). + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ]. + assert (H0 : 0 < eps / (2 * Rabs l)). + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos eps) + | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; + [ prove_sup0 | apply Rabs_pos_lt; assumption ] ]. + elim (X (mkposreal _ H)); intros; elim (X0 (mkposreal _ H0)); intros; + split with (mkStepFun (StepFun_P28 l x x0)); elim p0; + elim p; intros; split with (mkStepFun (StepFun_P28 (Rabs l) x1 x2)); + elim p1; elim p2; clear p1 p2 p0 p X X0; intros; split. + intros; simpl in |- *; + apply Rle_trans with (Rabs (f t - x t) + Rabs (l * (g t - x0 t))). + replace (f t + l * g t - (x t + l * x0 t)) with + (f t - x t + l * (g t - x0 t)); [ apply Rabs_triang | ring ]. + apply Rplus_le_compat; + [ apply H3; assumption + | rewrite Rabs_mult; apply Rmult_le_compat_l; + [ apply Rabs_pos | apply H1; assumption ] ]. + rewrite StepFun_P30; + apply Rle_lt_trans with + (Rabs (RiemannInt_SF x1) + Rabs (Rabs l * RiemannInt_SF x2)). + apply Rabs_triang. + rewrite (double_var eps); apply Rplus_lt_compat. + apply H4. + rewrite Rabs_mult; rewrite Rabs_Rabsolu; apply Rmult_lt_reg_l with (/ Rabs l). + apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. + rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym; + [ rewrite Rmult_1_l; + replace (/ Rabs l * (eps / 2)) with (eps / (2 * Rabs l)); + [ apply H2 + | unfold Rdiv in |- *; rewrite Rinv_mult_distr; + [ ring | discrR | apply Rabs_no_R0; assumption ] ] + | apply Rabs_no_R0; assumption ]. Qed. Lemma RiemannInt_P11 : - forall (f:R -> R) (a b l:R) (un:nat -> posreal) - (phi1 phi2 psi1 psi2:nat -> StepFun a b), - Un_cv un 0 -> - (forall n:nat, + forall (f:R -> R) (a b l:R) (un:nat -> posreal) + (phi1 phi2 psi1 psi2:nat -> StepFun a b), + Un_cv un 0 -> + (forall n:nat, (forall t:R, - Rmin a b <= t <= Rmax a b -> Rabs (f t - phi1 n t) <= psi1 n t) /\ + Rmin a b <= t <= Rmax a b -> Rabs (f t - phi1 n t) <= psi1 n t) /\ Rabs (RiemannInt_SF (psi1 n)) < un n) -> - (forall n:nat, + (forall n:nat, (forall t:R, - Rmin a b <= t <= Rmax a b -> Rabs (f t - phi2 n t) <= psi2 n t) /\ + Rmin a b <= t <= Rmax a b -> Rabs (f t - phi2 n t) <= psi2 n t) /\ Rabs (RiemannInt_SF (psi2 n)) < un n) -> - Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) l -> - Un_cv (fun N:nat => RiemannInt_SF (phi2 N)) l. -unfold Un_cv in |- *; intro f; intros; intros. -case (Rle_dec a b); intro Hyp. -assert (H4 : 0 < eps / 3). -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. -elim (H _ H4); clear H; intros N0 H. -elim (H2 _ H4); clear H2; intros N1 H2. -set (N := max N0 N1); exists N; intros; unfold R_dist in |- *. -apply Rle_lt_trans with - (Rabs (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) + - Rabs (RiemannInt_SF (phi1 n) - l)). -replace (RiemannInt_SF (phi2 n) - l) with - (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n) + - (RiemannInt_SF (phi1 n) - l)); [ apply Rabs_triang | ring ]. -replace eps with (2 * (eps / 3) + eps / 3). -apply Rplus_lt_compat. -replace (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) with - (RiemannInt_SF (phi2 n) + -1 * RiemannInt_SF (phi1 n)); - [ idtac | ring ]. -rewrite <- StepFun_P30. -apply Rle_lt_trans with - (RiemannInt_SF - (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (phi2 n) (phi1 n)))))). -apply StepFun_P34; assumption. -apply Rle_lt_trans with - (RiemannInt_SF (mkStepFun (StepFun_P28 1 (psi1 n) (psi2 n)))). -apply StepFun_P37; try assumption; intros; simpl in |- *; rewrite Rmult_1_l. -apply Rle_trans with (Rabs (phi2 n x - f x) + Rabs (f x - phi1 n x)). -replace (phi2 n x + -1 * phi1 n x) with (phi2 n x - f x + (f x - phi1 n x)); - [ apply Rabs_triang | ring ]. -rewrite (Rplus_comm (psi1 n x)); apply Rplus_le_compat. -rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim (H1 n); intros; apply H7. -assert (H10 : Rmin a b = a). -unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n0; assumption ]. -assert (H11 : Rmax a b = b). -unfold Rmax in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n0; assumption ]. -rewrite H10; rewrite H11; elim H6; intros; split; left; assumption. -elim (H0 n); intros; apply H7; assert (H10 : Rmin a b = a). -unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n0; assumption ]. -assert (H11 : Rmax a b = b). -unfold Rmax in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n0; assumption ]. -rewrite H10; rewrite H11; elim H6; intros; split; left; assumption. -rewrite StepFun_P30; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat. -apply Rlt_trans with (pos (un n)). -elim (H0 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))). -apply RRle_abs. -assumption. -replace (pos (un n)) with (R_dist (un n) 0). -apply H; unfold ge in |- *; apply le_trans with N; try assumption. -unfold N in |- *; apply le_max_l. -unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; - rewrite Rplus_0_r; apply Rabs_right. -apply Rle_ge; left; apply (cond_pos (un n)). -apply Rlt_trans with (pos (un n)). -elim (H1 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))). -apply RRle_abs; assumption. -assumption. -replace (pos (un n)) with (R_dist (un n) 0). -apply H; unfold ge in |- *; apply le_trans with N; try assumption; - unfold N in |- *; apply le_max_l. -unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; - rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; - left; apply (cond_pos (un n)). -unfold R_dist in H2; apply H2; unfold ge in |- *; apply le_trans with N; - try assumption; unfold N in |- *; apply le_max_r. -apply Rmult_eq_reg_l with 3; - [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l; - do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; - rewrite <- Rinv_l_sym; [ ring | discrR ] - | discrR ]. -assert (H4 : 0 < eps / 3). -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. -elim (H _ H4); clear H; intros N0 H. -elim (H2 _ H4); clear H2; intros N1 H2. -set (N := max N0 N1); exists N; intros; unfold R_dist in |- *. -apply Rle_lt_trans with - (Rabs (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) + - Rabs (RiemannInt_SF (phi1 n) - l)). -replace (RiemannInt_SF (phi2 n) - l) with - (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n) + - (RiemannInt_SF (phi1 n) - l)); [ apply Rabs_triang | ring ]. -assert (Hyp_b : b <= a). -auto with real. -replace eps with (2 * (eps / 3) + eps / 3). -apply Rplus_lt_compat. -replace (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) with - (RiemannInt_SF (phi2 n) + -1 * RiemannInt_SF (phi1 n)); - [ idtac | ring ]. -rewrite <- StepFun_P30. -rewrite StepFun_P39. -rewrite Rabs_Ropp. -apply Rle_lt_trans with - (RiemannInt_SF - (mkStepFun - (StepFun_P32 + Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) l -> + Un_cv (fun N:nat => RiemannInt_SF (phi2 N)) l. +Proof. + unfold Un_cv in |- *; intro f; intros; intros. + case (Rle_dec a b); intro Hyp. + assert (H4 : 0 < eps / 3). + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. + elim (H _ H4); clear H; intros N0 H. + elim (H2 _ H4); clear H2; intros N1 H2. + set (N := max N0 N1); exists N; intros; unfold R_dist in |- *. + apply Rle_lt_trans with + (Rabs (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) + + Rabs (RiemannInt_SF (phi1 n) - l)). + replace (RiemannInt_SF (phi2 n) - l) with + (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n) + + (RiemannInt_SF (phi1 n) - l)); [ apply Rabs_triang | ring ]. + replace eps with (2 * (eps / 3) + eps / 3). + apply Rplus_lt_compat. + replace (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) with + (RiemannInt_SF (phi2 n) + -1 * RiemannInt_SF (phi1 n)); + [ idtac | ring ]. + rewrite <- StepFun_P30. + apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (phi2 n) (phi1 n)))))). + apply StepFun_P34; assumption. + apply Rle_lt_trans with + (RiemannInt_SF (mkStepFun (StepFun_P28 1 (psi1 n) (psi2 n)))). + apply StepFun_P37; try assumption; intros; simpl in |- *; rewrite Rmult_1_l. + apply Rle_trans with (Rabs (phi2 n x - f x) + Rabs (f x - phi1 n x)). + replace (phi2 n x + -1 * phi1 n x) with (phi2 n x - f x + (f x - phi1 n x)); + [ apply Rabs_triang | ring ]. + rewrite (Rplus_comm (psi1 n x)); apply Rplus_le_compat. + rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim (H1 n); intros; apply H7. + assert (H10 : Rmin a b = a). + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. + assert (H11 : Rmax a b = b). + unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. + rewrite H10; rewrite H11; elim H6; intros; split; left; assumption. + elim (H0 n); intros; apply H7; assert (H10 : Rmin a b = a). + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. + assert (H11 : Rmax a b = b). + unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. + rewrite H10; rewrite H11; elim H6; intros; split; left; assumption. + rewrite StepFun_P30; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat. + apply Rlt_trans with (pos (un n)). + elim (H0 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))). + apply RRle_abs. + assumption. + replace (pos (un n)) with (R_dist (un n) 0). + apply H; unfold ge in |- *; apply le_trans with N; try assumption. + unfold N in |- *; apply le_max_l. + unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; apply Rabs_right. + apply Rle_ge; left; apply (cond_pos (un n)). + apply Rlt_trans with (pos (un n)). + elim (H1 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))). + apply RRle_abs; assumption. + assumption. + replace (pos (un n)) with (R_dist (un n) 0). + apply H; unfold ge in |- *; apply le_trans with N; try assumption; + unfold N in |- *; apply le_max_l. + unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; + left; apply (cond_pos (un n)). + unfold R_dist in H2; apply H2; unfold ge in |- *; apply le_trans with N; + try assumption; unfold N in |- *; apply le_max_r. + apply Rmult_eq_reg_l with 3; + [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l; + do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ ring | discrR ] + | discrR ]. + assert (H4 : 0 < eps / 3). + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. + elim (H _ H4); clear H; intros N0 H. + elim (H2 _ H4); clear H2; intros N1 H2. + set (N := max N0 N1); exists N; intros; unfold R_dist in |- *. + apply Rle_lt_trans with + (Rabs (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) + + Rabs (RiemannInt_SF (phi1 n) - l)). + replace (RiemannInt_SF (phi2 n) - l) with + (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n) + + (RiemannInt_SF (phi1 n) - l)); [ apply Rabs_triang | ring ]. + assert (Hyp_b : b <= a). + auto with real. + replace eps with (2 * (eps / 3) + eps / 3). + apply Rplus_lt_compat. + replace (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) with + (RiemannInt_SF (phi2 n) + -1 * RiemannInt_SF (phi1 n)); + [ idtac | ring ]. + rewrite <- StepFun_P30. + rewrite StepFun_P39. + rewrite Rabs_Ropp. + apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P32 (mkStepFun - (StepFun_P6 - (pre (mkStepFun (StepFun_P28 (-1) (phi2 n) (phi1 n))))))))). -apply StepFun_P34; try assumption. -apply Rle_lt_trans with - (RiemannInt_SF - (mkStepFun - (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 (psi1 n) (psi2 n))))))). -apply StepFun_P37; try assumption. -intros; simpl in |- *; rewrite Rmult_1_l. -apply Rle_trans with (Rabs (phi2 n x - f x) + Rabs (f x - phi1 n x)). -replace (phi2 n x + -1 * phi1 n x) with (phi2 n x - f x + (f x - phi1 n x)); - [ apply Rabs_triang | ring ]. -rewrite (Rplus_comm (psi1 n x)); apply Rplus_le_compat. -rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim (H1 n); intros; apply H7. -assert (H10 : Rmin a b = b). -unfold Rmin in |- *; case (Rle_dec a b); intro; - [ elim Hyp; assumption | reflexivity ]. -assert (H11 : Rmax a b = a). -unfold Rmax in |- *; case (Rle_dec a b); intro; - [ elim Hyp; assumption | reflexivity ]. -rewrite H10; rewrite H11; elim H6; intros; split; left; assumption. -elim (H0 n); intros; apply H7; assert (H10 : Rmin a b = b). -unfold Rmin in |- *; case (Rle_dec a b); intro; - [ elim Hyp; assumption | reflexivity ]. -assert (H11 : Rmax a b = a). -unfold Rmax in |- *; case (Rle_dec a b); intro; - [ elim Hyp; assumption | reflexivity ]. -rewrite H10; rewrite H11; elim H6; intros; split; left; assumption. -rewrite <- - (Ropp_involutive + (StepFun_P6 + (pre (mkStepFun (StepFun_P28 (-1) (phi2 n) (phi1 n))))))))). + apply StepFun_P34; try assumption. + apply Rle_lt_trans with (RiemannInt_SF - (mkStepFun + (mkStepFun + (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 (psi1 n) (psi2 n))))))). + apply StepFun_P37; try assumption. + intros; simpl in |- *; rewrite Rmult_1_l. + apply Rle_trans with (Rabs (phi2 n x - f x) + Rabs (f x - phi1 n x)). + replace (phi2 n x + -1 * phi1 n x) with (phi2 n x - f x + (f x - phi1 n x)); + [ apply Rabs_triang | ring ]. + rewrite (Rplus_comm (psi1 n x)); apply Rplus_le_compat. + rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim (H1 n); intros; apply H7. + assert (H10 : Rmin a b = b). + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ elim Hyp; assumption | reflexivity ]. + assert (H11 : Rmax a b = a). + unfold Rmax in |- *; case (Rle_dec a b); intro; + [ elim Hyp; assumption | reflexivity ]. + rewrite H10; rewrite H11; elim H6; intros; split; left; assumption. + elim (H0 n); intros; apply H7; assert (H10 : Rmin a b = b). + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ elim Hyp; assumption | reflexivity ]. + assert (H11 : Rmax a b = a). + unfold Rmax in |- *; case (Rle_dec a b); intro; + [ elim Hyp; assumption | reflexivity ]. + rewrite H10; rewrite H11; elim H6; intros; split; left; assumption. + rewrite <- + (Ropp_involutive + (RiemannInt_SF + (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 (psi1 n) (psi2 n)))))))) - . -rewrite <- StepFun_P39. -rewrite StepFun_P30. -rewrite Rmult_1_l; rewrite double. -rewrite Ropp_plus_distr; apply Rplus_lt_compat. -apply Rlt_trans with (pos (un n)). -elim (H0 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))). -rewrite <- Rabs_Ropp; apply RRle_abs. -assumption. -replace (pos (un n)) with (R_dist (un n) 0). -apply H; unfold ge in |- *; apply le_trans with N; try assumption. -unfold N in |- *; apply le_max_l. -unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; - rewrite Rplus_0_r; apply Rabs_right. -apply Rle_ge; left; apply (cond_pos (un n)). -apply Rlt_trans with (pos (un n)). -elim (H1 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))). -rewrite <- Rabs_Ropp; apply RRle_abs; assumption. -assumption. -replace (pos (un n)) with (R_dist (un n) 0). -apply H; unfold ge in |- *; apply le_trans with N; try assumption; - unfold N in |- *; apply le_max_l. -unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; - rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; - left; apply (cond_pos (un n)). -unfold R_dist in H2; apply H2; unfold ge in |- *; apply le_trans with N; - try assumption; unfold N in |- *; apply le_max_r. -apply Rmult_eq_reg_l with 3; - [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l; - do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; - rewrite <- Rinv_l_sym; [ ring | discrR ] - | discrR ]. + . + rewrite <- StepFun_P39. + rewrite StepFun_P30. + rewrite Rmult_1_l; rewrite double. + rewrite Ropp_plus_distr; apply Rplus_lt_compat. + apply Rlt_trans with (pos (un n)). + elim (H0 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))). + rewrite <- Rabs_Ropp; apply RRle_abs. + assumption. + replace (pos (un n)) with (R_dist (un n) 0). + apply H; unfold ge in |- *; apply le_trans with N; try assumption. + unfold N in |- *; apply le_max_l. + unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; apply Rabs_right. + apply Rle_ge; left; apply (cond_pos (un n)). + apply Rlt_trans with (pos (un n)). + elim (H1 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))). + rewrite <- Rabs_Ropp; apply RRle_abs; assumption. + assumption. + replace (pos (un n)) with (R_dist (un n) 0). + apply H; unfold ge in |- *; apply le_trans with N; try assumption; + unfold N in |- *; apply le_max_l. + unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; + left; apply (cond_pos (un n)). + unfold R_dist in H2; apply H2; unfold ge in |- *; apply le_trans with N; + try assumption; unfold N in |- *; apply le_max_r. + apply Rmult_eq_reg_l with 3; + [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l; + do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ ring | discrR ] + | discrR ]. Qed. Lemma RiemannInt_P12 : - forall (f g:R -> R) (a b l:R) (pr1:Riemann_integrable f a b) - (pr2:Riemann_integrable g a b) - (pr3:Riemann_integrable (fun x:R => f x + l * g x) a b), - a <= b -> RiemannInt pr3 = RiemannInt pr1 + l * RiemannInt pr2. -intro f; intros; case (Req_dec l 0); intro. -pattern l at 2 in |- *; rewrite H0; rewrite Rmult_0_l; rewrite Rplus_0_r; - unfold RiemannInt in |- *; case (RiemannInt_exists pr3 RinvN RinvN_cv); - case (RiemannInt_exists pr1 RinvN RinvN_cv); intros; - eapply UL_sequence; - [ apply u0 - | set (psi1 := fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); - set (psi2 := fun n:nat => projT1 (phi_sequence_prop RinvN pr3 n)); - apply RiemannInt_P11 with f RinvN (phi_sequence RinvN pr1) psi1 psi2; - [ apply RinvN_cv - | intro; apply (projT2 (phi_sequence_prop RinvN pr1 n)) - | intro; - assert - (H1 : - (forall t:R, - Rmin a b <= t /\ t <= Rmax a b -> - Rabs (f t + l * g t - phi_sequence RinvN pr3 n t) <= psi2 n t) /\ - Rabs (RiemannInt_SF (psi2 n)) < RinvN n); - [ apply (projT2 (phi_sequence_prop RinvN pr3 n)) - | elim H1; intros; split; try assumption; intros; - replace (f t) with (f t + l * g t); - [ apply H2; assumption | rewrite H0; ring ] ] - | assumption ] ]. -eapply UL_sequence. -unfold RiemannInt in |- *; case (RiemannInt_exists pr3 RinvN RinvN_cv); - intros; apply u. -unfold Un_cv in |- *; intros; unfold RiemannInt in |- *; - case (RiemannInt_exists pr1 RinvN RinvN_cv); - case (RiemannInt_exists pr2 RinvN RinvN_cv); unfold Un_cv in |- *; - intros; assert (H2 : 0 < eps / 5). -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. -elim (u0 _ H2); clear u0; intros N0 H3; assert (H4 := RinvN_cv); - unfold Un_cv in H4; elim (H4 _ H2); clear H4 H2; intros N1 H4; - assert (H5 : 0 < eps / (5 * Rabs l)). -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption - | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; - [ prove_sup0 | apply Rabs_pos_lt; assumption ] ]. -elim (u _ H5); clear u; intros N2 H6; assert (H7 := RinvN_cv); - unfold Un_cv in H7; elim (H7 _ H5); clear H7 H5; intros N3 H5; - unfold R_dist in H3, H4, H5, H6; set (N := max (max N0 N1) (max N2 N3)). -assert (H7 : forall n:nat, (n >= N1)%nat -> RinvN n < eps / 5). -intros; replace (pos (RinvN n)) with (Rabs (RinvN n - 0)); - [ unfold RinvN in |- *; apply H4; assumption - | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; - left; apply (cond_pos (RinvN n)) ]. -clear H4; assert (H4 := H7); clear H7; - assert (H7 : forall n:nat, (n >= N3)%nat -> RinvN n < eps / (5 * Rabs l)). -intros; replace (pos (RinvN n)) with (Rabs (RinvN n - 0)); - [ unfold RinvN in |- *; apply H5; assumption - | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; - left; apply (cond_pos (RinvN n)) ]. -clear H5; assert (H5 := H7); clear H7; exists N; intros; - unfold R_dist in |- *. -apply Rle_lt_trans with - (Rabs - (RiemannInt_SF (phi_sequence RinvN pr3 n) - - (RiemannInt_SF (phi_sequence RinvN pr1 n) + - l * RiemannInt_SF (phi_sequence RinvN pr2 n))) + - Rabs (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0) + - Rabs l * Rabs (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)). -apply Rle_trans with - (Rabs - (RiemannInt_SF (phi_sequence RinvN pr3 n) - - (RiemannInt_SF (phi_sequence RinvN pr1 n) + - l * RiemannInt_SF (phi_sequence RinvN pr2 n))) + - Rabs - (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0 + - l * (RiemannInt_SF (phi_sequence RinvN pr2 n) - x))). -replace (RiemannInt_SF (phi_sequence RinvN pr3 n) - (x0 + l * x)) with - (RiemannInt_SF (phi_sequence RinvN pr3 n) - - (RiemannInt_SF (phi_sequence RinvN pr1 n) + - l * RiemannInt_SF (phi_sequence RinvN pr2 n)) + - (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0 + - l * (RiemannInt_SF (phi_sequence RinvN pr2 n) - x))); - [ apply Rabs_triang | ring ]. -rewrite Rplus_assoc; apply Rplus_le_compat_l; rewrite <- Rabs_mult; - replace - (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0 + - l * (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)) with - (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0 + - l * (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)); - [ apply Rabs_triang | ring ]. -replace eps with (3 * (eps / 5) + eps / 5 + eps / 5). -repeat apply Rplus_lt_compat. -assert - (H7 : - exists psi1 : nat -> StepFun a b, - (forall n:nat, - (forall t:R, - Rmin a b <= t /\ t <= Rmax a b -> - Rabs (f t - phi_sequence RinvN pr1 n t) <= psi1 n t) /\ - Rabs (RiemannInt_SF (psi1 n)) < RinvN n)). -split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro; - apply (projT2 (phi_sequence_prop RinvN pr1 n0)). -assert - (H8 : - exists psi2 : nat -> StepFun a b, - (forall n:nat, - (forall t:R, - Rmin a b <= t /\ t <= Rmax a b -> - Rabs (g t - phi_sequence RinvN pr2 n t) <= psi2 n t) /\ - Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). -split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro; - apply (projT2 (phi_sequence_prop RinvN pr2 n0)). -assert - (H9 : - exists psi3 : nat -> StepFun a b, - (forall n:nat, - (forall t:R, - Rmin a b <= t /\ t <= Rmax a b -> - Rabs (f t + l * g t - phi_sequence RinvN pr3 n t) <= psi3 n t) /\ - Rabs (RiemannInt_SF (psi3 n)) < RinvN n)). -split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr3 n)); intro; - apply (projT2 (phi_sequence_prop RinvN pr3 n0)). -elim H7; clear H7; intros psi1 H7; elim H8; clear H8; intros psi2 H8; elim H9; - clear H9; intros psi3 H9; - replace + forall (f g:R -> R) (a b l:R) (pr1:Riemann_integrable f a b) + (pr2:Riemann_integrable g a b) + (pr3:Riemann_integrable (fun x:R => f x + l * g x) a b), + a <= b -> RiemannInt pr3 = RiemannInt pr1 + l * RiemannInt pr2. +Proof. + intro f; intros; case (Req_dec l 0); intro. + pattern l at 2 in |- *; rewrite H0; rewrite Rmult_0_l; rewrite Rplus_0_r; + unfold RiemannInt in |- *; case (RiemannInt_exists pr3 RinvN RinvN_cv); + case (RiemannInt_exists pr1 RinvN RinvN_cv); intros; + eapply UL_sequence; + [ apply u0 + | set (psi1 := fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); + set (psi2 := fun n:nat => projT1 (phi_sequence_prop RinvN pr3 n)); + apply RiemannInt_P11 with f RinvN (phi_sequence RinvN pr1) psi1 psi2; + [ apply RinvN_cv + | intro; apply (projT2 (phi_sequence_prop RinvN pr1 n)) + | intro; + assert + (H1 : + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (f t + l * g t - phi_sequence RinvN pr3 n t) <= psi2 n t) /\ + Rabs (RiemannInt_SF (psi2 n)) < RinvN n); + [ apply (projT2 (phi_sequence_prop RinvN pr3 n)) + | elim H1; intros; split; try assumption; intros; + replace (f t) with (f t + l * g t); + [ apply H2; assumption | rewrite H0; ring ] ] + | assumption ] ]. + eapply UL_sequence. + unfold RiemannInt in |- *; case (RiemannInt_exists pr3 RinvN RinvN_cv); + intros; apply u. + unfold Un_cv in |- *; intros; unfold RiemannInt in |- *; + case (RiemannInt_exists pr1 RinvN RinvN_cv); + case (RiemannInt_exists pr2 RinvN RinvN_cv); unfold Un_cv in |- *; + intros; assert (H2 : 0 < eps / 5). + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. + elim (u0 _ H2); clear u0; intros N0 H3; assert (H4 := RinvN_cv); + unfold Un_cv in H4; elim (H4 _ H2); clear H4 H2; intros N1 H4; + assert (H5 : 0 < eps / (5 * Rabs l)). + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption + | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; + [ prove_sup0 | apply Rabs_pos_lt; assumption ] ]. + elim (u _ H5); clear u; intros N2 H6; assert (H7 := RinvN_cv); + unfold Un_cv in H7; elim (H7 _ H5); clear H7 H5; intros N3 H5; + unfold R_dist in H3, H4, H5, H6; set (N := max (max N0 N1) (max N2 N3)). + assert (H7 : forall n:nat, (n >= N1)%nat -> RinvN n < eps / 5). + intros; replace (pos (RinvN n)) with (Rabs (RinvN n - 0)); + [ unfold RinvN in |- *; apply H4; assumption + | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; + left; apply (cond_pos (RinvN n)) ]. + clear H4; assert (H4 := H7); clear H7; + assert (H7 : forall n:nat, (n >= N3)%nat -> RinvN n < eps / (5 * Rabs l)). + intros; replace (pos (RinvN n)) with (Rabs (RinvN n - 0)); + [ unfold RinvN in |- *; apply H5; assumption + | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; + left; apply (cond_pos (RinvN n)) ]. + clear H5; assert (H5 := H7); clear H7; exists N; intros; + unfold R_dist in |- *. + apply Rle_lt_trans with + (Rabs + (RiemannInt_SF (phi_sequence RinvN pr3 n) - + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + l * RiemannInt_SF (phi_sequence RinvN pr2 n))) + + Rabs (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0) + + Rabs l * Rabs (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)). + apply Rle_trans with + (Rabs + (RiemannInt_SF (phi_sequence RinvN pr3 n) - + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + l * RiemannInt_SF (phi_sequence RinvN pr2 n))) + + Rabs + (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0 + + l * (RiemannInt_SF (phi_sequence RinvN pr2 n) - x))). + replace (RiemannInt_SF (phi_sequence RinvN pr3 n) - (x0 + l * x)) with (RiemannInt_SF (phi_sequence RinvN pr3 n) - - (RiemannInt_SF (phi_sequence RinvN pr1 n) + - l * RiemannInt_SF (phi_sequence RinvN pr2 n))) with - (RiemannInt_SF (phi_sequence RinvN pr3 n) + - -1 * - (RiemannInt_SF (phi_sequence RinvN pr1 n) + - l * RiemannInt_SF (phi_sequence RinvN pr2 n))); - [ idtac | ring ]; do 2 rewrite <- StepFun_P30; assert (H10 : Rmin a b = a). -unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n0; assumption ]. -assert (H11 : Rmax a b = b). -unfold Rmax in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n0; assumption ]. -rewrite H10 in H7; rewrite H10 in H8; rewrite H10 in H9; rewrite H11 in H7; - rewrite H11 in H8; rewrite H11 in H9; - apply Rle_lt_trans with - (RiemannInt_SF - (mkStepFun - (StepFun_P32 - (mkStepFun - (StepFun_P28 (-1) (phi_sequence RinvN pr3 n) - (mkStepFun + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + l * RiemannInt_SF (phi_sequence RinvN pr2 n)) + + (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0 + + l * (RiemannInt_SF (phi_sequence RinvN pr2 n) - x))); + [ apply Rabs_triang | ring ]. + rewrite Rplus_assoc; apply Rplus_le_compat_l; rewrite <- Rabs_mult; + replace + (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0 + + l * (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)) with + (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0 + + l * (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)); + [ apply Rabs_triang | ring ]. + replace eps with (3 * (eps / 5) + eps / 5 + eps / 5). + repeat apply Rplus_lt_compat. + assert + (H7 : + exists psi1 : nat -> StepFun a b, + (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (f t - phi_sequence RinvN pr1 n t) <= psi1 n t) /\ + Rabs (RiemannInt_SF (psi1 n)) < RinvN n)). + split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr1 n0)). + assert + (H8 : + exists psi2 : nat -> StepFun a b, + (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (g t - phi_sequence RinvN pr2 n t) <= psi2 n t) /\ + Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). + split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr2 n0)). + assert + (H9 : + exists psi3 : nat -> StepFun a b, + (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (f t + l * g t - phi_sequence RinvN pr3 n t) <= psi3 n t) /\ + Rabs (RiemannInt_SF (psi3 n)) < RinvN n)). + split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr3 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr3 n0)). + elim H7; clear H7; intros psi1 H7; elim H8; clear H8; intros psi2 H8; elim H9; + clear H9; intros psi3 H9; + replace + (RiemannInt_SF (phi_sequence RinvN pr3 n) - + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + l * RiemannInt_SF (phi_sequence RinvN pr2 n))) with + (RiemannInt_SF (phi_sequence RinvN pr3 n) + + -1 * + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + l * RiemannInt_SF (phi_sequence RinvN pr2 n))); + [ idtac | ring ]; do 2 rewrite <- StepFun_P30; assert (H10 : Rmin a b = a). + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. + assert (H11 : Rmax a b = b). + unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. + rewrite H10 in H7; rewrite H10 in H8; rewrite H10 in H9; rewrite H11 in H7; + rewrite H11 in H8; rewrite H11 in H9; + apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P32 + (mkStepFun + (StepFun_P28 (-1) (phi_sequence RinvN pr3 n) + (mkStepFun (StepFun_P28 l (phi_sequence RinvN pr1 n) - (phi_sequence RinvN pr2 n)))))))). -apply StepFun_P34; assumption. -apply Rle_lt_trans with - (RiemannInt_SF - (mkStepFun - (StepFun_P28 1 (psi3 n) + (phi_sequence RinvN pr2 n)))))))). + apply StepFun_P34; assumption. + apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P28 1 (psi3 n) (mkStepFun (StepFun_P28 (Rabs l) (psi1 n) (psi2 n)))))). -apply StepFun_P37; try assumption. -intros; simpl in |- *; rewrite Rmult_1_l. -apply Rle_trans with - (Rabs (phi_sequence RinvN pr3 n x1 - (f x1 + l * g x1)) + - Rabs + apply StepFun_P37; try assumption. + intros; simpl in |- *; rewrite Rmult_1_l. + apply Rle_trans with + (Rabs (phi_sequence RinvN pr3 n x1 - (f x1 + l * g x1)) + + Rabs + (f x1 + l * g x1 + + -1 * (phi_sequence RinvN pr1 n x1 + l * phi_sequence RinvN pr2 n x1))). + replace + (phi_sequence RinvN pr3 n x1 + + -1 * (phi_sequence RinvN pr1 n x1 + l * phi_sequence RinvN pr2 n x1)) with + (phi_sequence RinvN pr3 n x1 - (f x1 + l * g x1) + (f x1 + l * g x1 + - -1 * (phi_sequence RinvN pr1 n x1 + l * phi_sequence RinvN pr2 n x1))). -replace - (phi_sequence RinvN pr3 n x1 + - -1 * (phi_sequence RinvN pr1 n x1 + l * phi_sequence RinvN pr2 n x1)) with - (phi_sequence RinvN pr3 n x1 - (f x1 + l * g x1) + - (f x1 + l * g x1 + - -1 * (phi_sequence RinvN pr1 n x1 + l * phi_sequence RinvN pr2 n x1))); - [ apply Rabs_triang | ring ]. -rewrite Rplus_assoc; apply Rplus_le_compat. -elim (H9 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; - apply H13. -elim H12; intros; split; left; assumption. -apply Rle_trans with - (Rabs (f x1 - phi_sequence RinvN pr1 n x1) + - Rabs l * Rabs (g x1 - phi_sequence RinvN pr2 n x1)). -rewrite <- Rabs_mult; - replace - (f x1 + - (l * g x1 + - -1 * (phi_sequence RinvN pr1 n x1 + l * phi_sequence RinvN pr2 n x1))) - with - (f x1 - phi_sequence RinvN pr1 n x1 + - l * (g x1 - phi_sequence RinvN pr2 n x1)); [ apply Rabs_triang | ring ]. -apply Rplus_le_compat. -elim (H7 n); intros; apply H13. -elim H12; intros; split; left; assumption. -apply Rmult_le_compat_l; - [ apply Rabs_pos - | elim (H8 n); intros; apply H13; elim H12; intros; split; left; assumption ]. -do 2 rewrite StepFun_P30; rewrite Rmult_1_l; - replace (3 * (eps / 5)) with (eps / 5 + (eps / 5 + eps / 5)); - [ repeat apply Rplus_lt_compat | ring ]. -apply Rlt_trans with (pos (RinvN n)); - [ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi3 n))); - [ apply RRle_abs | elim (H9 n); intros; assumption ] - | apply H4; unfold ge in |- *; apply le_trans with N; - [ apply le_trans with (max N0 N1); - [ apply le_max_r | unfold N in |- *; apply le_max_l ] - | assumption ] ]. -apply Rlt_trans with (pos (RinvN n)); - [ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))); - [ apply RRle_abs | elim (H7 n); intros; assumption ] - | apply H4; unfold ge in |- *; apply le_trans with N; - [ apply le_trans with (max N0 N1); - [ apply le_max_r | unfold N in |- *; apply le_max_l ] - | assumption ] ]. -apply Rmult_lt_reg_l with (/ Rabs l). -apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. -rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_l; replace (/ Rabs l * (eps / 5)) with (eps / (5 * Rabs l)). -apply Rlt_trans with (pos (RinvN n)); - [ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))); - [ apply RRle_abs | elim (H8 n); intros; assumption ] - | apply H5; unfold ge in |- *; apply le_trans with N; - [ apply le_trans with (max N2 N3); - [ apply le_max_r | unfold N in |- *; apply le_max_r ] - | assumption ] ]. -unfold Rdiv in |- *; rewrite Rinv_mult_distr; - [ ring | discrR | apply Rabs_no_R0; assumption ]. -apply Rabs_no_R0; assumption. -apply H3; unfold ge in |- *; apply le_trans with (max N0 N1); - [ apply le_max_l - | apply le_trans with N; [ unfold N in |- *; apply le_max_l | assumption ] ]. -apply Rmult_lt_reg_l with (/ Rabs l). -apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. -rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_l; replace (/ Rabs l * (eps / 5)) with (eps / (5 * Rabs l)). -apply H6; unfold ge in |- *; apply le_trans with (max N2 N3); - [ apply le_max_l - | apply le_trans with N; [ unfold N in |- *; apply le_max_r | assumption ] ]. -unfold Rdiv in |- *; rewrite Rinv_mult_distr; - [ ring | discrR | apply Rabs_no_R0; assumption ]. -apply Rabs_no_R0; assumption. -apply Rmult_eq_reg_l with 5; - [ unfold Rdiv in |- *; do 2 rewrite Rmult_plus_distr_l; - do 3 rewrite (Rmult_comm 5); repeat rewrite Rmult_assoc; - rewrite <- Rinv_l_sym; [ ring | discrR ] - | discrR ]. + -1 * (phi_sequence RinvN pr1 n x1 + l * phi_sequence RinvN pr2 n x1))); + [ apply Rabs_triang | ring ]. + rewrite Rplus_assoc; apply Rplus_le_compat. + elim (H9 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; + apply H13. + elim H12; intros; split; left; assumption. + apply Rle_trans with + (Rabs (f x1 - phi_sequence RinvN pr1 n x1) + + Rabs l * Rabs (g x1 - phi_sequence RinvN pr2 n x1)). + rewrite <- Rabs_mult; + replace + (f x1 + + (l * g x1 + + -1 * (phi_sequence RinvN pr1 n x1 + l * phi_sequence RinvN pr2 n x1))) + with + (f x1 - phi_sequence RinvN pr1 n x1 + + l * (g x1 - phi_sequence RinvN pr2 n x1)); [ apply Rabs_triang | ring ]. + apply Rplus_le_compat. + elim (H7 n); intros; apply H13. + elim H12; intros; split; left; assumption. + apply Rmult_le_compat_l; + [ apply Rabs_pos + | elim (H8 n); intros; apply H13; elim H12; intros; split; left; assumption ]. + do 2 rewrite StepFun_P30; rewrite Rmult_1_l; + replace (3 * (eps / 5)) with (eps / 5 + (eps / 5 + eps / 5)); + [ repeat apply Rplus_lt_compat | ring ]. + apply Rlt_trans with (pos (RinvN n)); + [ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi3 n))); + [ apply RRle_abs | elim (H9 n); intros; assumption ] + | apply H4; unfold ge in |- *; apply le_trans with N; + [ apply le_trans with (max N0 N1); + [ apply le_max_r | unfold N in |- *; apply le_max_l ] + | assumption ] ]. + apply Rlt_trans with (pos (RinvN n)); + [ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))); + [ apply RRle_abs | elim (H7 n); intros; assumption ] + | apply H4; unfold ge in |- *; apply le_trans with N; + [ apply le_trans with (max N0 N1); + [ apply le_max_r | unfold N in |- *; apply le_max_l ] + | assumption ] ]. + apply Rmult_lt_reg_l with (/ Rabs l). + apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. + rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_l; replace (/ Rabs l * (eps / 5)) with (eps / (5 * Rabs l)). + apply Rlt_trans with (pos (RinvN n)); + [ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))); + [ apply RRle_abs | elim (H8 n); intros; assumption ] + | apply H5; unfold ge in |- *; apply le_trans with N; + [ apply le_trans with (max N2 N3); + [ apply le_max_r | unfold N in |- *; apply le_max_r ] + | assumption ] ]. + unfold Rdiv in |- *; rewrite Rinv_mult_distr; + [ ring | discrR | apply Rabs_no_R0; assumption ]. + apply Rabs_no_R0; assumption. + apply H3; unfold ge in |- *; apply le_trans with (max N0 N1); + [ apply le_max_l + | apply le_trans with N; [ unfold N in |- *; apply le_max_l | assumption ] ]. + apply Rmult_lt_reg_l with (/ Rabs l). + apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. + rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_l; replace (/ Rabs l * (eps / 5)) with (eps / (5 * Rabs l)). + apply H6; unfold ge in |- *; apply le_trans with (max N2 N3); + [ apply le_max_l + | apply le_trans with N; [ unfold N in |- *; apply le_max_r | assumption ] ]. + unfold Rdiv in |- *; rewrite Rinv_mult_distr; + [ ring | discrR | apply Rabs_no_R0; assumption ]. + apply Rabs_no_R0; assumption. + apply Rmult_eq_reg_l with 5; + [ unfold Rdiv in |- *; do 2 rewrite Rmult_plus_distr_l; + do 3 rewrite (Rmult_comm 5); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ ring | discrR ] + | discrR ]. Qed. Lemma RiemannInt_P13 : - forall (f g:R -> R) (a b l:R) (pr1:Riemann_integrable f a b) - (pr2:Riemann_integrable g a b) - (pr3:Riemann_integrable (fun x:R => f x + l * g x) a b), - RiemannInt pr3 = RiemannInt pr1 + l * RiemannInt pr2. -intros; case (Rle_dec a b); intro; - [ apply RiemannInt_P12; assumption - | assert (H : b <= a); - [ auto with real - | replace (RiemannInt pr3) with (- RiemannInt (RiemannInt_P1 pr3)); - [ idtac | symmetry in |- *; apply RiemannInt_P8 ]; - replace (RiemannInt pr2) with (- RiemannInt (RiemannInt_P1 pr2)); - [ idtac | symmetry in |- *; apply RiemannInt_P8 ]; - replace (RiemannInt pr1) with (- RiemannInt (RiemannInt_P1 pr1)); - [ idtac | symmetry in |- *; apply RiemannInt_P8 ]; - rewrite - (RiemannInt_P12 (RiemannInt_P1 pr1) (RiemannInt_P1 pr2) - (RiemannInt_P1 pr3) H); ring ] ]. + forall (f g:R -> R) (a b l:R) (pr1:Riemann_integrable f a b) + (pr2:Riemann_integrable g a b) + (pr3:Riemann_integrable (fun x:R => f x + l * g x) a b), + RiemannInt pr3 = RiemannInt pr1 + l * RiemannInt pr2. +Proof. + intros; case (Rle_dec a b); intro; + [ apply RiemannInt_P12; assumption + | assert (H : b <= a); + [ auto with real + | replace (RiemannInt pr3) with (- RiemannInt (RiemannInt_P1 pr3)); + [ idtac | symmetry in |- *; apply RiemannInt_P8 ]; + replace (RiemannInt pr2) with (- RiemannInt (RiemannInt_P1 pr2)); + [ idtac | symmetry in |- *; apply RiemannInt_P8 ]; + replace (RiemannInt pr1) with (- RiemannInt (RiemannInt_P1 pr1)); + [ idtac | symmetry in |- *; apply RiemannInt_P8 ]; + rewrite + (RiemannInt_P12 (RiemannInt_P1 pr1) (RiemannInt_P1 pr2) + (RiemannInt_P1 pr3) H); ring ] ]. Qed. Lemma RiemannInt_P14 : forall a b c:R, Riemann_integrable (fct_cte c) a b. -unfold Riemann_integrable in |- *; intros; - split with (mkStepFun (StepFun_P4 a b c)); - split with (mkStepFun (StepFun_P4 a b 0)); split; - [ intros; simpl in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; - rewrite Rabs_R0; unfold fct_cte in |- *; right; - reflexivity - | rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0; - apply (cond_pos eps) ]. +Proof. + unfold Riemann_integrable in |- *; intros; + split with (mkStepFun (StepFun_P4 a b c)); + split with (mkStepFun (StepFun_P4 a b 0)); split; + [ intros; simpl in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; unfold fct_cte in |- *; right; + reflexivity + | rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0; + apply (cond_pos eps) ]. Qed. Lemma RiemannInt_P15 : - forall (a b c:R) (pr:Riemann_integrable (fct_cte c) a b), - RiemannInt pr = c * (b - a). -intros; unfold RiemannInt in |- *; case (RiemannInt_exists pr RinvN RinvN_cv); - intros; eapply UL_sequence. -apply u. -set (phi1 := fun N:nat => phi_sequence RinvN pr N); - change (Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) (c * (b - a))) in |- *; - set (f := fct_cte c); - assert - (H1 : - exists psi1 : nat -> StepFun a b, - (forall n:nat, - (forall t:R, - Rmin a b <= t /\ t <= Rmax a b -> - Rabs (f t - phi_sequence RinvN pr n t) <= psi1 n t) /\ - Rabs (RiemannInt_SF (psi1 n)) < RinvN n)). -split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr n)); intro; - apply (projT2 (phi_sequence_prop RinvN pr n)). -elim H1; clear H1; intros psi1 H1; - set (phi2 := fun n:nat => mkStepFun (StepFun_P4 a b c)); - set (psi2 := fun n:nat => mkStepFun (StepFun_P4 a b 0)); - apply RiemannInt_P11 with f RinvN phi2 psi2 psi1; - try assumption. -apply RinvN_cv. -intro; split. -intros; unfold f in |- *; simpl in |- *; unfold Rminus in |- *; - rewrite Rplus_opp_r; rewrite Rabs_R0; unfold fct_cte in |- *; - right; reflexivity. -unfold psi2 in |- *; rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0; - apply (cond_pos (RinvN n)). -unfold Un_cv in |- *; intros; split with 0%nat; intros; unfold R_dist in |- *; - unfold phi2 in |- *; rewrite StepFun_P18; unfold Rminus in |- *; - rewrite Rplus_opp_r; rewrite Rabs_R0; apply H. + forall (a b c:R) (pr:Riemann_integrable (fct_cte c) a b), + RiemannInt pr = c * (b - a). +Proof. + intros; unfold RiemannInt in |- *; case (RiemannInt_exists pr RinvN RinvN_cv); + intros; eapply UL_sequence. + apply u. + set (phi1 := fun N:nat => phi_sequence RinvN pr N); + change (Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) (c * (b - a))) in |- *; + set (f := fct_cte c); + assert + (H1 : + exists psi1 : nat -> StepFun a b, + (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (f t - phi_sequence RinvN pr n t) <= psi1 n t) /\ + Rabs (RiemannInt_SF (psi1 n)) < RinvN n)). + split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr n)). + elim H1; clear H1; intros psi1 H1; + set (phi2 := fun n:nat => mkStepFun (StepFun_P4 a b c)); + set (psi2 := fun n:nat => mkStepFun (StepFun_P4 a b 0)); + apply RiemannInt_P11 with f RinvN phi2 psi2 psi1; + try assumption. + apply RinvN_cv. + intro; split. + intros; unfold f in |- *; simpl in |- *; unfold Rminus in |- *; + rewrite Rplus_opp_r; rewrite Rabs_R0; unfold fct_cte in |- *; + right; reflexivity. + unfold psi2 in |- *; rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0; + apply (cond_pos (RinvN n)). + unfold Un_cv in |- *; intros; split with 0%nat; intros; unfold R_dist in |- *; + unfold phi2 in |- *; rewrite StepFun_P18; unfold Rminus in |- *; + rewrite Rplus_opp_r; rewrite Rabs_R0; apply H. Qed. Lemma RiemannInt_P16 : - forall (f:R -> R) (a b:R), - Riemann_integrable f a b -> Riemann_integrable (fun x:R => Rabs (f x)) a b. -unfold Riemann_integrable in |- *; intro f; intros; elim (X eps); clear X; - intros phi [psi [H H0]]; split with (mkStepFun (StepFun_P32 phi)); - split with psi; split; try assumption; intros; simpl in |- *; - apply Rle_trans with (Rabs (f t - phi t)); - [ apply Rabs_triang_inv2 | apply H; assumption ]. + forall (f:R -> R) (a b:R), + Riemann_integrable f a b -> Riemann_integrable (fun x:R => Rabs (f x)) a b. +Proof. + unfold Riemann_integrable in |- *; intro f; intros; elim (X eps); clear X; + intros phi [psi [H H0]]; split with (mkStepFun (StepFun_P32 phi)); + split with psi; split; try assumption; intros; simpl in |- *; + apply Rle_trans with (Rabs (f t - phi t)); + [ apply Rabs_triang_inv2 | apply H; assumption ]. Qed. Lemma Rle_cv_lim : - forall (Un Vn:nat -> R) (l1 l2:R), - (forall n:nat, Un n <= Vn n) -> Un_cv Un l1 -> Un_cv Vn l2 -> l1 <= l2. -intros; case (Rle_dec l1 l2); intro. -assumption. -assert (H2 : l2 < l1). -auto with real. -clear n; assert (H3 : 0 < (l1 - l2) / 2). -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ apply Rlt_Rminus; assumption | apply Rinv_0_lt_compat; prove_sup0 ]. -elim (H1 _ H3); elim (H0 _ H3); clear H0 H1; unfold R_dist in |- *; intros; - set (N := max x x0); cut (Vn N < Un N). -intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (H N) H4)). -apply Rlt_trans with ((l1 + l2) / 2). -apply Rplus_lt_reg_r with (- l2); - replace (- l2 + (l1 + l2) / 2) with ((l1 - l2) / 2). -rewrite Rplus_comm; apply Rle_lt_trans with (Rabs (Vn N - l2)). -apply RRle_abs. -apply H1; unfold ge in |- *; unfold N in |- *; apply le_max_r. -apply Rmult_eq_reg_l with 2; - [ unfold Rdiv in |- *; do 2 rewrite (Rmult_comm 2); - rewrite (Rmult_plus_distr_r (- l2) ((l1 + l2) * / 2) 2); - repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym; - [ ring | discrR ] - | discrR ]. -apply Ropp_lt_cancel; apply Rplus_lt_reg_r with l1; - replace (l1 + - ((l1 + l2) / 2)) with ((l1 - l2) / 2). -apply Rle_lt_trans with (Rabs (Un N - l1)). -rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs. -apply H0; unfold ge in |- *; unfold N in |- *; apply le_max_l. -apply Rmult_eq_reg_l with 2; - [ unfold Rdiv in |- *; do 2 rewrite (Rmult_comm 2); - rewrite (Rmult_plus_distr_r l1 (- ((l1 + l2) * / 2)) 2); - rewrite <- Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc; - rewrite <- Rinv_l_sym; [ ring | discrR ] - | discrR ]. + forall (Un Vn:nat -> R) (l1 l2:R), + (forall n:nat, Un n <= Vn n) -> Un_cv Un l1 -> Un_cv Vn l2 -> l1 <= l2. +Proof. + intros; case (Rle_dec l1 l2); intro. + assumption. + assert (H2 : l2 < l1). + auto with real. + clear n; assert (H3 : 0 < (l1 - l2) / 2). + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply Rlt_Rminus; assumption | apply Rinv_0_lt_compat; prove_sup0 ]. + elim (H1 _ H3); elim (H0 _ H3); clear H0 H1; unfold R_dist in |- *; intros; + set (N := max x x0); cut (Vn N < Un N). + intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (H N) H4)). + apply Rlt_trans with ((l1 + l2) / 2). + apply Rplus_lt_reg_r with (- l2); + replace (- l2 + (l1 + l2) / 2) with ((l1 - l2) / 2). + rewrite Rplus_comm; apply Rle_lt_trans with (Rabs (Vn N - l2)). + apply RRle_abs. + apply H1; unfold ge in |- *; unfold N in |- *; apply le_max_r. + apply Rmult_eq_reg_l with 2; + [ unfold Rdiv in |- *; do 2 rewrite (Rmult_comm 2); + rewrite (Rmult_plus_distr_r (- l2) ((l1 + l2) * / 2) 2); + repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym; + [ ring | discrR ] + | discrR ]. + apply Ropp_lt_cancel; apply Rplus_lt_reg_r with l1; + replace (l1 + - ((l1 + l2) / 2)) with ((l1 - l2) / 2). + apply Rle_lt_trans with (Rabs (Un N - l1)). + rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs. + apply H0; unfold ge in |- *; unfold N in |- *; apply le_max_l. + apply Rmult_eq_reg_l with 2; + [ unfold Rdiv in |- *; do 2 rewrite (Rmult_comm 2); + rewrite (Rmult_plus_distr_r l1 (- ((l1 + l2) * / 2)) 2); + rewrite <- Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ ring | discrR ] + | discrR ]. Qed. Lemma RiemannInt_P17 : - forall (f:R -> R) (a b:R) (pr1:Riemann_integrable f a b) - (pr2:Riemann_integrable (fun x:R => Rabs (f x)) a b), - a <= b -> Rabs (RiemannInt pr1) <= RiemannInt pr2. -intro f; intros; unfold RiemannInt in |- *; - case (RiemannInt_exists pr1 RinvN RinvN_cv); - case (RiemannInt_exists pr2 RinvN RinvN_cv); intros; - set (phi1 := phi_sequence RinvN pr1) in u0; - set (phi2 := fun N:nat => mkStepFun (StepFun_P32 (phi1 N))); - apply Rle_cv_lim with - (fun N:nat => Rabs (RiemannInt_SF (phi1 N))) - (fun N:nat => RiemannInt_SF (phi2 N)). -intro; unfold phi2 in |- *; apply StepFun_P34; assumption. - apply (continuity_seq Rabs (fun N:nat => RiemannInt_SF (phi1 N)) x0); - try assumption. -apply Rcontinuity_abs. -set (phi3 := phi_sequence RinvN pr2); - assert - (H0 : - exists psi3 : nat -> StepFun a b, - (forall n:nat, - (forall t:R, - Rmin a b <= t /\ t <= Rmax a b -> - Rabs (Rabs (f t) - phi3 n t) <= psi3 n t) /\ - Rabs (RiemannInt_SF (psi3 n)) < RinvN n)). -split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro; - apply (projT2 (phi_sequence_prop RinvN pr2 n)). -assert - (H1 : - exists psi2 : nat -> StepFun a b, - (forall n:nat, - (forall t:R, - Rmin a b <= t /\ t <= Rmax a b -> - Rabs (Rabs (f t) - phi2 n t) <= psi2 n t) /\ - Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). -assert - (H1 : - exists psi2 : nat -> StepFun a b, - (forall n:nat, - (forall t:R, - Rmin a b <= t /\ t <= Rmax a b -> Rabs (f t - phi1 n t) <= psi2 n t) /\ - Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). -split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro; - apply (projT2 (phi_sequence_prop RinvN pr1 n)). -elim H1; clear H1; intros psi2 H1; split with psi2; intros; elim (H1 n); - clear H1; intros; split; try assumption. -intros; unfold phi2 in |- *; simpl in |- *; - apply Rle_trans with (Rabs (f t - phi1 n t)). -apply Rabs_triang_inv2. -apply H1; assumption. -elim H0; clear H0; intros psi3 H0; elim H1; clear H1; intros psi2 H1; - apply RiemannInt_P11 with (fun x:R => Rabs (f x)) RinvN phi3 psi3 psi2; - try assumption; apply RinvN_cv. + forall (f:R -> R) (a b:R) (pr1:Riemann_integrable f a b) + (pr2:Riemann_integrable (fun x:R => Rabs (f x)) a b), + a <= b -> Rabs (RiemannInt pr1) <= RiemannInt pr2. +Proof. + intro f; intros; unfold RiemannInt in |- *; + case (RiemannInt_exists pr1 RinvN RinvN_cv); + case (RiemannInt_exists pr2 RinvN RinvN_cv); intros; + set (phi1 := phi_sequence RinvN pr1) in u0; + set (phi2 := fun N:nat => mkStepFun (StepFun_P32 (phi1 N))); + apply Rle_cv_lim with + (fun N:nat => Rabs (RiemannInt_SF (phi1 N))) + (fun N:nat => RiemannInt_SF (phi2 N)). + intro; unfold phi2 in |- *; apply StepFun_P34; assumption. + apply (continuity_seq Rabs (fun N:nat => RiemannInt_SF (phi1 N)) x0); + try assumption. + apply Rcontinuity_abs. + set (phi3 := phi_sequence RinvN pr2); + assert + (H0 : + exists psi3 : nat -> StepFun a b, + (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (Rabs (f t) - phi3 n t) <= psi3 n t) /\ + Rabs (RiemannInt_SF (psi3 n)) < RinvN n)). + split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr2 n)). + assert + (H1 : + exists psi2 : nat -> StepFun a b, + (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (Rabs (f t) - phi2 n t) <= psi2 n t) /\ + Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). + assert + (H1 : + exists psi2 : nat -> StepFun a b, + (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> Rabs (f t - phi1 n t) <= psi2 n t) /\ + Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). + split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr1 n)). + elim H1; clear H1; intros psi2 H1; split with psi2; intros; elim (H1 n); + clear H1; intros; split; try assumption. + intros; unfold phi2 in |- *; simpl in |- *; + apply Rle_trans with (Rabs (f t - phi1 n t)). + apply Rabs_triang_inv2. + apply H1; assumption. + elim H0; clear H0; intros psi3 H0; elim H1; clear H1; intros psi2 H1; + apply RiemannInt_P11 with (fun x:R => Rabs (f x)) RinvN phi3 psi3 psi2; + try assumption; apply RinvN_cv. Qed. Lemma RiemannInt_P18 : - forall (f g:R -> R) (a b:R) (pr1:Riemann_integrable f a b) - (pr2:Riemann_integrable g a b), - a <= b -> - (forall x:R, a < x < b -> f x = g x) -> RiemannInt pr1 = RiemannInt pr2. -intro f; intros; unfold RiemannInt in |- *; - case (RiemannInt_exists pr1 RinvN RinvN_cv); - case (RiemannInt_exists pr2 RinvN RinvN_cv); intros; - eapply UL_sequence. -apply u0. -set (phi1 := fun N:nat => phi_sequence RinvN pr1 N); - change (Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) x) in |- *; - assert - (H1 : - exists psi1 : nat -> StepFun a b, - (forall n:nat, - (forall t:R, - Rmin a b <= t /\ t <= Rmax a b -> - Rabs (f t - phi1 n t) <= psi1 n t) /\ - Rabs (RiemannInt_SF (psi1 n)) < RinvN n)). -split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro; - apply (projT2 (phi_sequence_prop RinvN pr1 n)). -elim H1; clear H1; intros psi1 H1; - set (phi2 := fun N:nat => phi_sequence RinvN pr2 N). -set - (phi2_aux := - fun (N:nat) (x:R) => - match Req_EM_T x a with - | left _ => f a - | right _ => - match Req_EM_T x b with - | left _ => f b - | right _ => phi2 N x - end - end). -cut (forall N:nat, IsStepFun (phi2_aux N) a b). -intro; set (phi2_m := fun N:nat => mkStepFun (X N)). -assert - (H2 : - exists psi2 : nat -> StepFun a b, - (forall n:nat, - (forall t:R, - Rmin a b <= t /\ t <= Rmax a b -> Rabs (g t - phi2 n t) <= psi2 n t) /\ - Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). -split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro; - apply (projT2 (phi_sequence_prop RinvN pr2 n)). -elim H2; clear H2; intros psi2 H2; - apply RiemannInt_P11 with f RinvN phi2_m psi2 psi1; - try assumption. -apply RinvN_cv. -intro; elim (H2 n); intros; split; try assumption. -intros; unfold phi2_m in |- *; simpl in |- *; unfold phi2_aux in |- *; - case (Req_EM_T t a); case (Req_EM_T t b); intros. -rewrite e0; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; - apply Rle_trans with (Rabs (g t - phi2 n t)). -apply Rabs_pos. -pattern a at 3 in |- *; rewrite <- e0; apply H3; assumption. -rewrite e; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; - apply Rle_trans with (Rabs (g t - phi2 n t)). -apply Rabs_pos. -pattern a at 3 in |- *; rewrite <- e; apply H3; assumption. -rewrite e; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; - apply Rle_trans with (Rabs (g t - phi2 n t)). -apply Rabs_pos. -pattern b at 3 in |- *; rewrite <- e; apply H3; assumption. -replace (f t) with (g t). -apply H3; assumption. -symmetry in |- *; apply H0; elim H5; clear H5; intros. -assert (H7 : Rmin a b = a). -unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n2; assumption ]. -assert (H8 : Rmax a b = b). -unfold Rmax in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n2; assumption ]. -rewrite H7 in H5; rewrite H8 in H6; split. -elim H5; intro; [ assumption | elim n1; symmetry in |- *; assumption ]. -elim H6; intro; [ assumption | elim n0; assumption ]. -cut (forall N:nat, RiemannInt_SF (phi2_m N) = RiemannInt_SF (phi2 N)). -intro; unfold Un_cv in |- *; intros; elim (u _ H4); intros; exists x1; intros; - rewrite (H3 n); apply H5; assumption. -intro; apply Rle_antisym. -apply StepFun_P37; try assumption. -intros; unfold phi2_m in |- *; simpl in |- *; unfold phi2_aux in |- *; - case (Req_EM_T x1 a); case (Req_EM_T x1 b); intros. -elim H3; intros; rewrite e0 in H4; elim (Rlt_irrefl _ H4). -elim H3; intros; rewrite e in H4; elim (Rlt_irrefl _ H4). -elim H3; intros; rewrite e in H5; elim (Rlt_irrefl _ H5). -right; reflexivity. -apply StepFun_P37; try assumption. -intros; unfold phi2_m in |- *; simpl in |- *; unfold phi2_aux in |- *; - case (Req_EM_T x1 a); case (Req_EM_T x1 b); intros. -elim H3; intros; rewrite e0 in H4; elim (Rlt_irrefl _ H4). -elim H3; intros; rewrite e in H4; elim (Rlt_irrefl _ H4). -elim H3; intros; rewrite e in H5; elim (Rlt_irrefl _ H5). -right; reflexivity. -intro; assert (H2 := pre (phi2 N)); unfold IsStepFun in H2; - unfold is_subdivision in H2; elim H2; clear H2; intros l [lf H2]; - split with l; split with lf; unfold adapted_couple in H2; - decompose [and] H2; clear H2; unfold adapted_couple in |- *; - repeat split; try assumption. -intros; assert (H9 := H8 i H2); unfold constant_D_eq, open_interval in H9; - unfold constant_D_eq, open_interval in |- *; intros; - rewrite <- (H9 x1 H7); assert (H10 : a <= pos_Rl l i). -replace a with (Rmin a b). -rewrite <- H5; elim (RList_P6 l); intros; apply H10. -assumption. -apply le_O_n. -apply lt_trans with (pred (Rlength l)); [ assumption | apply lt_pred_n_n ]. -apply neq_O_lt; intro; rewrite <- H12 in H6; discriminate. -unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ]. -assert (H11 : pos_Rl l (S i) <= b). -replace b with (Rmax a b). -rewrite <- H4; elim (RList_P6 l); intros; apply H11. -assumption. -apply lt_le_S; assumption. -apply lt_pred_n_n; apply neq_O_lt; intro; rewrite <- H13 in H6; discriminate. -unfold Rmax in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ]. -elim H7; clear H7; intros; unfold phi2_aux in |- *; case (Req_EM_T x1 a); - case (Req_EM_T x1 b); intros. -rewrite e in H12; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H12)). -rewrite e in H7; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H10 H7)). -rewrite e in H12; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H12)). -reflexivity. + forall (f g:R -> R) (a b:R) (pr1:Riemann_integrable f a b) + (pr2:Riemann_integrable g a b), + a <= b -> + (forall x:R, a < x < b -> f x = g x) -> RiemannInt pr1 = RiemannInt pr2. +Proof. + intro f; intros; unfold RiemannInt in |- *; + case (RiemannInt_exists pr1 RinvN RinvN_cv); + case (RiemannInt_exists pr2 RinvN RinvN_cv); intros; + eapply UL_sequence. + apply u0. + set (phi1 := fun N:nat => phi_sequence RinvN pr1 N); + change (Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) x) in |- *; + assert + (H1 : + exists psi1 : nat -> StepFun a b, + (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (f t - phi1 n t) <= psi1 n t) /\ + Rabs (RiemannInt_SF (psi1 n)) < RinvN n)). + split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr1 n)). + elim H1; clear H1; intros psi1 H1; + set (phi2 := fun N:nat => phi_sequence RinvN pr2 N). + set + (phi2_aux := + fun (N:nat) (x:R) => + match Req_EM_T x a with + | left _ => f a + | right _ => + match Req_EM_T x b with + | left _ => f b + | right _ => phi2 N x + end + end). + cut (forall N:nat, IsStepFun (phi2_aux N) a b). + intro; set (phi2_m := fun N:nat => mkStepFun (X N)). + assert + (H2 : + exists psi2 : nat -> StepFun a b, + (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> Rabs (g t - phi2 n t) <= psi2 n t) /\ + Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). + split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr2 n)). + elim H2; clear H2; intros psi2 H2; + apply RiemannInt_P11 with f RinvN phi2_m psi2 psi1; + try assumption. + apply RinvN_cv. + intro; elim (H2 n); intros; split; try assumption. + intros; unfold phi2_m in |- *; simpl in |- *; unfold phi2_aux in |- *; + case (Req_EM_T t a); case (Req_EM_T t b); intros. + rewrite e0; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + apply Rle_trans with (Rabs (g t - phi2 n t)). + apply Rabs_pos. + pattern a at 3 in |- *; rewrite <- e0; apply H3; assumption. + rewrite e; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + apply Rle_trans with (Rabs (g t - phi2 n t)). + apply Rabs_pos. + pattern a at 3 in |- *; rewrite <- e; apply H3; assumption. + rewrite e; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + apply Rle_trans with (Rabs (g t - phi2 n t)). + apply Rabs_pos. + pattern b at 3 in |- *; rewrite <- e; apply H3; assumption. + replace (f t) with (g t). + apply H3; assumption. + symmetry in |- *; apply H0; elim H5; clear H5; intros. + assert (H7 : Rmin a b = a). + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n2; assumption ]. + assert (H8 : Rmax a b = b). + unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n2; assumption ]. + rewrite H7 in H5; rewrite H8 in H6; split. + elim H5; intro; [ assumption | elim n1; symmetry in |- *; assumption ]. + elim H6; intro; [ assumption | elim n0; assumption ]. + cut (forall N:nat, RiemannInt_SF (phi2_m N) = RiemannInt_SF (phi2 N)). + intro; unfold Un_cv in |- *; intros; elim (u _ H4); intros; exists x1; intros; + rewrite (H3 n); apply H5; assumption. + intro; apply Rle_antisym. + apply StepFun_P37; try assumption. + intros; unfold phi2_m in |- *; simpl in |- *; unfold phi2_aux in |- *; + case (Req_EM_T x1 a); case (Req_EM_T x1 b); intros. + elim H3; intros; rewrite e0 in H4; elim (Rlt_irrefl _ H4). + elim H3; intros; rewrite e in H4; elim (Rlt_irrefl _ H4). + elim H3; intros; rewrite e in H5; elim (Rlt_irrefl _ H5). + right; reflexivity. + apply StepFun_P37; try assumption. + intros; unfold phi2_m in |- *; simpl in |- *; unfold phi2_aux in |- *; + case (Req_EM_T x1 a); case (Req_EM_T x1 b); intros. + elim H3; intros; rewrite e0 in H4; elim (Rlt_irrefl _ H4). + elim H3; intros; rewrite e in H4; elim (Rlt_irrefl _ H4). + elim H3; intros; rewrite e in H5; elim (Rlt_irrefl _ H5). + right; reflexivity. + intro; assert (H2 := pre (phi2 N)); unfold IsStepFun in H2; + unfold is_subdivision in H2; elim H2; clear H2; intros l [lf H2]; + split with l; split with lf; unfold adapted_couple in H2; + decompose [and] H2; clear H2; unfold adapted_couple in |- *; + repeat split; try assumption. + intros; assert (H9 := H8 i H2); unfold constant_D_eq, open_interval in H9; + unfold constant_D_eq, open_interval in |- *; intros; + rewrite <- (H9 x1 H7); assert (H10 : a <= pos_Rl l i). + replace a with (Rmin a b). + rewrite <- H5; elim (RList_P6 l); intros; apply H10. + assumption. + apply le_O_n. + apply lt_trans with (pred (Rlength l)); [ assumption | apply lt_pred_n_n ]. + apply neq_O_lt; intro; rewrite <- H12 in H6; discriminate. + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. + assert (H11 : pos_Rl l (S i) <= b). + replace b with (Rmax a b). + rewrite <- H4; elim (RList_P6 l); intros; apply H11. + assumption. + apply lt_le_S; assumption. + apply lt_pred_n_n; apply neq_O_lt; intro; rewrite <- H13 in H6; discriminate. + unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. + elim H7; clear H7; intros; unfold phi2_aux in |- *; case (Req_EM_T x1 a); + case (Req_EM_T x1 b); intros. + rewrite e in H12; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H12)). + rewrite e in H7; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H10 H7)). + rewrite e in H12; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H12)). + reflexivity. Qed. Lemma RiemannInt_P19 : - forall (f g:R -> R) (a b:R) (pr1:Riemann_integrable f a b) - (pr2:Riemann_integrable g a b), - a <= b -> - (forall x:R, a < x < b -> f x <= g x) -> RiemannInt pr1 <= RiemannInt pr2. -intro f; intros; apply Rplus_le_reg_l with (- RiemannInt pr1); - rewrite Rplus_opp_l; rewrite Rplus_comm; - apply Rle_trans with (Rabs (RiemannInt (RiemannInt_P10 (-1) pr2 pr1))). -apply Rabs_pos. -replace (RiemannInt pr2 + - RiemannInt pr1) with - (RiemannInt (RiemannInt_P16 (RiemannInt_P10 (-1) pr2 pr1))). -apply - (RiemannInt_P17 (RiemannInt_P10 (-1) pr2 pr1) - (RiemannInt_P16 (RiemannInt_P10 (-1) pr2 pr1))); - assumption. -replace (RiemannInt pr2 + - RiemannInt pr1) with - (RiemannInt (RiemannInt_P10 (-1) pr2 pr1)). -apply RiemannInt_P18; try assumption. -intros; apply Rabs_right. -apply Rle_ge; apply Rplus_le_reg_l with (f x); rewrite Rplus_0_r; - replace (f x + (g x + -1 * f x)) with (g x); [ apply H0; assumption | ring ]. -rewrite (RiemannInt_P12 pr2 pr1 (RiemannInt_P10 (-1) pr2 pr1)); - [ ring | assumption ]. + forall (f g:R -> R) (a b:R) (pr1:Riemann_integrable f a b) + (pr2:Riemann_integrable g a b), + a <= b -> + (forall x:R, a < x < b -> f x <= g x) -> RiemannInt pr1 <= RiemannInt pr2. +Proof. + intro f; intros; apply Rplus_le_reg_l with (- RiemannInt pr1); + rewrite Rplus_opp_l; rewrite Rplus_comm; + apply Rle_trans with (Rabs (RiemannInt (RiemannInt_P10 (-1) pr2 pr1))). + apply Rabs_pos. + replace (RiemannInt pr2 + - RiemannInt pr1) with + (RiemannInt (RiemannInt_P16 (RiemannInt_P10 (-1) pr2 pr1))). + apply + (RiemannInt_P17 (RiemannInt_P10 (-1) pr2 pr1) + (RiemannInt_P16 (RiemannInt_P10 (-1) pr2 pr1))); + assumption. + replace (RiemannInt pr2 + - RiemannInt pr1) with + (RiemannInt (RiemannInt_P10 (-1) pr2 pr1)). + apply RiemannInt_P18; try assumption. + intros; apply Rabs_right. + apply Rle_ge; apply Rplus_le_reg_l with (f x); rewrite Rplus_0_r; + replace (f x + (g x + -1 * f x)) with (g x); [ apply H0; assumption | ring ]. + rewrite (RiemannInt_P12 pr2 pr1 (RiemannInt_P10 (-1) pr2 pr1)); + [ ring | assumption ]. Qed. Lemma FTC_P1 : - forall (f:R -> R) (a b:R), - a <= b -> - (forall x:R, a <= x <= b -> continuity_pt f x) -> - forall x:R, a <= x -> x <= b -> Riemann_integrable f a x. -intros; apply continuity_implies_RiemannInt; - [ assumption - | intros; apply H0; elim H3; intros; split; - assumption || apply Rle_trans with x; assumption ]. + forall (f:R -> R) (a b:R), + a <= b -> + (forall x:R, a <= x <= b -> continuity_pt f x) -> + forall x:R, a <= x -> x <= b -> Riemann_integrable f a x. +Proof. + intros; apply continuity_implies_RiemannInt; + [ assumption + | intros; apply H0; elim H3; intros; split; + assumption || apply Rle_trans with x; assumption ]. Qed. Definition primitive (f:R -> R) (a b:R) (h:a <= b) (pr:forall x:R, a <= x -> x <= b -> Riemann_integrable f a x) (x:R) : R := match Rle_dec a x with - | left r => + | left r => match Rle_dec x b with - | left r0 => RiemannInt (pr x r r0) - | right _ => f b * (x - b) + RiemannInt (pr b h (Rle_refl b)) + | left r0 => RiemannInt (pr x r r0) + | right _ => f b * (x - b) + RiemannInt (pr b h (Rle_refl b)) end - | right _ => f a * (x - a) + | right _ => f a * (x - a) end. Lemma RiemannInt_P20 : - forall (f:R -> R) (a b:R) (h:a <= b) - (pr:forall x:R, a <= x -> x <= b -> Riemann_integrable f a x) - (pr0:Riemann_integrable f a b), - RiemannInt pr0 = primitive h pr b - primitive h pr a. -intros; replace (primitive h pr a) with 0. -replace (RiemannInt pr0) with (primitive h pr b). -ring. -unfold primitive in |- *; case (Rle_dec a b); case (Rle_dec b b); intros; - [ apply RiemannInt_P5 - | elim n; right; reflexivity - | elim n; assumption - | elim n0; assumption ]. -symmetry in |- *; unfold primitive in |- *; case (Rle_dec a a); - case (Rle_dec a b); intros; - [ apply RiemannInt_P9 - | elim n; assumption - | elim n; right; reflexivity - | elim n0; right; reflexivity ]. + forall (f:R -> R) (a b:R) (h:a <= b) + (pr:forall x:R, a <= x -> x <= b -> Riemann_integrable f a x) + (pr0:Riemann_integrable f a b), + RiemannInt pr0 = primitive h pr b - primitive h pr a. +Proof. + intros; replace (primitive h pr a) with 0. + replace (RiemannInt pr0) with (primitive h pr b). + ring. + unfold primitive in |- *; case (Rle_dec a b); case (Rle_dec b b); intros; + [ apply RiemannInt_P5 + | elim n; right; reflexivity + | elim n; assumption + | elim n0; assumption ]. + symmetry in |- *; unfold primitive in |- *; case (Rle_dec a a); + case (Rle_dec a b); intros; + [ apply RiemannInt_P9 + | elim n; assumption + | elim n; right; reflexivity + | elim n0; right; reflexivity ]. Qed. Lemma RiemannInt_P21 : - forall (f:R -> R) (a b c:R), - a <= b -> - b <= c -> - Riemann_integrable f a b -> - Riemann_integrable f b c -> Riemann_integrable f a c. -unfold Riemann_integrable in |- *; intros f a b c Hyp1 Hyp2 X X0 eps. -assert (H : 0 < eps / 2). -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ]. -elim (X (mkposreal _ H)); clear X; intros phi1 [psi1 H1]; - elim (X0 (mkposreal _ H)); clear X0; intros phi2 [psi2 H2]. -set - (phi3 := - fun x:R => - match Rle_dec a x with - | left _ => - match Rle_dec x b with - | left _ => phi1 x - | right _ => phi2 x - end - | right _ => 0 - end). -set - (psi3 := - fun x:R => - match Rle_dec a x with - | left _ => - match Rle_dec x b with - | left _ => psi1 x - | right _ => psi2 x - end - | right _ => 0 - end). -cut (IsStepFun phi3 a c). -intro; cut (IsStepFun psi3 a b). -intro; cut (IsStepFun psi3 b c). -intro; cut (IsStepFun psi3 a c). -intro; split with (mkStepFun X); split with (mkStepFun X2); simpl in |- *; - split. -intros; unfold phi3, psi3 in |- *; case (Rle_dec t b); case (Rle_dec a t); - intros. -elim H1; intros; apply H3. -replace (Rmin a b) with a. -replace (Rmax a b) with b. -split; assumption. -unfold Rmax in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ]. -unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ]. -elim n; replace a with (Rmin a c). -elim H0; intros; assumption. -unfold Rmin in |- *; case (Rle_dec a c); intro; - [ reflexivity | elim n0; apply Rle_trans with b; assumption ]. -elim H2; intros; apply H3. -replace (Rmax b c) with (Rmax a c). -elim H0; intros; split; try assumption. -replace (Rmin b c) with b. -auto with real. -unfold Rmin in |- *; case (Rle_dec b c); intro; - [ reflexivity | elim n0; assumption ]. -unfold Rmax in |- *; case (Rle_dec a c); case (Rle_dec b c); intros; - try (elim n0; assumption || elim n0; apply Rle_trans with b; assumption). -reflexivity. -elim n; replace a with (Rmin a c). -elim H0; intros; assumption. -unfold Rmin in |- *; case (Rle_dec a c); intro; - [ reflexivity | elim n1; apply Rle_trans with b; assumption ]. -rewrite <- (StepFun_P43 X0 X1 X2). -apply Rle_lt_trans with - (Rabs (RiemannInt_SF (mkStepFun X0)) + Rabs (RiemannInt_SF (mkStepFun X1))). -apply Rabs_triang. -rewrite (double_var eps); - replace (RiemannInt_SF (mkStepFun X0)) with (RiemannInt_SF psi1). -replace (RiemannInt_SF (mkStepFun X1)) with (RiemannInt_SF psi2). -apply Rplus_lt_compat. -elim H1; intros; assumption. -elim H2; intros; assumption. -apply Rle_antisym. -apply StepFun_P37; try assumption. -simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros; - case (Rle_dec a x); case (Rle_dec x b); intros; - [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H0)) - | right; reflexivity - | elim n; apply Rle_trans with b; [ assumption | left; assumption ] - | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ]. -apply StepFun_P37; try assumption. -simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros; - case (Rle_dec a x); case (Rle_dec x b); intros; - [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H0)) - | right; reflexivity - | elim n; apply Rle_trans with b; [ assumption | left; assumption ] - | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ]. -apply Rle_antisym. -apply StepFun_P37; try assumption. -simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros; - case (Rle_dec a x); case (Rle_dec x b); intros; - [ right; reflexivity - | elim n; left; assumption - | elim n; left; assumption - | elim n0; left; assumption ]. -apply StepFun_P37; try assumption. -simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros; - case (Rle_dec a x); case (Rle_dec x b); intros; - [ right; reflexivity - | elim n; left; assumption - | elim n; left; assumption - | elim n0; left; assumption ]. -apply StepFun_P46 with b; assumption. -assert (H3 := pre psi2); unfold IsStepFun in H3; unfold is_subdivision in H3; - elim H3; clear H3; intros l1 [lf1 H3]; split with l1; - split with lf1; unfold adapted_couple in H3; decompose [and] H3; - clear H3; unfold adapted_couple in |- *; repeat split; - try assumption. -intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *; - unfold constant_D_eq, open_interval in H9; intros; - rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : b < x). -apply Rle_lt_trans with (pos_Rl l1 i). -replace b with (Rmin b c). -rewrite <- H5; elim (RList_P6 l1); intros; apply H10; try assumption. -apply le_O_n. -apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n; - apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6; - discriminate. -unfold Rmin in |- *; case (Rle_dec b c); intro; - [ reflexivity | elim n; assumption ]. -elim H7; intros; assumption. -case (Rle_dec a x); case (Rle_dec x b); intros; - [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H10)) - | reflexivity - | elim n; apply Rle_trans with b; [ assumption | left; assumption ] - | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ]. -assert (H3 := pre psi1); unfold IsStepFun in H3; unfold is_subdivision in H3; - elim H3; clear H3; intros l1 [lf1 H3]; split with l1; - split with lf1; unfold adapted_couple in H3; decompose [and] H3; - clear H3; unfold adapted_couple in |- *; repeat split; - try assumption. -intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *; - unfold constant_D_eq, open_interval in H9; intros; - rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : x <= b). -apply Rle_trans with (pos_Rl l1 (S i)). -elim H7; intros; left; assumption. -replace b with (Rmax a b). -rewrite <- H4; elim (RList_P6 l1); intros; apply H10; try assumption. -apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6; - discriminate. -unfold Rmax in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ]. -assert (H11 : a <= x). -apply Rle_trans with (pos_Rl l1 i). -replace a with (Rmin a b). -rewrite <- H5; elim (RList_P6 l1); intros; apply H11; try assumption. -apply le_O_n. -apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n; - apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H6; - discriminate. -unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ]. -left; elim H7; intros; assumption. -case (Rle_dec a x); case (Rle_dec x b); intros; reflexivity || elim n; - assumption. -apply StepFun_P46 with b. -assert (H3 := pre phi1); unfold IsStepFun in H3; unfold is_subdivision in H3; - elim H3; clear H3; intros l1 [lf1 H3]; split with l1; - split with lf1; unfold adapted_couple in H3; decompose [and] H3; - clear H3; unfold adapted_couple in |- *; repeat split; - try assumption. -intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *; - unfold constant_D_eq, open_interval in H9; intros; - rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : x <= b). -apply Rle_trans with (pos_Rl l1 (S i)). -elim H7; intros; left; assumption. -replace b with (Rmax a b). -rewrite <- H4; elim (RList_P6 l1); intros; apply H10; try assumption. -apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6; - discriminate. -unfold Rmax in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ]. -assert (H11 : a <= x). -apply Rle_trans with (pos_Rl l1 i). -replace a with (Rmin a b). -rewrite <- H5; elim (RList_P6 l1); intros; apply H11; try assumption. -apply le_O_n. -apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n; - apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H6; - discriminate. -unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ]. -left; elim H7; intros; assumption. -unfold phi3 in |- *; case (Rle_dec a x); case (Rle_dec x b); intros; - reflexivity || elim n; assumption. -assert (H3 := pre phi2); unfold IsStepFun in H3; unfold is_subdivision in H3; - elim H3; clear H3; intros l1 [lf1 H3]; split with l1; - split with lf1; unfold adapted_couple in H3; decompose [and] H3; - clear H3; unfold adapted_couple in |- *; repeat split; - try assumption. -intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *; - unfold constant_D_eq, open_interval in H9; intros; - rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : b < x). -apply Rle_lt_trans with (pos_Rl l1 i). -replace b with (Rmin b c). -rewrite <- H5; elim (RList_P6 l1); intros; apply H10; try assumption. -apply le_O_n. -apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n; - apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6; - discriminate. -unfold Rmin in |- *; case (Rle_dec b c); intro; - [ reflexivity | elim n; assumption ]. -elim H7; intros; assumption. -unfold phi3 in |- *; case (Rle_dec a x); case (Rle_dec x b); intros; - [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H10)) - | reflexivity - | elim n; apply Rle_trans with b; [ assumption | left; assumption ] - | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ]. + forall (f:R -> R) (a b c:R), + a <= b -> + b <= c -> + Riemann_integrable f a b -> + Riemann_integrable f b c -> Riemann_integrable f a c. +Proof. + unfold Riemann_integrable in |- *; intros f a b c Hyp1 Hyp2 X X0 eps. + assert (H : 0 < eps / 2). + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ]. + elim (X (mkposreal _ H)); clear X; intros phi1 [psi1 H1]; + elim (X0 (mkposreal _ H)); clear X0; intros phi2 [psi2 H2]. + set + (phi3 := + fun x:R => + match Rle_dec a x with + | left _ => + match Rle_dec x b with + | left _ => phi1 x + | right _ => phi2 x + end + | right _ => 0 + end). + set + (psi3 := + fun x:R => + match Rle_dec a x with + | left _ => + match Rle_dec x b with + | left _ => psi1 x + | right _ => psi2 x + end + | right _ => 0 + end). + cut (IsStepFun phi3 a c). + intro; cut (IsStepFun psi3 a b). + intro; cut (IsStepFun psi3 b c). + intro; cut (IsStepFun psi3 a c). + intro; split with (mkStepFun X); split with (mkStepFun X2); simpl in |- *; + split. + intros; unfold phi3, psi3 in |- *; case (Rle_dec t b); case (Rle_dec a t); + intros. + elim H1; intros; apply H3. + replace (Rmin a b) with a. + replace (Rmax a b) with b. + split; assumption. + unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. + elim n; replace a with (Rmin a c). + elim H0; intros; assumption. + unfold Rmin in |- *; case (Rle_dec a c); intro; + [ reflexivity | elim n0; apply Rle_trans with b; assumption ]. + elim H2; intros; apply H3. + replace (Rmax b c) with (Rmax a c). + elim H0; intros; split; try assumption. + replace (Rmin b c) with b. + auto with real. + unfold Rmin in |- *; case (Rle_dec b c); intro; + [ reflexivity | elim n0; assumption ]. + unfold Rmax in |- *; case (Rle_dec a c); case (Rle_dec b c); intros; + try (elim n0; assumption || elim n0; apply Rle_trans with b; assumption). + reflexivity. + elim n; replace a with (Rmin a c). + elim H0; intros; assumption. + unfold Rmin in |- *; case (Rle_dec a c); intro; + [ reflexivity | elim n1; apply Rle_trans with b; assumption ]. + rewrite <- (StepFun_P43 X0 X1 X2). + apply Rle_lt_trans with + (Rabs (RiemannInt_SF (mkStepFun X0)) + Rabs (RiemannInt_SF (mkStepFun X1))). + apply Rabs_triang. + rewrite (double_var eps); + replace (RiemannInt_SF (mkStepFun X0)) with (RiemannInt_SF psi1). + replace (RiemannInt_SF (mkStepFun X1)) with (RiemannInt_SF psi2). + apply Rplus_lt_compat. + elim H1; intros; assumption. + elim H2; intros; assumption. + apply Rle_antisym. + apply StepFun_P37; try assumption. + simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros; + case (Rle_dec a x); case (Rle_dec x b); intros; + [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H0)) + | right; reflexivity + | elim n; apply Rle_trans with b; [ assumption | left; assumption ] + | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ]. + apply StepFun_P37; try assumption. + simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros; + case (Rle_dec a x); case (Rle_dec x b); intros; + [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H0)) + | right; reflexivity + | elim n; apply Rle_trans with b; [ assumption | left; assumption ] + | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ]. + apply Rle_antisym. + apply StepFun_P37; try assumption. + simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros; + case (Rle_dec a x); case (Rle_dec x b); intros; + [ right; reflexivity + | elim n; left; assumption + | elim n; left; assumption + | elim n0; left; assumption ]. + apply StepFun_P37; try assumption. + simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros; + case (Rle_dec a x); case (Rle_dec x b); intros; + [ right; reflexivity + | elim n; left; assumption + | elim n; left; assumption + | elim n0; left; assumption ]. + apply StepFun_P46 with b; assumption. + assert (H3 := pre psi2); unfold IsStepFun in H3; unfold is_subdivision in H3; + elim H3; clear H3; intros l1 [lf1 H3]; split with l1; + split with lf1; unfold adapted_couple in H3; decompose [and] H3; + clear H3; unfold adapted_couple in |- *; repeat split; + try assumption. + intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *; + unfold constant_D_eq, open_interval in H9; intros; + rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : b < x). + apply Rle_lt_trans with (pos_Rl l1 i). + replace b with (Rmin b c). + rewrite <- H5; elim (RList_P6 l1); intros; apply H10; try assumption. + apply le_O_n. + apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n; + apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6; + discriminate. + unfold Rmin in |- *; case (Rle_dec b c); intro; + [ reflexivity | elim n; assumption ]. + elim H7; intros; assumption. + case (Rle_dec a x); case (Rle_dec x b); intros; + [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H10)) + | reflexivity + | elim n; apply Rle_trans with b; [ assumption | left; assumption ] + | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ]. + assert (H3 := pre psi1); unfold IsStepFun in H3; unfold is_subdivision in H3; + elim H3; clear H3; intros l1 [lf1 H3]; split with l1; + split with lf1; unfold adapted_couple in H3; decompose [and] H3; + clear H3; unfold adapted_couple in |- *; repeat split; + try assumption. + intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *; + unfold constant_D_eq, open_interval in H9; intros; + rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : x <= b). + apply Rle_trans with (pos_Rl l1 (S i)). + elim H7; intros; left; assumption. + replace b with (Rmax a b). + rewrite <- H4; elim (RList_P6 l1); intros; apply H10; try assumption. + apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6; + discriminate. + unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. + assert (H11 : a <= x). + apply Rle_trans with (pos_Rl l1 i). + replace a with (Rmin a b). + rewrite <- H5; elim (RList_P6 l1); intros; apply H11; try assumption. + apply le_O_n. + apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n; + apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H6; + discriminate. + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. + left; elim H7; intros; assumption. + case (Rle_dec a x); case (Rle_dec x b); intros; reflexivity || elim n; + assumption. + apply StepFun_P46 with b. + assert (H3 := pre phi1); unfold IsStepFun in H3; unfold is_subdivision in H3; + elim H3; clear H3; intros l1 [lf1 H3]; split with l1; + split with lf1; unfold adapted_couple in H3; decompose [and] H3; + clear H3; unfold adapted_couple in |- *; repeat split; + try assumption. + intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *; + unfold constant_D_eq, open_interval in H9; intros; + rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : x <= b). + apply Rle_trans with (pos_Rl l1 (S i)). + elim H7; intros; left; assumption. + replace b with (Rmax a b). + rewrite <- H4; elim (RList_P6 l1); intros; apply H10; try assumption. + apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6; + discriminate. + unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. + assert (H11 : a <= x). + apply Rle_trans with (pos_Rl l1 i). + replace a with (Rmin a b). + rewrite <- H5; elim (RList_P6 l1); intros; apply H11; try assumption. + apply le_O_n. + apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n; + apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H6; + discriminate. + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. + left; elim H7; intros; assumption. + unfold phi3 in |- *; case (Rle_dec a x); case (Rle_dec x b); intros; + reflexivity || elim n; assumption. + assert (H3 := pre phi2); unfold IsStepFun in H3; unfold is_subdivision in H3; + elim H3; clear H3; intros l1 [lf1 H3]; split with l1; + split with lf1; unfold adapted_couple in H3; decompose [and] H3; + clear H3; unfold adapted_couple in |- *; repeat split; + try assumption. + intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *; + unfold constant_D_eq, open_interval in H9; intros; + rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : b < x). + apply Rle_lt_trans with (pos_Rl l1 i). + replace b with (Rmin b c). + rewrite <- H5; elim (RList_P6 l1); intros; apply H10; try assumption. + apply le_O_n. + apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n; + apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6; + discriminate. + unfold Rmin in |- *; case (Rle_dec b c); intro; + [ reflexivity | elim n; assumption ]. + elim H7; intros; assumption. + unfold phi3 in |- *; case (Rle_dec a x); case (Rle_dec x b); intros; + [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H10)) + | reflexivity + | elim n; apply Rle_trans with b; [ assumption | left; assumption ] + | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ]. Qed. Lemma RiemannInt_P22 : - forall (f:R -> R) (a b c:R), - Riemann_integrable f a b -> a <= c <= b -> Riemann_integrable f a c. -unfold Riemann_integrable in |- *; intros; elim (X eps); clear X; - intros phi [psi H0]; elim H; elim H0; clear H H0; - intros; assert (H3 : IsStepFun phi a c). -apply StepFun_P44 with b. -apply (pre phi). -split; assumption. -assert (H4 : IsStepFun psi a c). -apply StepFun_P44 with b. -apply (pre psi). -split; assumption. -split with (mkStepFun H3); split with (mkStepFun H4); split. -simpl in |- *; intros; apply H. -replace (Rmin a b) with (Rmin a c). -elim H5; intros; split; try assumption. -apply Rle_trans with (Rmax a c); try assumption. -replace (Rmax a b) with b. -replace (Rmax a c) with c. -assumption. -unfold Rmax in |- *; case (Rle_dec a c); intro; - [ reflexivity | elim n; assumption ]. -unfold Rmax in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; apply Rle_trans with c; assumption ]. -unfold Rmin in |- *; case (Rle_dec a c); case (Rle_dec a b); intros; - [ reflexivity - | elim n; apply Rle_trans with c; assumption - | elim n; assumption - | elim n0; assumption ]. -rewrite Rabs_right. -assert (H5 : IsStepFun psi c b). -apply StepFun_P46 with a. -apply StepFun_P6; assumption. -apply (pre psi). -replace (RiemannInt_SF (mkStepFun H4)) with - (RiemannInt_SF psi - RiemannInt_SF (mkStepFun H5)). -apply Rle_lt_trans with (RiemannInt_SF psi). -unfold Rminus in |- *; pattern (RiemannInt_SF psi) at 2 in |- *; - rewrite <- Rplus_0_r; apply Rplus_le_compat_l; rewrite <- Ropp_0; - apply Ropp_ge_le_contravar; apply Rle_ge; - replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 c b 0))). -apply StepFun_P37; try assumption. -intros; simpl in |- *; unfold fct_cte in |- *; - apply Rle_trans with (Rabs (f x - phi x)). -apply Rabs_pos. -apply H. -replace (Rmin a b) with a. -replace (Rmax a b) with b. -elim H6; intros; split; left. -apply Rle_lt_trans with c; assumption. -assumption. -unfold Rmax in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; apply Rle_trans with c; assumption ]. -unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; apply Rle_trans with c; assumption ]. -rewrite StepFun_P18; ring. -apply Rle_lt_trans with (Rabs (RiemannInt_SF psi)). -apply RRle_abs. -assumption. -assert (H6 : IsStepFun psi a b). -apply (pre psi). -replace (RiemannInt_SF psi) with (RiemannInt_SF (mkStepFun H6)). -rewrite <- (StepFun_P43 H4 H5 H6); ring. -unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro. -eapply StepFun_P17. -apply StepFun_P1. -simpl in |- *; apply StepFun_P1. -apply Ropp_eq_compat; eapply StepFun_P17. -apply StepFun_P1. -simpl in |- *; apply StepFun_P1. -apply Rle_ge; replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 a c 0))). -apply StepFun_P37; try assumption. -intros; simpl in |- *; unfold fct_cte in |- *; - apply Rle_trans with (Rabs (f x - phi x)). -apply Rabs_pos. -apply H. -replace (Rmin a b) with a. -replace (Rmax a b) with b. -elim H5; intros; split; left. -assumption. -apply Rlt_le_trans with c; assumption. -unfold Rmax in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; apply Rle_trans with c; assumption ]. -unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; apply Rle_trans with c; assumption ]. -rewrite StepFun_P18; ring. + forall (f:R -> R) (a b c:R), + Riemann_integrable f a b -> a <= c <= b -> Riemann_integrable f a c. +Proof. + unfold Riemann_integrable in |- *; intros; elim (X eps); clear X; + intros phi [psi H0]; elim H; elim H0; clear H H0; + intros; assert (H3 : IsStepFun phi a c). + apply StepFun_P44 with b. + apply (pre phi). + split; assumption. + assert (H4 : IsStepFun psi a c). + apply StepFun_P44 with b. + apply (pre psi). + split; assumption. + split with (mkStepFun H3); split with (mkStepFun H4); split. + simpl in |- *; intros; apply H. + replace (Rmin a b) with (Rmin a c). + elim H5; intros; split; try assumption. + apply Rle_trans with (Rmax a c); try assumption. + replace (Rmax a b) with b. + replace (Rmax a c) with c. + assumption. + unfold Rmax in |- *; case (Rle_dec a c); intro; + [ reflexivity | elim n; assumption ]. + unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. + unfold Rmin in |- *; case (Rle_dec a c); case (Rle_dec a b); intros; + [ reflexivity + | elim n; apply Rle_trans with c; assumption + | elim n; assumption + | elim n0; assumption ]. + rewrite Rabs_right. + assert (H5 : IsStepFun psi c b). + apply StepFun_P46 with a. + apply StepFun_P6; assumption. + apply (pre psi). + replace (RiemannInt_SF (mkStepFun H4)) with + (RiemannInt_SF psi - RiemannInt_SF (mkStepFun H5)). + apply Rle_lt_trans with (RiemannInt_SF psi). + unfold Rminus in |- *; pattern (RiemannInt_SF psi) at 2 in |- *; + rewrite <- Rplus_0_r; apply Rplus_le_compat_l; rewrite <- Ropp_0; + apply Ropp_ge_le_contravar; apply Rle_ge; + replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 c b 0))). + apply StepFun_P37; try assumption. + intros; simpl in |- *; unfold fct_cte in |- *; + apply Rle_trans with (Rabs (f x - phi x)). + apply Rabs_pos. + apply H. + replace (Rmin a b) with a. + replace (Rmax a b) with b. + elim H6; intros; split; left. + apply Rle_lt_trans with c; assumption. + assumption. + unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. + rewrite StepFun_P18; ring. + apply Rle_lt_trans with (Rabs (RiemannInt_SF psi)). + apply RRle_abs. + assumption. + assert (H6 : IsStepFun psi a b). + apply (pre psi). + replace (RiemannInt_SF psi) with (RiemannInt_SF (mkStepFun H6)). + rewrite <- (StepFun_P43 H4 H5 H6); ring. + unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro. + eapply StepFun_P17. + apply StepFun_P1. + simpl in |- *; apply StepFun_P1. + apply Ropp_eq_compat; eapply StepFun_P17. + apply StepFun_P1. + simpl in |- *; apply StepFun_P1. + apply Rle_ge; replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 a c 0))). + apply StepFun_P37; try assumption. + intros; simpl in |- *; unfold fct_cte in |- *; + apply Rle_trans with (Rabs (f x - phi x)). + apply Rabs_pos. + apply H. + replace (Rmin a b) with a. + replace (Rmax a b) with b. + elim H5; intros; split; left. + assumption. + apply Rlt_le_trans with c; assumption. + unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. + rewrite StepFun_P18; ring. Qed. Lemma RiemannInt_P23 : - forall (f:R -> R) (a b c:R), - Riemann_integrable f a b -> a <= c <= b -> Riemann_integrable f c b. -unfold Riemann_integrable in |- *; intros; elim (X eps); clear X; - intros phi [psi H0]; elim H; elim H0; clear H H0; - intros; assert (H3 : IsStepFun phi c b). -apply StepFun_P45 with a. -apply (pre phi). -split; assumption. -assert (H4 : IsStepFun psi c b). -apply StepFun_P45 with a. -apply (pre psi). -split; assumption. -split with (mkStepFun H3); split with (mkStepFun H4); split. -simpl in |- *; intros; apply H. -replace (Rmax a b) with (Rmax c b). -elim H5; intros; split; try assumption. -apply Rle_trans with (Rmin c b); try assumption. -replace (Rmin a b) with a. -replace (Rmin c b) with c. -assumption. -unfold Rmin in |- *; case (Rle_dec c b); intro; - [ reflexivity | elim n; assumption ]. -unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; apply Rle_trans with c; assumption ]. -unfold Rmax in |- *; case (Rle_dec c b); case (Rle_dec a b); intros; - [ reflexivity - | elim n; apply Rle_trans with c; assumption - | elim n; assumption - | elim n0; assumption ]. -rewrite Rabs_right. -assert (H5 : IsStepFun psi a c). -apply StepFun_P46 with b. -apply (pre psi). -apply StepFun_P6; assumption. -replace (RiemannInt_SF (mkStepFun H4)) with - (RiemannInt_SF psi - RiemannInt_SF (mkStepFun H5)). -apply Rle_lt_trans with (RiemannInt_SF psi). -unfold Rminus in |- *; pattern (RiemannInt_SF psi) at 2 in |- *; - rewrite <- Rplus_0_r; apply Rplus_le_compat_l; rewrite <- Ropp_0; - apply Ropp_ge_le_contravar; apply Rle_ge; - replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 a c 0))). -apply StepFun_P37; try assumption. -intros; simpl in |- *; unfold fct_cte in |- *; - apply Rle_trans with (Rabs (f x - phi x)). -apply Rabs_pos. -apply H. -replace (Rmin a b) with a. -replace (Rmax a b) with b. -elim H6; intros; split; left. -assumption. -apply Rlt_le_trans with c; assumption. -unfold Rmax in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; apply Rle_trans with c; assumption ]. -unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; apply Rle_trans with c; assumption ]. -rewrite StepFun_P18; ring. -apply Rle_lt_trans with (Rabs (RiemannInt_SF psi)). -apply RRle_abs. -assumption. -assert (H6 : IsStepFun psi a b). -apply (pre psi). -replace (RiemannInt_SF psi) with (RiemannInt_SF (mkStepFun H6)). -rewrite <- (StepFun_P43 H5 H4 H6); ring. -unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro. -eapply StepFun_P17. -apply StepFun_P1. -simpl in |- *; apply StepFun_P1. -apply Ropp_eq_compat; eapply StepFun_P17. -apply StepFun_P1. -simpl in |- *; apply StepFun_P1. -apply Rle_ge; replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 c b 0))). -apply StepFun_P37; try assumption. -intros; simpl in |- *; unfold fct_cte in |- *; - apply Rle_trans with (Rabs (f x - phi x)). -apply Rabs_pos. -apply H. -replace (Rmin a b) with a. -replace (Rmax a b) with b. -elim H5; intros; split; left. -apply Rle_lt_trans with c; assumption. -assumption. -unfold Rmax in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; apply Rle_trans with c; assumption ]. -unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; apply Rle_trans with c; assumption ]. -rewrite StepFun_P18; ring. + forall (f:R -> R) (a b c:R), + Riemann_integrable f a b -> a <= c <= b -> Riemann_integrable f c b. +Proof. + unfold Riemann_integrable in |- *; intros; elim (X eps); clear X; + intros phi [psi H0]; elim H; elim H0; clear H H0; + intros; assert (H3 : IsStepFun phi c b). + apply StepFun_P45 with a. + apply (pre phi). + split; assumption. + assert (H4 : IsStepFun psi c b). + apply StepFun_P45 with a. + apply (pre psi). + split; assumption. + split with (mkStepFun H3); split with (mkStepFun H4); split. + simpl in |- *; intros; apply H. + replace (Rmax a b) with (Rmax c b). + elim H5; intros; split; try assumption. + apply Rle_trans with (Rmin c b); try assumption. + replace (Rmin a b) with a. + replace (Rmin c b) with c. + assumption. + unfold Rmin in |- *; case (Rle_dec c b); intro; + [ reflexivity | elim n; assumption ]. + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. + unfold Rmax in |- *; case (Rle_dec c b); case (Rle_dec a b); intros; + [ reflexivity + | elim n; apply Rle_trans with c; assumption + | elim n; assumption + | elim n0; assumption ]. + rewrite Rabs_right. + assert (H5 : IsStepFun psi a c). + apply StepFun_P46 with b. + apply (pre psi). + apply StepFun_P6; assumption. + replace (RiemannInt_SF (mkStepFun H4)) with + (RiemannInt_SF psi - RiemannInt_SF (mkStepFun H5)). + apply Rle_lt_trans with (RiemannInt_SF psi). + unfold Rminus in |- *; pattern (RiemannInt_SF psi) at 2 in |- *; + rewrite <- Rplus_0_r; apply Rplus_le_compat_l; rewrite <- Ropp_0; + apply Ropp_ge_le_contravar; apply Rle_ge; + replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 a c 0))). + apply StepFun_P37; try assumption. + intros; simpl in |- *; unfold fct_cte in |- *; + apply Rle_trans with (Rabs (f x - phi x)). + apply Rabs_pos. + apply H. + replace (Rmin a b) with a. + replace (Rmax a b) with b. + elim H6; intros; split; left. + assumption. + apply Rlt_le_trans with c; assumption. + unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. + rewrite StepFun_P18; ring. + apply Rle_lt_trans with (Rabs (RiemannInt_SF psi)). + apply RRle_abs. + assumption. + assert (H6 : IsStepFun psi a b). + apply (pre psi). + replace (RiemannInt_SF psi) with (RiemannInt_SF (mkStepFun H6)). + rewrite <- (StepFun_P43 H5 H4 H6); ring. + unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro. + eapply StepFun_P17. + apply StepFun_P1. + simpl in |- *; apply StepFun_P1. + apply Ropp_eq_compat; eapply StepFun_P17. + apply StepFun_P1. + simpl in |- *; apply StepFun_P1. + apply Rle_ge; replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 c b 0))). + apply StepFun_P37; try assumption. + intros; simpl in |- *; unfold fct_cte in |- *; + apply Rle_trans with (Rabs (f x - phi x)). + apply Rabs_pos. + apply H. + replace (Rmin a b) with a. + replace (Rmax a b) with b. + elim H5; intros; split; left. + apply Rle_lt_trans with c; assumption. + assumption. + unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; apply Rle_trans with c; assumption ]. + rewrite StepFun_P18; ring. Qed. Lemma RiemannInt_P24 : - forall (f:R -> R) (a b c:R), - Riemann_integrable f a b -> - Riemann_integrable f b c -> Riemann_integrable f a c. -intros; case (Rle_dec a b); case (Rle_dec b c); intros. -apply RiemannInt_P21 with b; assumption. -case (Rle_dec a c); intro. -apply RiemannInt_P22 with b; try assumption. -split; [ assumption | auto with real ]. -apply RiemannInt_P1; apply RiemannInt_P22 with b. -apply RiemannInt_P1; assumption. -split; auto with real. -case (Rle_dec a c); intro. -apply RiemannInt_P23 with b; try assumption. -split; auto with real. -apply RiemannInt_P1; apply RiemannInt_P23 with b. -apply RiemannInt_P1; assumption. -split; [ assumption | auto with real ]. -apply RiemannInt_P1; apply RiemannInt_P21 with b; - auto with real || apply RiemannInt_P1; assumption. + forall (f:R -> R) (a b c:R), + Riemann_integrable f a b -> + Riemann_integrable f b c -> Riemann_integrable f a c. +Proof. + intros; case (Rle_dec a b); case (Rle_dec b c); intros. + apply RiemannInt_P21 with b; assumption. + case (Rle_dec a c); intro. + apply RiemannInt_P22 with b; try assumption. + split; [ assumption | auto with real ]. + apply RiemannInt_P1; apply RiemannInt_P22 with b. + apply RiemannInt_P1; assumption. + split; auto with real. + case (Rle_dec a c); intro. + apply RiemannInt_P23 with b; try assumption. + split; auto with real. + apply RiemannInt_P1; apply RiemannInt_P23 with b. + apply RiemannInt_P1; assumption. + split; [ assumption | auto with real ]. + apply RiemannInt_P1; apply RiemannInt_P21 with b; + auto with real || apply RiemannInt_P1; assumption. Qed. Lemma RiemannInt_P25 : - forall (f:R -> R) (a b c:R) (pr1:Riemann_integrable f a b) - (pr2:Riemann_integrable f b c) (pr3:Riemann_integrable f a c), - a <= b -> b <= c -> RiemannInt pr1 + RiemannInt pr2 = RiemannInt pr3. -intros f a b c pr1 pr2 pr3 Hyp1 Hyp2; unfold RiemannInt in |- *; - case (RiemannInt_exists pr1 RinvN RinvN_cv); - case (RiemannInt_exists pr2 RinvN RinvN_cv); - case (RiemannInt_exists pr3 RinvN RinvN_cv); intros; - symmetry in |- *; eapply UL_sequence. -apply u. -unfold Un_cv in |- *; intros; assert (H0 : 0 < eps / 3). -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. -elim (u1 _ H0); clear u1; intros N1 H1; elim (u0 _ H0); clear u0; - intros N2 H2; - cut - (Un_cv - (fun n:nat => - RiemannInt_SF (phi_sequence RinvN pr3 n) - - (RiemannInt_SF (phi_sequence RinvN pr1 n) + - RiemannInt_SF (phi_sequence RinvN pr2 n))) 0). -intro; elim (H3 _ H0); clear H3; intros N3 H3; - set (N0 := max (max N1 N2) N3); exists N0; intros; - unfold R_dist in |- *; - apply Rle_lt_trans with - (Rabs - (RiemannInt_SF (phi_sequence RinvN pr3 n) - - (RiemannInt_SF (phi_sequence RinvN pr1 n) + - RiemannInt_SF (phi_sequence RinvN pr2 n))) + - Rabs - (RiemannInt_SF (phi_sequence RinvN pr1 n) + - RiemannInt_SF (phi_sequence RinvN pr2 n) - (x1 + x0))). -replace (RiemannInt_SF (phi_sequence RinvN pr3 n) - (x1 + x0)) with - (RiemannInt_SF (phi_sequence RinvN pr3 n) - - (RiemannInt_SF (phi_sequence RinvN pr1 n) + - RiemannInt_SF (phi_sequence RinvN pr2 n)) + + forall (f:R -> R) (a b c:R) (pr1:Riemann_integrable f a b) + (pr2:Riemann_integrable f b c) (pr3:Riemann_integrable f a c), + a <= b -> b <= c -> RiemannInt pr1 + RiemannInt pr2 = RiemannInt pr3. +Proof. + intros f a b c pr1 pr2 pr3 Hyp1 Hyp2; unfold RiemannInt in |- *; + case (RiemannInt_exists pr1 RinvN RinvN_cv); + case (RiemannInt_exists pr2 RinvN RinvN_cv); + case (RiemannInt_exists pr3 RinvN RinvN_cv); intros; + symmetry in |- *; eapply UL_sequence. + apply u. + unfold Un_cv in |- *; intros; assert (H0 : 0 < eps / 3). + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. + elim (u1 _ H0); clear u1; intros N1 H1; elim (u0 _ H0); clear u0; + intros N2 H2; + cut + (Un_cv + (fun n:nat => + RiemannInt_SF (phi_sequence RinvN pr3 n) - + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + RiemannInt_SF (phi_sequence RinvN pr2 n))) 0). + intro; elim (H3 _ H0); clear H3; intros N3 H3; + set (N0 := max (max N1 N2) N3); exists N0; intros; + unfold R_dist in |- *; + apply Rle_lt_trans with + (Rabs + (RiemannInt_SF (phi_sequence RinvN pr3 n) - + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + RiemannInt_SF (phi_sequence RinvN pr2 n))) + + Rabs + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + RiemannInt_SF (phi_sequence RinvN pr2 n) - (x1 + x0))). + replace (RiemannInt_SF (phi_sequence RinvN pr3 n) - (x1 + x0)) with + (RiemannInt_SF (phi_sequence RinvN pr3 n) - + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + RiemannInt_SF (phi_sequence RinvN pr2 n)) + + (RiemannInt_SF (phi_sequence RinvN pr1 n) + + RiemannInt_SF (phi_sequence RinvN pr2 n) - (x1 + x0))); + [ apply Rabs_triang | ring ]. + replace eps with (eps / 3 + eps / 3 + eps / 3). + rewrite Rplus_assoc; apply Rplus_lt_compat. + unfold R_dist in H3; cut (n >= N3)%nat. + intro; assert (H6 := H3 _ H5); unfold Rminus in H6; rewrite Ropp_0 in H6; + rewrite Rplus_0_r in H6; apply H6. + unfold ge in |- *; apply le_trans with N0; + [ unfold N0 in |- *; apply le_max_r | assumption ]. + apply Rle_lt_trans with + (Rabs (RiemannInt_SF (phi_sequence RinvN pr1 n) - x1) + + Rabs (RiemannInt_SF (phi_sequence RinvN pr2 n) - x0)). + replace (RiemannInt_SF (phi_sequence RinvN pr1 n) + - RiemannInt_SF (phi_sequence RinvN pr2 n) - (x1 + x0))); - [ apply Rabs_triang | ring ]. -replace eps with (eps / 3 + eps / 3 + eps / 3). -rewrite Rplus_assoc; apply Rplus_lt_compat. -unfold R_dist in H3; cut (n >= N3)%nat. -intro; assert (H6 := H3 _ H5); unfold Rminus in H6; rewrite Ropp_0 in H6; - rewrite Rplus_0_r in H6; apply H6. -unfold ge in |- *; apply le_trans with N0; - [ unfold N0 in |- *; apply le_max_r | assumption ]. -apply Rle_lt_trans with - (Rabs (RiemannInt_SF (phi_sequence RinvN pr1 n) - x1) + - Rabs (RiemannInt_SF (phi_sequence RinvN pr2 n) - x0)). -replace - (RiemannInt_SF (phi_sequence RinvN pr1 n) + - RiemannInt_SF (phi_sequence RinvN pr2 n) - (x1 + x0)) with - (RiemannInt_SF (phi_sequence RinvN pr1 n) - x1 + - (RiemannInt_SF (phi_sequence RinvN pr2 n) - x0)); - [ apply Rabs_triang | ring ]. -apply Rplus_lt_compat. -unfold R_dist in H1; apply H1. -unfold ge in |- *; apply le_trans with N0; - [ apply le_trans with (max N1 N2); - [ apply le_max_l | unfold N0 in |- *; apply le_max_l ] - | assumption ]. -unfold R_dist in H2; apply H2. -unfold ge in |- *; apply le_trans with N0; - [ apply le_trans with (max N1 N2); - [ apply le_max_r | unfold N0 in |- *; apply le_max_l ] - | assumption ]. -apply Rmult_eq_reg_l with 3; - [ unfold Rdiv in |- *; repeat rewrite Rmult_plus_distr_l; - do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; - rewrite <- Rinv_l_sym; [ ring | discrR ] - | discrR ]. -clear x u x0 x1 eps H H0 N1 H1 N2 H2; - assert - (H1 : - exists psi1 : nat -> StepFun a b, - (forall n:nat, - (forall t:R, - Rmin a b <= t /\ t <= Rmax a b -> - Rabs (f t - phi_sequence RinvN pr1 n t) <= psi1 n t) /\ - Rabs (RiemannInt_SF (psi1 n)) < RinvN n)). -split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro; - apply (projT2 (phi_sequence_prop RinvN pr1 n)). -assert - (H2 : - exists psi2 : nat -> StepFun b c, - (forall n:nat, - (forall t:R, - Rmin b c <= t /\ t <= Rmax b c -> - Rabs (f t - phi_sequence RinvN pr2 n t) <= psi2 n t) /\ - Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). -split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro; - apply (projT2 (phi_sequence_prop RinvN pr2 n)). -assert - (H3 : - exists psi3 : nat -> StepFun a c, - (forall n:nat, - (forall t:R, - Rmin a c <= t /\ t <= Rmax a c -> - Rabs (f t - phi_sequence RinvN pr3 n t) <= psi3 n t) /\ - Rabs (RiemannInt_SF (psi3 n)) < RinvN n)). -split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr3 n)); intro; - apply (projT2 (phi_sequence_prop RinvN pr3 n)). -elim H1; clear H1; intros psi1 H1; elim H2; clear H2; intros psi2 H2; elim H3; - clear H3; intros psi3 H3; assert (H := RinvN_cv); - unfold Un_cv in |- *; intros; assert (H4 : 0 < eps / 3). -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. -elim (H _ H4); clear H; intros N0 H; - assert (H5 : forall n:nat, (n >= N0)%nat -> RinvN n < eps / 3). -intros; - replace (pos (RinvN n)) with - (R_dist (mkposreal (/ (INR n + 1)) (RinvN_pos n)) 0). -apply H; assumption. -unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; - rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; - left; apply (cond_pos (RinvN n)). -exists N0; intros; elim (H1 n); elim (H2 n); elim (H3 n); clear H1 H2 H3; - intros; unfold R_dist in |- *; unfold Rminus in |- *; - rewrite Ropp_0; rewrite Rplus_0_r; - set (phi1 := phi_sequence RinvN pr1 n) in H8 |- *; - set (phi2 := phi_sequence RinvN pr2 n) in H3 |- *; - set (phi3 := phi_sequence RinvN pr3 n) in H1 |- *; - assert (H10 : IsStepFun phi3 a b). -apply StepFun_P44 with c. -apply (pre phi3). -split; assumption. -assert (H11 : IsStepFun (psi3 n) a b). -apply StepFun_P44 with c. -apply (pre (psi3 n)). -split; assumption. -assert (H12 : IsStepFun phi3 b c). -apply StepFun_P45 with a. -apply (pre phi3). -split; assumption. -assert (H13 : IsStepFun (psi3 n) b c). -apply StepFun_P45 with a. -apply (pre (psi3 n)). -split; assumption. -replace (RiemannInt_SF phi3) with - (RiemannInt_SF (mkStepFun H10) + RiemannInt_SF (mkStepFun H12)). -apply Rle_lt_trans with - (Rabs (RiemannInt_SF (mkStepFun H10) - RiemannInt_SF phi1) + - Rabs (RiemannInt_SF (mkStepFun H12) - RiemannInt_SF phi2)). -replace - (RiemannInt_SF (mkStepFun H10) + RiemannInt_SF (mkStepFun H12) + - - (RiemannInt_SF phi1 + RiemannInt_SF phi2)) with - (RiemannInt_SF (mkStepFun H10) - RiemannInt_SF phi1 + - (RiemannInt_SF (mkStepFun H12) - RiemannInt_SF phi2)); - [ apply Rabs_triang | ring ]. -replace (RiemannInt_SF (mkStepFun H10) - RiemannInt_SF phi1) with - (RiemannInt_SF (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1))). -replace (RiemannInt_SF (mkStepFun H12) - RiemannInt_SF phi2) with - (RiemannInt_SF (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2))). -apply Rle_lt_trans with - (RiemannInt_SF - (mkStepFun - (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1)))) + - RiemannInt_SF - (mkStepFun - (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2))))). -apply Rle_trans with - (Rabs (RiemannInt_SF (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1))) + - RiemannInt_SF - (mkStepFun - (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2))))). -apply Rplus_le_compat_l. -apply StepFun_P34; try assumption. -do 2 - rewrite <- - (Rplus_comm - (RiemannInt_SF - (mkStepFun - (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2)))))) - ; apply Rplus_le_compat_l; apply StepFun_P34; try assumption. -apply Rle_lt_trans with - (RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H11) (psi1 n))) + - RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H13) (psi2 n)))). -apply Rle_trans with - (RiemannInt_SF - (mkStepFun - (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1)))) + - RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H13) (psi2 n)))). -apply Rplus_le_compat_l; apply StepFun_P37; try assumption. -intros; simpl in |- *; rewrite Rmult_1_l; - apply Rle_trans with (Rabs (f x - phi3 x) + Rabs (f x - phi2 x)). -rewrite <- (Rabs_Ropp (f x - phi3 x)); rewrite Ropp_minus_distr; - replace (phi3 x + -1 * phi2 x) with (phi3 x - f x + (f x - phi2 x)); - [ apply Rabs_triang | ring ]. -apply Rplus_le_compat. -apply H1. -elim H14; intros; split. -replace (Rmin a c) with a. -apply Rle_trans with b; try assumption. -left; assumption. -unfold Rmin in |- *; case (Rle_dec a c); intro; - [ reflexivity | elim n0; apply Rle_trans with b; assumption ]. -replace (Rmax a c) with c. -left; assumption. -unfold Rmax in |- *; case (Rle_dec a c); intro; - [ reflexivity | elim n0; apply Rle_trans with b; assumption ]. -apply H3. -elim H14; intros; split. -replace (Rmin b c) with b. -left; assumption. -unfold Rmin in |- *; case (Rle_dec b c); intro; - [ reflexivity | elim n0; assumption ]. -replace (Rmax b c) with c. -left; assumption. -unfold Rmax in |- *; case (Rle_dec b c); intro; - [ reflexivity | elim n0; assumption ]. -do 2 - rewrite <- - (Rplus_comm - (RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H13) (psi2 n))))) - ; apply Rplus_le_compat_l; apply StepFun_P37; try assumption. -intros; simpl in |- *; rewrite Rmult_1_l; - apply Rle_trans with (Rabs (f x - phi3 x) + Rabs (f x - phi1 x)). -rewrite <- (Rabs_Ropp (f x - phi3 x)); rewrite Ropp_minus_distr; - replace (phi3 x + -1 * phi1 x) with (phi3 x - f x + (f x - phi1 x)); - [ apply Rabs_triang | ring ]. -apply Rplus_le_compat. -apply H1. -elim H14; intros; split. -replace (Rmin a c) with a. -left; assumption. -unfold Rmin in |- *; case (Rle_dec a c); intro; - [ reflexivity | elim n0; apply Rle_trans with b; assumption ]. -replace (Rmax a c) with c. -apply Rle_trans with b. -left; assumption. -assumption. -unfold Rmax in |- *; case (Rle_dec a c); intro; - [ reflexivity | elim n0; apply Rle_trans with b; assumption ]. -apply H8. -elim H14; intros; split. -replace (Rmin a b) with a. -left; assumption. -unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n0; assumption ]. -replace (Rmax a b) with b. -left; assumption. -unfold Rmax in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n0; assumption ]. -do 2 rewrite StepFun_P30. -do 2 rewrite Rmult_1_l; - replace - (RiemannInt_SF (mkStepFun H11) + RiemannInt_SF (psi1 n) + - (RiemannInt_SF (mkStepFun H13) + RiemannInt_SF (psi2 n))) with - (RiemannInt_SF (psi3 n) + RiemannInt_SF (psi1 n) + RiemannInt_SF (psi2 n)). -replace eps with (eps / 3 + eps / 3 + eps / 3). -repeat rewrite Rplus_assoc; repeat apply Rplus_lt_compat. -apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi3 n))). -apply RRle_abs. -apply Rlt_trans with (pos (RinvN n)). -assumption. -apply H5; assumption. -apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))). -apply RRle_abs. -apply Rlt_trans with (pos (RinvN n)). -assumption. -apply H5; assumption. -apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))). -apply RRle_abs. -apply Rlt_trans with (pos (RinvN n)). -assumption. -apply H5; assumption. -apply Rmult_eq_reg_l with 3; - [ unfold Rdiv in |- *; repeat rewrite Rmult_plus_distr_l; - do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; - rewrite <- Rinv_l_sym; [ ring | discrR ] - | discrR ]. -replace (RiemannInt_SF (psi3 n)) with - (RiemannInt_SF (mkStepFun (pre (psi3 n)))). -rewrite <- (StepFun_P43 H11 H13 (pre (psi3 n))); ring. -reflexivity. -rewrite StepFun_P30; ring. -rewrite StepFun_P30; ring. -apply (StepFun_P43 H10 H12 (pre phi3)). + RiemannInt_SF (phi_sequence RinvN pr2 n) - (x1 + x0)) with + (RiemannInt_SF (phi_sequence RinvN pr1 n) - x1 + + (RiemannInt_SF (phi_sequence RinvN pr2 n) - x0)); + [ apply Rabs_triang | ring ]. + apply Rplus_lt_compat. + unfold R_dist in H1; apply H1. + unfold ge in |- *; apply le_trans with N0; + [ apply le_trans with (max N1 N2); + [ apply le_max_l | unfold N0 in |- *; apply le_max_l ] + | assumption ]. + unfold R_dist in H2; apply H2. + unfold ge in |- *; apply le_trans with N0; + [ apply le_trans with (max N1 N2); + [ apply le_max_r | unfold N0 in |- *; apply le_max_l ] + | assumption ]. + apply Rmult_eq_reg_l with 3; + [ unfold Rdiv in |- *; repeat rewrite Rmult_plus_distr_l; + do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ ring | discrR ] + | discrR ]. + clear x u x0 x1 eps H H0 N1 H1 N2 H2; + assert + (H1 : + exists psi1 : nat -> StepFun a b, + (forall n:nat, + (forall t:R, + Rmin a b <= t /\ t <= Rmax a b -> + Rabs (f t - phi_sequence RinvN pr1 n t) <= psi1 n t) /\ + Rabs (RiemannInt_SF (psi1 n)) < RinvN n)). + split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr1 n)). + assert + (H2 : + exists psi2 : nat -> StepFun b c, + (forall n:nat, + (forall t:R, + Rmin b c <= t /\ t <= Rmax b c -> + Rabs (f t - phi_sequence RinvN pr2 n t) <= psi2 n t) /\ + Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). + split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr2 n)). + assert + (H3 : + exists psi3 : nat -> StepFun a c, + (forall n:nat, + (forall t:R, + Rmin a c <= t /\ t <= Rmax a c -> + Rabs (f t - phi_sequence RinvN pr3 n t) <= psi3 n t) /\ + Rabs (RiemannInt_SF (psi3 n)) < RinvN n)). + split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr3 n)); intro; + apply (projT2 (phi_sequence_prop RinvN pr3 n)). + elim H1; clear H1; intros psi1 H1; elim H2; clear H2; intros psi2 H2; elim H3; + clear H3; intros psi3 H3; assert (H := RinvN_cv); + unfold Un_cv in |- *; intros; assert (H4 : 0 < eps / 3). + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. + elim (H _ H4); clear H; intros N0 H; + assert (H5 : forall n:nat, (n >= N0)%nat -> RinvN n < eps / 3). + intros; + replace (pos (RinvN n)) with + (R_dist (mkposreal (/ (INR n + 1)) (RinvN_pos n)) 0). + apply H; assumption. + unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; + left; apply (cond_pos (RinvN n)). + exists N0; intros; elim (H1 n); elim (H2 n); elim (H3 n); clear H1 H2 H3; + intros; unfold R_dist in |- *; unfold Rminus in |- *; + rewrite Ropp_0; rewrite Rplus_0_r; + set (phi1 := phi_sequence RinvN pr1 n) in H8 |- *; + set (phi2 := phi_sequence RinvN pr2 n) in H3 |- *; + set (phi3 := phi_sequence RinvN pr3 n) in H1 |- *; + assert (H10 : IsStepFun phi3 a b). + apply StepFun_P44 with c. + apply (pre phi3). + split; assumption. + assert (H11 : IsStepFun (psi3 n) a b). + apply StepFun_P44 with c. + apply (pre (psi3 n)). + split; assumption. + assert (H12 : IsStepFun phi3 b c). + apply StepFun_P45 with a. + apply (pre phi3). + split; assumption. + assert (H13 : IsStepFun (psi3 n) b c). + apply StepFun_P45 with a. + apply (pre (psi3 n)). + split; assumption. + replace (RiemannInt_SF phi3) with + (RiemannInt_SF (mkStepFun H10) + RiemannInt_SF (mkStepFun H12)). + apply Rle_lt_trans with + (Rabs (RiemannInt_SF (mkStepFun H10) - RiemannInt_SF phi1) + + Rabs (RiemannInt_SF (mkStepFun H12) - RiemannInt_SF phi2)). + replace + (RiemannInt_SF (mkStepFun H10) + RiemannInt_SF (mkStepFun H12) + + - (RiemannInt_SF phi1 + RiemannInt_SF phi2)) with + (RiemannInt_SF (mkStepFun H10) - RiemannInt_SF phi1 + + (RiemannInt_SF (mkStepFun H12) - RiemannInt_SF phi2)); + [ apply Rabs_triang | ring ]. + replace (RiemannInt_SF (mkStepFun H10) - RiemannInt_SF phi1) with + (RiemannInt_SF (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1))). + replace (RiemannInt_SF (mkStepFun H12) - RiemannInt_SF phi2) with + (RiemannInt_SF (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2))). + apply Rle_lt_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1)))) + + RiemannInt_SF + (mkStepFun + (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2))))). + apply Rle_trans with + (Rabs (RiemannInt_SF (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1))) + + RiemannInt_SF + (mkStepFun + (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2))))). + apply Rplus_le_compat_l. + apply StepFun_P34; try assumption. + do 2 + rewrite <- + (Rplus_comm + (RiemannInt_SF + (mkStepFun + (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2)))))) + ; apply Rplus_le_compat_l; apply StepFun_P34; try assumption. + apply Rle_lt_trans with + (RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H11) (psi1 n))) + + RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H13) (psi2 n)))). + apply Rle_trans with + (RiemannInt_SF + (mkStepFun + (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1)))) + + RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H13) (psi2 n)))). + apply Rplus_le_compat_l; apply StepFun_P37; try assumption. + intros; simpl in |- *; rewrite Rmult_1_l; + apply Rle_trans with (Rabs (f x - phi3 x) + Rabs (f x - phi2 x)). + rewrite <- (Rabs_Ropp (f x - phi3 x)); rewrite Ropp_minus_distr; + replace (phi3 x + -1 * phi2 x) with (phi3 x - f x + (f x - phi2 x)); + [ apply Rabs_triang | ring ]. + apply Rplus_le_compat. + apply H1. + elim H14; intros; split. + replace (Rmin a c) with a. + apply Rle_trans with b; try assumption. + left; assumption. + unfold Rmin in |- *; case (Rle_dec a c); intro; + [ reflexivity | elim n0; apply Rle_trans with b; assumption ]. + replace (Rmax a c) with c. + left; assumption. + unfold Rmax in |- *; case (Rle_dec a c); intro; + [ reflexivity | elim n0; apply Rle_trans with b; assumption ]. + apply H3. + elim H14; intros; split. + replace (Rmin b c) with b. + left; assumption. + unfold Rmin in |- *; case (Rle_dec b c); intro; + [ reflexivity | elim n0; assumption ]. + replace (Rmax b c) with c. + left; assumption. + unfold Rmax in |- *; case (Rle_dec b c); intro; + [ reflexivity | elim n0; assumption ]. + do 2 + rewrite <- + (Rplus_comm + (RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H13) (psi2 n))))) + ; apply Rplus_le_compat_l; apply StepFun_P37; try assumption. + intros; simpl in |- *; rewrite Rmult_1_l; + apply Rle_trans with (Rabs (f x - phi3 x) + Rabs (f x - phi1 x)). + rewrite <- (Rabs_Ropp (f x - phi3 x)); rewrite Ropp_minus_distr; + replace (phi3 x + -1 * phi1 x) with (phi3 x - f x + (f x - phi1 x)); + [ apply Rabs_triang | ring ]. + apply Rplus_le_compat. + apply H1. + elim H14; intros; split. + replace (Rmin a c) with a. + left; assumption. + unfold Rmin in |- *; case (Rle_dec a c); intro; + [ reflexivity | elim n0; apply Rle_trans with b; assumption ]. + replace (Rmax a c) with c. + apply Rle_trans with b. + left; assumption. + assumption. + unfold Rmax in |- *; case (Rle_dec a c); intro; + [ reflexivity | elim n0; apply Rle_trans with b; assumption ]. + apply H8. + elim H14; intros; split. + replace (Rmin a b) with a. + left; assumption. + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. + replace (Rmax a b) with b. + left; assumption. + unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n0; assumption ]. + do 2 rewrite StepFun_P30. + do 2 rewrite Rmult_1_l; + replace + (RiemannInt_SF (mkStepFun H11) + RiemannInt_SF (psi1 n) + + (RiemannInt_SF (mkStepFun H13) + RiemannInt_SF (psi2 n))) with + (RiemannInt_SF (psi3 n) + RiemannInt_SF (psi1 n) + RiemannInt_SF (psi2 n)). + replace eps with (eps / 3 + eps / 3 + eps / 3). + repeat rewrite Rplus_assoc; repeat apply Rplus_lt_compat. + apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi3 n))). + apply RRle_abs. + apply Rlt_trans with (pos (RinvN n)). + assumption. + apply H5; assumption. + apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))). + apply RRle_abs. + apply Rlt_trans with (pos (RinvN n)). + assumption. + apply H5; assumption. + apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))). + apply RRle_abs. + apply Rlt_trans with (pos (RinvN n)). + assumption. + apply H5; assumption. + apply Rmult_eq_reg_l with 3; + [ unfold Rdiv in |- *; repeat rewrite Rmult_plus_distr_l; + do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ ring | discrR ] + | discrR ]. + replace (RiemannInt_SF (psi3 n)) with + (RiemannInt_SF (mkStepFun (pre (psi3 n)))). + rewrite <- (StepFun_P43 H11 H13 (pre (psi3 n))); ring. + reflexivity. + rewrite StepFun_P30; ring. + rewrite StepFun_P30; ring. + apply (StepFun_P43 H10 H12 (pre phi3)). Qed. Lemma RiemannInt_P26 : - forall (f:R -> R) (a b c:R) (pr1:Riemann_integrable f a b) - (pr2:Riemann_integrable f b c) (pr3:Riemann_integrable f a c), - RiemannInt pr1 + RiemannInt pr2 = RiemannInt pr3. -intros; case (Rle_dec a b); case (Rle_dec b c); intros. -apply RiemannInt_P25; assumption. -case (Rle_dec a c); intro. -assert (H : c <= b). -auto with real. -rewrite <- (RiemannInt_P25 pr3 (RiemannInt_P1 pr2) pr1 r0 H); - rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); ring. -assert (H : c <= a). -auto with real. -rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); - rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr3) pr1 (RiemannInt_P1 pr2) H r); - rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); ring. -assert (H : b <= a). -auto with real. -case (Rle_dec a c); intro. -rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr1) pr3 pr2 H r0); - rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); ring. -assert (H0 : c <= a). -auto with real. -rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); - rewrite <- (RiemannInt_P25 pr2 (RiemannInt_P1 pr3) (RiemannInt_P1 pr1) r H0); - rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); ring. -rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); - rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); - rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); - rewrite <- - (RiemannInt_P25 (RiemannInt_P1 pr2) (RiemannInt_P1 pr1) (RiemannInt_P1 pr3)) - ; [ ring | auto with real | auto with real ]. + forall (f:R -> R) (a b c:R) (pr1:Riemann_integrable f a b) + (pr2:Riemann_integrable f b c) (pr3:Riemann_integrable f a c), + RiemannInt pr1 + RiemannInt pr2 = RiemannInt pr3. +Proof. + intros; case (Rle_dec a b); case (Rle_dec b c); intros. + apply RiemannInt_P25; assumption. + case (Rle_dec a c); intro. + assert (H : c <= b). + auto with real. + rewrite <- (RiemannInt_P25 pr3 (RiemannInt_P1 pr2) pr1 r0 H); + rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); ring. + assert (H : c <= a). + auto with real. + rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); + rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr3) pr1 (RiemannInt_P1 pr2) H r); + rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); ring. + assert (H : b <= a). + auto with real. + case (Rle_dec a c); intro. + rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr1) pr3 pr2 H r0); + rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); ring. + assert (H0 : c <= a). + auto with real. + rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); + rewrite <- (RiemannInt_P25 pr2 (RiemannInt_P1 pr3) (RiemannInt_P1 pr1) r H0); + rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); ring. + rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); + rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); + rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); + rewrite <- + (RiemannInt_P25 (RiemannInt_P1 pr2) (RiemannInt_P1 pr1) (RiemannInt_P1 pr3)) + ; [ ring | auto with real | auto with real ]. Qed. Lemma RiemannInt_P27 : - forall (f:R -> R) (a b x:R) (h:a <= b) - (C0:forall x:R, a <= x <= b -> continuity_pt f x), - a < x < b -> derivable_pt_lim (primitive h (FTC_P1 h C0)) x (f x). -intro f; intros; elim H; clear H; intros; assert (H1 : continuity_pt f x). -apply C0; split; left; assumption. -unfold derivable_pt_lim in |- *; intros; assert (Hyp : 0 < eps / 2). -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. -elim (H1 _ Hyp); unfold dist, D_x, no_cond in |- *; simpl in |- *; - unfold R_dist in |- *; intros; set (del := Rmin x0 (Rmin (b - x) (x - a))); - assert (H4 : 0 < del). -unfold del in |- *; unfold Rmin in |- *; case (Rle_dec (b - x) (x - a)); - intro. -case (Rle_dec x0 (b - x)); intro; - [ elim H3; intros; assumption | apply Rlt_Rminus; assumption ]. -case (Rle_dec x0 (x - a)); intro; - [ elim H3; intros; assumption | apply Rlt_Rminus; assumption ]. -split with (mkposreal _ H4); intros; - assert (H7 : Riemann_integrable f x (x + h0)). -case (Rle_dec x (x + h0)); intro. -apply continuity_implies_RiemannInt; try assumption. -intros; apply C0; elim H7; intros; split. -apply Rle_trans with x; [ left; assumption | assumption ]. -apply Rle_trans with (x + h0). -assumption. -left; apply Rlt_le_trans with (x + del). -apply Rplus_lt_compat_l; apply Rle_lt_trans with (Rabs h0); - [ apply RRle_abs | apply H6 ]. -unfold del in |- *; apply Rle_trans with (x + Rmin (b - x) (x - a)). -apply Rplus_le_compat_l; apply Rmin_r. -pattern b at 2 in |- *; replace b with (x + (b - x)); - [ apply Rplus_le_compat_l; apply Rmin_l | ring ]. -apply RiemannInt_P1; apply continuity_implies_RiemannInt; auto with real. -intros; apply C0; elim H7; intros; split. -apply Rle_trans with (x + h0). -left; apply Rle_lt_trans with (x - del). -unfold del in |- *; apply Rle_trans with (x - Rmin (b - x) (x - a)). -pattern a at 1 in |- *; replace a with (x + (a - x)); [ idtac | ring ]. -unfold Rminus in |- *; apply Rplus_le_compat_l; apply Ropp_le_cancel. -rewrite Ropp_involutive; rewrite Ropp_plus_distr; rewrite Ropp_involutive; - rewrite (Rplus_comm x); apply Rmin_r. -unfold Rminus in |- *; apply Rplus_le_compat_l; apply Ropp_le_cancel. -do 2 rewrite Ropp_involutive; apply Rmin_r. -unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_cancel. -rewrite Ropp_involutive; apply Rle_lt_trans with (Rabs h0); - [ rewrite <- Rabs_Ropp; apply RRle_abs | apply H6 ]. -assumption. -apply Rle_trans with x; [ assumption | left; assumption ]. -replace (primitive h (FTC_P1 h C0) (x + h0) - primitive h (FTC_P1 h C0) x) - with (RiemannInt H7). -replace (f x) with (RiemannInt (RiemannInt_P14 x (x + h0) (f x)) / h0). -replace - (RiemannInt H7 / h0 - RiemannInt (RiemannInt_P14 x (x + h0) (f x)) / h0) - with ((RiemannInt H7 - RiemannInt (RiemannInt_P14 x (x + h0) (f x))) / h0). -replace (RiemannInt H7 - RiemannInt (RiemannInt_P14 x (x + h0) (f x))) with - (RiemannInt (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))). -unfold Rdiv in |- *; rewrite Rabs_mult; case (Rle_dec x (x + h0)); intro. -apply Rle_lt_trans with - (RiemannInt - (RiemannInt_P16 - (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))) * - Rabs (/ h0)). -do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. -apply Rabs_pos. -apply - (RiemannInt_P17 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))) - (RiemannInt_P16 - (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))))); - assumption. -apply Rle_lt_trans with - (RiemannInt (RiemannInt_P14 x (x + h0) (eps / 2)) * Rabs (/ h0)). -do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. -apply Rabs_pos. -apply RiemannInt_P19; try assumption. -intros; replace (f x1 + -1 * fct_cte (f x) x1) with (f x1 - f x). -unfold fct_cte in |- *; case (Req_dec x x1); intro. -rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; left; - assumption. -elim H3; intros; left; apply H11. -repeat split. -assumption. -rewrite Rabs_right. -apply Rplus_lt_reg_r with x; replace (x + (x1 - x)) with x1; [ idtac | ring ]. -apply Rlt_le_trans with (x + h0). -elim H8; intros; assumption. -apply Rplus_le_compat_l; apply Rle_trans with del. -left; apply Rle_lt_trans with (Rabs h0); [ apply RRle_abs | assumption ]. -unfold del in |- *; apply Rmin_l. -apply Rge_minus; apply Rle_ge; left; elim H8; intros; assumption. -unfold fct_cte in |- *; ring. -rewrite RiemannInt_P15. -rewrite Rmult_assoc; replace ((x + h0 - x) * Rabs (/ h0)) with 1. -rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2; - [ prove_sup0 - | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r; - rewrite double; apply Rplus_lt_compat_l; assumption - | discrR ] ]. -rewrite Rabs_right. -replace (x + h0 - x) with h0; [ idtac | ring ]. -apply Rinv_r_sym. -assumption. -apply Rle_ge; left; apply Rinv_0_lt_compat. -elim r; intro. -apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; assumption. -elim H5; symmetry in |- *; apply Rplus_eq_reg_l with x; rewrite Rplus_0_r; - assumption. -apply Rle_lt_trans with - (RiemannInt - (RiemannInt_P16 - (RiemannInt_P1 + forall (f:R -> R) (a b x:R) (h:a <= b) + (C0:forall x:R, a <= x <= b -> continuity_pt f x), + a < x < b -> derivable_pt_lim (primitive h (FTC_P1 h C0)) x (f x). +Proof. + intro f; intros; elim H; clear H; intros; assert (H1 : continuity_pt f x). + apply C0; split; left; assumption. + unfold derivable_pt_lim in |- *; intros; assert (Hyp : 0 < eps / 2). + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. + elim (H1 _ Hyp); unfold dist, D_x, no_cond in |- *; simpl in |- *; + unfold R_dist in |- *; intros; set (del := Rmin x0 (Rmin (b - x) (x - a))); + assert (H4 : 0 < del). + unfold del in |- *; unfold Rmin in |- *; case (Rle_dec (b - x) (x - a)); + intro. + case (Rle_dec x0 (b - x)); intro; + [ elim H3; intros; assumption | apply Rlt_Rminus; assumption ]. + case (Rle_dec x0 (x - a)); intro; + [ elim H3; intros; assumption | apply Rlt_Rminus; assumption ]. + split with (mkposreal _ H4); intros; + assert (H7 : Riemann_integrable f x (x + h0)). + case (Rle_dec x (x + h0)); intro. + apply continuity_implies_RiemannInt; try assumption. + intros; apply C0; elim H7; intros; split. + apply Rle_trans with x; [ left; assumption | assumption ]. + apply Rle_trans with (x + h0). + assumption. + left; apply Rlt_le_trans with (x + del). + apply Rplus_lt_compat_l; apply Rle_lt_trans with (Rabs h0); + [ apply RRle_abs | apply H6 ]. + unfold del in |- *; apply Rle_trans with (x + Rmin (b - x) (x - a)). + apply Rplus_le_compat_l; apply Rmin_r. + pattern b at 2 in |- *; replace b with (x + (b - x)); + [ apply Rplus_le_compat_l; apply Rmin_l | ring ]. + apply RiemannInt_P1; apply continuity_implies_RiemannInt; auto with real. + intros; apply C0; elim H7; intros; split. + apply Rle_trans with (x + h0). + left; apply Rle_lt_trans with (x - del). + unfold del in |- *; apply Rle_trans with (x - Rmin (b - x) (x - a)). + pattern a at 1 in |- *; replace a with (x + (a - x)); [ idtac | ring ]. + unfold Rminus in |- *; apply Rplus_le_compat_l; apply Ropp_le_cancel. + rewrite Ropp_involutive; rewrite Ropp_plus_distr; rewrite Ropp_involutive; + rewrite (Rplus_comm x); apply Rmin_r. + unfold Rminus in |- *; apply Rplus_le_compat_l; apply Ropp_le_cancel. + do 2 rewrite Ropp_involutive; apply Rmin_r. + unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_cancel. + rewrite Ropp_involutive; apply Rle_lt_trans with (Rabs h0); + [ rewrite <- Rabs_Ropp; apply RRle_abs | apply H6 ]. + assumption. + apply Rle_trans with x; [ assumption | left; assumption ]. + replace (primitive h (FTC_P1 h C0) (x + h0) - primitive h (FTC_P1 h C0) x) + with (RiemannInt H7). + replace (f x) with (RiemannInt (RiemannInt_P14 x (x + h0) (f x)) / h0). + replace + (RiemannInt H7 / h0 - RiemannInt (RiemannInt_P14 x (x + h0) (f x)) / h0) + with ((RiemannInt H7 - RiemannInt (RiemannInt_P14 x (x + h0) (f x))) / h0). + replace (RiemannInt H7 - RiemannInt (RiemannInt_P14 x (x + h0) (f x))) with + (RiemannInt (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))). + unfold Rdiv in |- *; rewrite Rabs_mult; case (Rle_dec x (x + h0)); intro. + apply Rle_lt_trans with + (RiemannInt + (RiemannInt_P16 + (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))) * + Rabs (/ h0)). + do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. + apply Rabs_pos. + apply + (RiemannInt_P17 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))) + (RiemannInt_P16 + (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))))); + assumption. + apply Rle_lt_trans with + (RiemannInt (RiemannInt_P14 x (x + h0) (eps / 2)) * Rabs (/ h0)). + do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. + apply Rabs_pos. + apply RiemannInt_P19; try assumption. + intros; replace (f x1 + -1 * fct_cte (f x) x1) with (f x1 - f x). + unfold fct_cte in |- *; case (Req_dec x x1); intro. + rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; left; + assumption. + elim H3; intros; left; apply H11. + repeat split. + assumption. + rewrite Rabs_right. + apply Rplus_lt_reg_r with x; replace (x + (x1 - x)) with x1; [ idtac | ring ]. + apply Rlt_le_trans with (x + h0). + elim H8; intros; assumption. + apply Rplus_le_compat_l; apply Rle_trans with del. + left; apply Rle_lt_trans with (Rabs h0); [ apply RRle_abs | assumption ]. + unfold del in |- *; apply Rmin_l. + apply Rge_minus; apply Rle_ge; left; elim H8; intros; assumption. + unfold fct_cte in |- *; ring. + rewrite RiemannInt_P15. + rewrite Rmult_assoc; replace ((x + h0 - x) * Rabs (/ h0)) with 1. + rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r; + rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. + rewrite Rabs_right. + replace (x + h0 - x) with h0; [ idtac | ring ]. + apply Rinv_r_sym. + assumption. + apply Rle_ge; left; apply Rinv_0_lt_compat. + elim r; intro. + apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; assumption. + elim H5; symmetry in |- *; apply Rplus_eq_reg_l with x; rewrite Rplus_0_r; + assumption. + apply Rle_lt_trans with + (RiemannInt + (RiemannInt_P16 + (RiemannInt_P1 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))))) * - Rabs (/ h0)). -do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. -apply Rabs_pos. -replace - (RiemannInt (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))) with - (- - RiemannInt + Rabs (/ h0)). + do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. + apply Rabs_pos. + replace + (RiemannInt (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))) with + (- + RiemannInt (RiemannInt_P1 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))))). -rewrite Rabs_Ropp; - apply - (RiemannInt_P17 - (RiemannInt_P1 - (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))) - (RiemannInt_P16 + rewrite Rabs_Ropp; + apply + (RiemannInt_P17 (RiemannInt_P1 - (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))))); - auto with real. -symmetry in |- *; apply RiemannInt_P8. -apply Rle_lt_trans with - (RiemannInt (RiemannInt_P14 (x + h0) x (eps / 2)) * Rabs (/ h0)). -do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. -apply Rabs_pos. -apply RiemannInt_P19. -auto with real. -intros; replace (f x1 + -1 * fct_cte (f x) x1) with (f x1 - f x). -unfold fct_cte in |- *; case (Req_dec x x1); intro. -rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; left; - assumption. -elim H3; intros; left; apply H11. -repeat split. -assumption. -rewrite Rabs_left. -apply Rplus_lt_reg_r with (x1 - x0); replace (x1 - x0 + x0) with x1; - [ idtac | ring ]. -replace (x1 - x0 + - (x1 - x)) with (x - x0); [ idtac | ring ]. -apply Rle_lt_trans with (x + h0). -unfold Rminus in |- *; apply Rplus_le_compat_l; apply Ropp_le_cancel. -rewrite Ropp_involutive; apply Rle_trans with (Rabs h0). -rewrite <- Rabs_Ropp; apply RRle_abs. -apply Rle_trans with del; - [ left; assumption | unfold del in |- *; apply Rmin_l ]. -elim H8; intros; assumption. -apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; - replace (x + (x1 - x)) with x1; [ elim H8; intros; assumption | ring ]. -unfold fct_cte in |- *; ring. -rewrite RiemannInt_P15. -rewrite Rmult_assoc; replace ((x - (x + h0)) * Rabs (/ h0)) with 1. -rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2; - [ prove_sup0 - | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r; - rewrite double; apply Rplus_lt_compat_l; assumption - | discrR ] ]. -rewrite Rabs_left. -replace (x - (x + h0)) with (- h0); [ idtac | ring ]. -rewrite Ropp_mult_distr_l_reverse; rewrite Ropp_mult_distr_r_reverse; - rewrite Ropp_involutive; apply Rinv_r_sym. -assumption. -apply Rinv_lt_0_compat. -assert (H8 : x + h0 < x). -auto with real. -apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; assumption. -rewrite - (RiemannInt_P13 H7 (RiemannInt_P14 x (x + h0) (f x)) - (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))) - . -ring. -unfold Rdiv, Rminus in |- *; rewrite Rmult_plus_distr_r; ring. -rewrite RiemannInt_P15; apply Rmult_eq_reg_l with h0; - [ unfold Rdiv in |- *; rewrite (Rmult_comm h0); repeat rewrite Rmult_assoc; - rewrite <- Rinv_l_sym; [ ring | assumption ] - | assumption ]. -cut (a <= x + h0). -cut (x + h0 <= b). -intros; unfold primitive in |- *. -case (Rle_dec a (x + h0)); case (Rle_dec (x + h0) b); case (Rle_dec a x); - case (Rle_dec x b); intros; try (elim n; assumption || left; assumption). -rewrite <- (RiemannInt_P26 (FTC_P1 h C0 r0 r) H7 (FTC_P1 h C0 r2 r1)); ring. -apply Rplus_le_reg_l with (- x); replace (- x + (x + h0)) with h0; - [ idtac | ring ]. -rewrite Rplus_comm; apply Rle_trans with (Rabs h0). -apply RRle_abs. -apply Rle_trans with del; - [ left; assumption - | unfold del in |- *; apply Rle_trans with (Rmin (b - x) (x - a)); - [ apply Rmin_r | apply Rmin_l ] ]. -apply Ropp_le_cancel; apply Rplus_le_reg_l with x; - replace (x + - (x + h0)) with (- h0); [ idtac | ring ]. -apply Rle_trans with (Rabs h0); - [ rewrite <- Rabs_Ropp; apply RRle_abs - | apply Rle_trans with del; + (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))) + (RiemannInt_P16 + (RiemannInt_P1 + (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))))); + auto with real. + symmetry in |- *; apply RiemannInt_P8. + apply Rle_lt_trans with + (RiemannInt (RiemannInt_P14 (x + h0) x (eps / 2)) * Rabs (/ h0)). + do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. + apply Rabs_pos. + apply RiemannInt_P19. + auto with real. + intros; replace (f x1 + -1 * fct_cte (f x) x1) with (f x1 - f x). + unfold fct_cte in |- *; case (Req_dec x x1); intro. + rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; left; + assumption. + elim H3; intros; left; apply H11. + repeat split. + assumption. + rewrite Rabs_left. + apply Rplus_lt_reg_r with (x1 - x0); replace (x1 - x0 + x0) with x1; + [ idtac | ring ]. + replace (x1 - x0 + - (x1 - x)) with (x - x0); [ idtac | ring ]. + apply Rle_lt_trans with (x + h0). + unfold Rminus in |- *; apply Rplus_le_compat_l; apply Ropp_le_cancel. + rewrite Ropp_involutive; apply Rle_trans with (Rabs h0). + rewrite <- Rabs_Ropp; apply RRle_abs. + apply Rle_trans with del; + [ left; assumption | unfold del in |- *; apply Rmin_l ]. + elim H8; intros; assumption. + apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; + replace (x + (x1 - x)) with x1; [ elim H8; intros; assumption | ring ]. + unfold fct_cte in |- *; ring. + rewrite RiemannInt_P15. + rewrite Rmult_assoc; replace ((x - (x + h0)) * Rabs (/ h0)) with 1. + rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r; + rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. + rewrite Rabs_left. + replace (x - (x + h0)) with (- h0); [ idtac | ring ]. + rewrite Ropp_mult_distr_l_reverse; rewrite Ropp_mult_distr_r_reverse; + rewrite Ropp_involutive; apply Rinv_r_sym. + assumption. + apply Rinv_lt_0_compat. + assert (H8 : x + h0 < x). + auto with real. + apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; assumption. + rewrite + (RiemannInt_P13 H7 (RiemannInt_P14 x (x + h0) (f x)) + (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))) + . + ring. + unfold Rdiv, Rminus in |- *; rewrite Rmult_plus_distr_r; ring. + rewrite RiemannInt_P15; apply Rmult_eq_reg_l with h0; + [ unfold Rdiv in |- *; rewrite (Rmult_comm h0); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ ring | assumption ] + | assumption ]. + cut (a <= x + h0). + cut (x + h0 <= b). + intros; unfold primitive in |- *. + case (Rle_dec a (x + h0)); case (Rle_dec (x + h0) b); case (Rle_dec a x); + case (Rle_dec x b); intros; try (elim n; assumption || left; assumption). + rewrite <- (RiemannInt_P26 (FTC_P1 h C0 r0 r) H7 (FTC_P1 h C0 r2 r1)); ring. + apply Rplus_le_reg_l with (- x); replace (- x + (x + h0)) with h0; + [ idtac | ring ]. + rewrite Rplus_comm; apply Rle_trans with (Rabs h0). + apply RRle_abs. + apply Rle_trans with del; [ left; assumption - | unfold del in |- *; apply Rle_trans with (Rmin (b - x) (x - a)); - apply Rmin_r ] ]. + | unfold del in |- *; apply Rle_trans with (Rmin (b - x) (x - a)); + [ apply Rmin_r | apply Rmin_l ] ]. + apply Ropp_le_cancel; apply Rplus_le_reg_l with x; + replace (x + - (x + h0)) with (- h0); [ idtac | ring ]. + apply Rle_trans with (Rabs h0); + [ rewrite <- Rabs_Ropp; apply RRle_abs + | apply Rle_trans with del; + [ left; assumption + | unfold del in |- *; apply Rle_trans with (Rmin (b - x) (x - a)); + apply Rmin_r ] ]. Qed. Lemma RiemannInt_P28 : - forall (f:R -> R) (a b x:R) (h:a <= b) - (C0:forall x:R, a <= x <= b -> continuity_pt f x), - a <= x <= b -> derivable_pt_lim (primitive h (FTC_P1 h C0)) x (f x). -intro f; intros; elim h; intro. -elim H; clear H; intros; elim H; intro. -elim H1; intro. -apply RiemannInt_P27; split; assumption. -set - (f_b := fun x:R => f b * (x - b) + RiemannInt (FTC_P1 h C0 h (Rle_refl b))); - rewrite H3. -assert (H4 : derivable_pt_lim f_b b (f b)). -unfold f_b in |- *; pattern (f b) at 2 in |- *; replace (f b) with (f b + 0). -change - (derivable_pt_lim - ((fct_cte (f b) * (id - fct_cte b))%F + - fct_cte (RiemannInt (FTC_P1 h C0 h (Rle_refl b)))) b ( - f b + 0)) in |- *. -apply derivable_pt_lim_plus. -pattern (f b) at 2 in |- *; - replace (f b) with (0 * (id - fct_cte b)%F b + fct_cte (f b) b * 1). -apply derivable_pt_lim_mult. -apply derivable_pt_lim_const. -replace 1 with (1 - 0); [ idtac | ring ]. -apply derivable_pt_lim_minus. -apply derivable_pt_lim_id. -apply derivable_pt_lim_const. -unfold fct_cte in |- *; ring. -apply derivable_pt_lim_const. -ring. -unfold derivable_pt_lim in |- *; intros; elim (H4 _ H5); intros; - assert (H7 : continuity_pt f b). -apply C0; split; [ left; assumption | right; reflexivity ]. -assert (H8 : 0 < eps / 2). -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. -elim (H7 _ H8); unfold D_x, no_cond, dist in |- *; simpl in |- *; - unfold R_dist in |- *; intros; set (del := Rmin x0 (Rmin x1 (b - a))); - assert (H10 : 0 < del). -unfold del in |- *; unfold Rmin in |- *; case (Rle_dec x1 (b - a)); intros. -case (Rle_dec x0 x1); intro; - [ apply (cond_pos x0) | elim H9; intros; assumption ]. -case (Rle_dec x0 (b - a)); intro; - [ apply (cond_pos x0) | apply Rlt_Rminus; assumption ]. -split with (mkposreal _ H10); intros; case (Rcase_abs h0); intro. -assert (H14 : b + h0 < b). -pattern b at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; - assumption. -assert (H13 : Riemann_integrable f (b + h0) b). -apply continuity_implies_RiemannInt. -left; assumption. -intros; apply C0; elim H13; intros; split; try assumption. -apply Rle_trans with (b + h0); try assumption. -apply Rplus_le_reg_l with (- a - h0). -replace (- a - h0 + a) with (- h0); [ idtac | ring ]. -replace (- a - h0 + (b + h0)) with (b - a); [ idtac | ring ]. -apply Rle_trans with del. -apply Rle_trans with (Rabs h0). -rewrite <- Rabs_Ropp; apply RRle_abs. -left; assumption. -unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r. -replace (primitive h (FTC_P1 h C0) (b + h0) - primitive h (FTC_P1 h C0) b) - with (- RiemannInt H13). -replace (f b) with (- RiemannInt (RiemannInt_P14 (b + h0) b (f b)) / h0). -rewrite <- Rabs_Ropp; unfold Rminus in |- *; unfold Rdiv in |- *; - rewrite Ropp_mult_distr_l_reverse; rewrite Ropp_plus_distr; - repeat rewrite Ropp_involutive; - replace - (RiemannInt H13 * / h0 + - - RiemannInt (RiemannInt_P14 (b + h0) b (f b)) * / h0) with - ((RiemannInt H13 - RiemannInt (RiemannInt_P14 (b + h0) b (f b))) / h0). -replace (RiemannInt H13 - RiemannInt (RiemannInt_P14 (b + h0) b (f b))) with - (RiemannInt (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b)))). -unfold Rdiv in |- *; rewrite Rabs_mult; - apply Rle_lt_trans with - (RiemannInt - (RiemannInt_P16 - (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b)))) * - Rabs (/ h0)). -do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. -apply Rabs_pos. -apply - (RiemannInt_P17 (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b))) - (RiemannInt_P16 - (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b))))); - left; assumption. -apply Rle_lt_trans with - (RiemannInt (RiemannInt_P14 (b + h0) b (eps / 2)) * Rabs (/ h0)). -do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. -apply Rabs_pos. -apply RiemannInt_P19. -left; assumption. -intros; replace (f x2 + -1 * fct_cte (f b) x2) with (f x2 - f b). -unfold fct_cte in |- *; case (Req_dec b x2); intro. -rewrite H16; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; - left; assumption. -elim H9; intros; left; apply H18. -repeat split. -assumption. -rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; rewrite Rabs_right. -apply Rplus_lt_reg_r with (x2 - x1); - replace (x2 - x1 + (b - x2)) with (b - x1); [ idtac | ring ]. -replace (x2 - x1 + x1) with x2; [ idtac | ring ]. -apply Rlt_le_trans with (b + h0). -2: elim H15; intros; left; assumption. -unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_cancel; - rewrite Ropp_involutive; apply Rle_lt_trans with (Rabs h0). -rewrite <- Rabs_Ropp; apply RRle_abs. -apply Rlt_le_trans with del; - [ assumption - | unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); - [ apply Rmin_r | apply Rmin_l ] ]. -apply Rle_ge; left; apply Rlt_Rminus; elim H15; intros; assumption. -unfold fct_cte in |- *; ring. -rewrite RiemannInt_P15. -rewrite Rmult_assoc; replace ((b - (b + h0)) * Rabs (/ h0)) with 1. -rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2; - [ prove_sup0 - | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r; - rewrite double; apply Rplus_lt_compat_l; assumption - | discrR ] ]. -rewrite Rabs_left. -apply Rmult_eq_reg_l with h0; - [ do 2 rewrite (Rmult_comm h0); rewrite Rmult_assoc; - rewrite Ropp_mult_distr_l_reverse; rewrite <- Rinv_l_sym; - [ ring | assumption ] - | assumption ]. -apply Rinv_lt_0_compat; assumption. -rewrite - (RiemannInt_P13 H13 (RiemannInt_P14 (b + h0) b (f b)) - (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b)))) - ; ring. -unfold Rdiv, Rminus in |- *; rewrite Rmult_plus_distr_r; ring. -rewrite RiemannInt_P15. -rewrite <- Ropp_mult_distr_l_reverse; apply Rmult_eq_reg_l with h0; - [ repeat rewrite (Rmult_comm h0); unfold Rdiv in |- *; - repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym; - [ ring | assumption ] - | assumption ]. -cut (a <= b + h0). -cut (b + h0 <= b). -intros; unfold primitive in |- *; case (Rle_dec a (b + h0)); - case (Rle_dec (b + h0) b); case (Rle_dec a b); case (Rle_dec b b); - intros; try (elim n; right; reflexivity) || (elim n; left; assumption). -rewrite <- (RiemannInt_P26 (FTC_P1 h C0 r3 r2) H13 (FTC_P1 h C0 r1 r0)); ring. -elim n; assumption. -left; assumption. -apply Rplus_le_reg_l with (- a - h0). -replace (- a - h0 + a) with (- h0); [ idtac | ring ]. -replace (- a - h0 + (b + h0)) with (b - a); [ idtac | ring ]. -apply Rle_trans with del. -apply Rle_trans with (Rabs h0). -rewrite <- Rabs_Ropp; apply RRle_abs. -left; assumption. -unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r. -cut (primitive h (FTC_P1 h C0) b = f_b b). -intro; cut (primitive h (FTC_P1 h C0) (b + h0) = f_b (b + h0)). -intro; rewrite H13; rewrite H14; apply H6. -assumption. -apply Rlt_le_trans with del; - [ assumption | unfold del in |- *; apply Rmin_l ]. -assert (H14 : b < b + h0). -pattern b at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l. -assert (H14 := Rge_le _ _ r); elim H14; intro. -assumption. -elim H11; symmetry in |- *; assumption. -unfold primitive in |- *; case (Rle_dec a (b + h0)); - case (Rle_dec (b + h0) b); intros; - [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 H14)) - | unfold f_b in |- *; reflexivity - | elim n; left; apply Rlt_trans with b; assumption - | elim n0; left; apply Rlt_trans with b; assumption ]. -unfold f_b in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; - rewrite Rmult_0_r; rewrite Rplus_0_l; unfold primitive in |- *; - case (Rle_dec a b); case (Rle_dec b b); intros; - [ apply RiemannInt_P5 - | elim n; right; reflexivity - | elim n; left; assumption - | elim n; right; reflexivity ]. + forall (f:R -> R) (a b x:R) (h:a <= b) + (C0:forall x:R, a <= x <= b -> continuity_pt f x), + a <= x <= b -> derivable_pt_lim (primitive h (FTC_P1 h C0)) x (f x). +Proof. + intro f; intros; elim h; intro. + elim H; clear H; intros; elim H; intro. + elim H1; intro. + apply RiemannInt_P27; split; assumption. + set + (f_b := fun x:R => f b * (x - b) + RiemannInt (FTC_P1 h C0 h (Rle_refl b))); + rewrite H3. + assert (H4 : derivable_pt_lim f_b b (f b)). + unfold f_b in |- *; pattern (f b) at 2 in |- *; replace (f b) with (f b + 0). + change + (derivable_pt_lim + ((fct_cte (f b) * (id - fct_cte b))%F + + fct_cte (RiemannInt (FTC_P1 h C0 h (Rle_refl b)))) b ( + f b + 0)) in |- *. + apply derivable_pt_lim_plus. + pattern (f b) at 2 in |- *; + replace (f b) with (0 * (id - fct_cte b)%F b + fct_cte (f b) b * 1). + apply derivable_pt_lim_mult. + apply derivable_pt_lim_const. + replace 1 with (1 - 0); [ idtac | ring ]. + apply derivable_pt_lim_minus. + apply derivable_pt_lim_id. + apply derivable_pt_lim_const. + unfold fct_cte in |- *; ring. + apply derivable_pt_lim_const. + ring. + unfold derivable_pt_lim in |- *; intros; elim (H4 _ H5); intros; + assert (H7 : continuity_pt f b). + apply C0; split; [ left; assumption | right; reflexivity ]. + assert (H8 : 0 < eps / 2). + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. + elim (H7 _ H8); unfold D_x, no_cond, dist in |- *; simpl in |- *; + unfold R_dist in |- *; intros; set (del := Rmin x0 (Rmin x1 (b - a))); + assert (H10 : 0 < del). + unfold del in |- *; unfold Rmin in |- *; case (Rle_dec x1 (b - a)); intros. + case (Rle_dec x0 x1); intro; + [ apply (cond_pos x0) | elim H9; intros; assumption ]. + case (Rle_dec x0 (b - a)); intro; + [ apply (cond_pos x0) | apply Rlt_Rminus; assumption ]. + split with (mkposreal _ H10); intros; case (Rcase_abs h0); intro. + assert (H14 : b + h0 < b). + pattern b at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + assumption. + assert (H13 : Riemann_integrable f (b + h0) b). + apply continuity_implies_RiemannInt. + left; assumption. + intros; apply C0; elim H13; intros; split; try assumption. + apply Rle_trans with (b + h0); try assumption. + apply Rplus_le_reg_l with (- a - h0). + replace (- a - h0 + a) with (- h0); [ idtac | ring ]. + replace (- a - h0 + (b + h0)) with (b - a); [ idtac | ring ]. + apply Rle_trans with del. + apply Rle_trans with (Rabs h0). + rewrite <- Rabs_Ropp; apply RRle_abs. + left; assumption. + unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r. + replace (primitive h (FTC_P1 h C0) (b + h0) - primitive h (FTC_P1 h C0) b) + with (- RiemannInt H13). + replace (f b) with (- RiemannInt (RiemannInt_P14 (b + h0) b (f b)) / h0). + rewrite <- Rabs_Ropp; unfold Rminus in |- *; unfold Rdiv in |- *; + rewrite Ropp_mult_distr_l_reverse; rewrite Ropp_plus_distr; + repeat rewrite Ropp_involutive; + replace + (RiemannInt H13 * / h0 + + - RiemannInt (RiemannInt_P14 (b + h0) b (f b)) * / h0) with + ((RiemannInt H13 - RiemannInt (RiemannInt_P14 (b + h0) b (f b))) / h0). + replace (RiemannInt H13 - RiemannInt (RiemannInt_P14 (b + h0) b (f b))) with + (RiemannInt (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b)))). + unfold Rdiv in |- *; rewrite Rabs_mult; + apply Rle_lt_trans with + (RiemannInt + (RiemannInt_P16 + (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b)))) * + Rabs (/ h0)). + do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. + apply Rabs_pos. + apply + (RiemannInt_P17 (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b))) + (RiemannInt_P16 + (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b))))); + left; assumption. + apply Rle_lt_trans with + (RiemannInt (RiemannInt_P14 (b + h0) b (eps / 2)) * Rabs (/ h0)). + do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. + apply Rabs_pos. + apply RiemannInt_P19. + left; assumption. + intros; replace (f x2 + -1 * fct_cte (f b) x2) with (f x2 - f b). + unfold fct_cte in |- *; case (Req_dec b x2); intro. + rewrite H16; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + left; assumption. + elim H9; intros; left; apply H18. + repeat split. + assumption. + rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; rewrite Rabs_right. + apply Rplus_lt_reg_r with (x2 - x1); + replace (x2 - x1 + (b - x2)) with (b - x1); [ idtac | ring ]. + replace (x2 - x1 + x1) with x2; [ idtac | ring ]. + apply Rlt_le_trans with (b + h0). + 2: elim H15; intros; left; assumption. + unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_cancel; + rewrite Ropp_involutive; apply Rle_lt_trans with (Rabs h0). + rewrite <- Rabs_Ropp; apply RRle_abs. + apply Rlt_le_trans with del; + [ assumption + | unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); + [ apply Rmin_r | apply Rmin_l ] ]. + apply Rle_ge; left; apply Rlt_Rminus; elim H15; intros; assumption. + unfold fct_cte in |- *; ring. + rewrite RiemannInt_P15. + rewrite Rmult_assoc; replace ((b - (b + h0)) * Rabs (/ h0)) with 1. + rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r; + rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. + rewrite Rabs_left. + apply Rmult_eq_reg_l with h0; + [ do 2 rewrite (Rmult_comm h0); rewrite Rmult_assoc; + rewrite Ropp_mult_distr_l_reverse; rewrite <- Rinv_l_sym; + [ ring | assumption ] + | assumption ]. + apply Rinv_lt_0_compat; assumption. + rewrite + (RiemannInt_P13 H13 (RiemannInt_P14 (b + h0) b (f b)) + (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b)))) + ; ring. + unfold Rdiv, Rminus in |- *; rewrite Rmult_plus_distr_r; ring. + rewrite RiemannInt_P15. + rewrite <- Ropp_mult_distr_l_reverse; apply Rmult_eq_reg_l with h0; + [ repeat rewrite (Rmult_comm h0); unfold Rdiv in |- *; + repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym; + [ ring | assumption ] + | assumption ]. + cut (a <= b + h0). + cut (b + h0 <= b). + intros; unfold primitive in |- *; case (Rle_dec a (b + h0)); + case (Rle_dec (b + h0) b); case (Rle_dec a b); case (Rle_dec b b); + intros; try (elim n; right; reflexivity) || (elim n; left; assumption). + rewrite <- (RiemannInt_P26 (FTC_P1 h C0 r3 r2) H13 (FTC_P1 h C0 r1 r0)); ring. + elim n; assumption. + left; assumption. + apply Rplus_le_reg_l with (- a - h0). + replace (- a - h0 + a) with (- h0); [ idtac | ring ]. + replace (- a - h0 + (b + h0)) with (b - a); [ idtac | ring ]. + apply Rle_trans with del. + apply Rle_trans with (Rabs h0). + rewrite <- Rabs_Ropp; apply RRle_abs. + left; assumption. + unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r. + cut (primitive h (FTC_P1 h C0) b = f_b b). + intro; cut (primitive h (FTC_P1 h C0) (b + h0) = f_b (b + h0)). + intro; rewrite H13; rewrite H14; apply H6. + assumption. + apply Rlt_le_trans with del; + [ assumption | unfold del in |- *; apply Rmin_l ]. + assert (H14 : b < b + h0). + pattern b at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l. + assert (H14 := Rge_le _ _ r); elim H14; intro. + assumption. + elim H11; symmetry in |- *; assumption. + unfold primitive in |- *; case (Rle_dec a (b + h0)); + case (Rle_dec (b + h0) b); intros; + [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 H14)) + | unfold f_b in |- *; reflexivity + | elim n; left; apply Rlt_trans with b; assumption + | elim n0; left; apply Rlt_trans with b; assumption ]. + unfold f_b in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rmult_0_r; rewrite Rplus_0_l; unfold primitive in |- *; + case (Rle_dec a b); case (Rle_dec b b); intros; + [ apply RiemannInt_P5 + | elim n; right; reflexivity + | elim n; left; assumption + | elim n; right; reflexivity ]. (*****) -set (f_a := fun x:R => f a * (x - a)); rewrite <- H2; - assert (H3 : derivable_pt_lim f_a a (f a)). -unfold f_a in |- *; - change (derivable_pt_lim (fct_cte (f a) * (id - fct_cte a)%F) a (f a)) - in |- *; pattern (f a) at 2 in |- *; - replace (f a) with (0 * (id - fct_cte a)%F a + fct_cte (f a) a * 1). -apply derivable_pt_lim_mult. -apply derivable_pt_lim_const. -replace 1 with (1 - 0); [ idtac | ring ]. -apply derivable_pt_lim_minus. -apply derivable_pt_lim_id. -apply derivable_pt_lim_const. -unfold fct_cte in |- *; ring. -unfold derivable_pt_lim in |- *; intros; elim (H3 _ H4); intros. -assert (H6 : continuity_pt f a). -apply C0; split; [ right; reflexivity | left; assumption ]. -assert (H7 : 0 < eps / 2). -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. -elim (H6 _ H7); unfold D_x, no_cond, dist in |- *; simpl in |- *; - unfold R_dist in |- *; intros. -set (del := Rmin x0 (Rmin x1 (b - a))). -assert (H9 : 0 < del). -unfold del in |- *; unfold Rmin in |- *. -case (Rle_dec x1 (b - a)); intros. -case (Rle_dec x0 x1); intro. -apply (cond_pos x0). -elim H8; intros; assumption. -case (Rle_dec x0 (b - a)); intro. -apply (cond_pos x0). -apply Rlt_Rminus; assumption. -split with (mkposreal _ H9). -intros; case (Rcase_abs h0); intro. -assert (H12 : a + h0 < a). -pattern a at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; - assumption. -unfold primitive in |- *. -case (Rle_dec a (a + h0)); case (Rle_dec (a + h0) b); case (Rle_dec a a); - case (Rle_dec a b); intros; - try (elim n; left; assumption) || (elim n; right; reflexivity). -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H12)). -elim n; left; apply Rlt_trans with a; assumption. -rewrite RiemannInt_P9; replace 0 with (f_a a). -replace (f a * (a + h0 - a)) with (f_a (a + h0)). -apply H5; try assumption. -apply Rlt_le_trans with del; - [ assumption | unfold del in |- *; apply Rmin_l ]. -unfold f_a in |- *; ring. -unfold f_a in |- *; ring. -elim n; left; apply Rlt_trans with a; assumption. -assert (H12 : a < a + h0). -pattern a at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l. -assert (H12 := Rge_le _ _ r); elim H12; intro. -assumption. -elim H10; symmetry in |- *; assumption. -assert (H13 : Riemann_integrable f a (a + h0)). -apply continuity_implies_RiemannInt. -left; assumption. -intros; apply C0; elim H13; intros; split; try assumption. -apply Rle_trans with (a + h0); try assumption. -apply Rplus_le_reg_l with (- b - h0). -replace (- b - h0 + b) with (- h0); [ idtac | ring ]. -replace (- b - h0 + (a + h0)) with (a - b); [ idtac | ring ]. -apply Ropp_le_cancel; rewrite Ropp_involutive; rewrite Ropp_minus_distr; - apply Rle_trans with del. -apply Rle_trans with (Rabs h0); [ apply RRle_abs | left; assumption ]. -unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r. -replace (primitive h (FTC_P1 h C0) (a + h0) - primitive h (FTC_P1 h C0) a) - with (RiemannInt H13). -replace (f a) with (RiemannInt (RiemannInt_P14 a (a + h0) (f a)) / h0). -replace - (RiemannInt H13 / h0 - RiemannInt (RiemannInt_P14 a (a + h0) (f a)) / h0) - with ((RiemannInt H13 - RiemannInt (RiemannInt_P14 a (a + h0) (f a))) / h0). -replace (RiemannInt H13 - RiemannInt (RiemannInt_P14 a (a + h0) (f a))) with - (RiemannInt (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a)))). -unfold Rdiv in |- *; rewrite Rabs_mult; - apply Rle_lt_trans with - (RiemannInt - (RiemannInt_P16 - (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a)))) * - Rabs (/ h0)). -do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. -apply Rabs_pos. -apply - (RiemannInt_P17 (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a))) - (RiemannInt_P16 - (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a))))); - left; assumption. -apply Rle_lt_trans with - (RiemannInt (RiemannInt_P14 a (a + h0) (eps / 2)) * Rabs (/ h0)). -do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. -apply Rabs_pos. -apply RiemannInt_P19. -left; assumption. -intros; replace (f x2 + -1 * fct_cte (f a) x2) with (f x2 - f a). -unfold fct_cte in |- *; case (Req_dec a x2); intro. -rewrite H15; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; - left; assumption. -elim H8; intros; left; apply H17; repeat split. -assumption. -rewrite Rabs_right. -apply Rplus_lt_reg_r with a; replace (a + (x2 - a)) with x2; [ idtac | ring ]. -apply Rlt_le_trans with (a + h0). -elim H14; intros; assumption. -apply Rplus_le_compat_l; left; apply Rle_lt_trans with (Rabs h0). -apply RRle_abs. -apply Rlt_le_trans with del; - [ assumption - | unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); - [ apply Rmin_r | apply Rmin_l ] ]. -apply Rle_ge; left; apply Rlt_Rminus; elim H14; intros; assumption. -unfold fct_cte in |- *; ring. -rewrite RiemannInt_P15. -rewrite Rmult_assoc; replace ((a + h0 - a) * Rabs (/ h0)) with 1. -rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2; - [ prove_sup0 - | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r; - rewrite double; apply Rplus_lt_compat_l; assumption - | discrR ] ]. -rewrite Rabs_right. -rewrite Rplus_comm; unfold Rminus in |- *; rewrite Rplus_assoc; - rewrite Rplus_opp_r; rewrite Rplus_0_r; rewrite <- Rinv_r_sym; - [ reflexivity | assumption ]. -apply Rle_ge; left; apply Rinv_0_lt_compat; assert (H14 := Rge_le _ _ r); - elim H14; intro. -assumption. -elim H10; symmetry in |- *; assumption. -rewrite - (RiemannInt_P13 H13 (RiemannInt_P14 a (a + h0) (f a)) - (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a)))) - ; ring. -unfold Rdiv, Rminus in |- *; rewrite Rmult_plus_distr_r; ring. -rewrite RiemannInt_P15. -rewrite Rplus_comm; unfold Rminus in |- *; rewrite Rplus_assoc; - rewrite Rplus_opp_r; rewrite Rplus_0_r; unfold Rdiv in |- *; - rewrite Rmult_assoc; rewrite <- Rinv_r_sym; [ ring | assumption ]. -cut (a <= a + h0). -cut (a + h0 <= b). -intros; unfold primitive in |- *; case (Rle_dec a (a + h0)); - case (Rle_dec (a + h0) b); case (Rle_dec a a); case (Rle_dec a b); - intros; try (elim n; right; reflexivity) || (elim n; left; assumption). -rewrite RiemannInt_P9; unfold Rminus in |- *; rewrite Ropp_0; - rewrite Rplus_0_r; apply RiemannInt_P5. -elim n; assumption. -elim n; assumption. -2: left; assumption. -apply Rplus_le_reg_l with (- a); replace (- a + (a + h0)) with h0; - [ idtac | ring ]. -rewrite Rplus_comm; apply Rle_trans with del; - [ apply Rle_trans with (Rabs h0); [ apply RRle_abs | left; assumption ] - | unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r ]. + set (f_a := fun x:R => f a * (x - a)); rewrite <- H2; + assert (H3 : derivable_pt_lim f_a a (f a)). + unfold f_a in |- *; + change (derivable_pt_lim (fct_cte (f a) * (id - fct_cte a)%F) a (f a)) + in |- *; pattern (f a) at 2 in |- *; + replace (f a) with (0 * (id - fct_cte a)%F a + fct_cte (f a) a * 1). + apply derivable_pt_lim_mult. + apply derivable_pt_lim_const. + replace 1 with (1 - 0); [ idtac | ring ]. + apply derivable_pt_lim_minus. + apply derivable_pt_lim_id. + apply derivable_pt_lim_const. + unfold fct_cte in |- *; ring. + unfold derivable_pt_lim in |- *; intros; elim (H3 _ H4); intros. + assert (H6 : continuity_pt f a). + apply C0; split; [ right; reflexivity | left; assumption ]. + assert (H7 : 0 < eps / 2). + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. + elim (H6 _ H7); unfold D_x, no_cond, dist in |- *; simpl in |- *; + unfold R_dist in |- *; intros. + set (del := Rmin x0 (Rmin x1 (b - a))). + assert (H9 : 0 < del). + unfold del in |- *; unfold Rmin in |- *. + case (Rle_dec x1 (b - a)); intros. + case (Rle_dec x0 x1); intro. + apply (cond_pos x0). + elim H8; intros; assumption. + case (Rle_dec x0 (b - a)); intro. + apply (cond_pos x0). + apply Rlt_Rminus; assumption. + split with (mkposreal _ H9). + intros; case (Rcase_abs h0); intro. + assert (H12 : a + h0 < a). + pattern a at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + assumption. + unfold primitive in |- *. + case (Rle_dec a (a + h0)); case (Rle_dec (a + h0) b); case (Rle_dec a a); + case (Rle_dec a b); intros; + try (elim n; left; assumption) || (elim n; right; reflexivity). + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H12)). + elim n; left; apply Rlt_trans with a; assumption. + rewrite RiemannInt_P9; replace 0 with (f_a a). + replace (f a * (a + h0 - a)) with (f_a (a + h0)). + apply H5; try assumption. + apply Rlt_le_trans with del; + [ assumption | unfold del in |- *; apply Rmin_l ]. + unfold f_a in |- *; ring. + unfold f_a in |- *; ring. + elim n; left; apply Rlt_trans with a; assumption. + assert (H12 : a < a + h0). + pattern a at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l. + assert (H12 := Rge_le _ _ r); elim H12; intro. + assumption. + elim H10; symmetry in |- *; assumption. + assert (H13 : Riemann_integrable f a (a + h0)). + apply continuity_implies_RiemannInt. + left; assumption. + intros; apply C0; elim H13; intros; split; try assumption. + apply Rle_trans with (a + h0); try assumption. + apply Rplus_le_reg_l with (- b - h0). + replace (- b - h0 + b) with (- h0); [ idtac | ring ]. + replace (- b - h0 + (a + h0)) with (a - b); [ idtac | ring ]. + apply Ropp_le_cancel; rewrite Ropp_involutive; rewrite Ropp_minus_distr; + apply Rle_trans with del. + apply Rle_trans with (Rabs h0); [ apply RRle_abs | left; assumption ]. + unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r. + replace (primitive h (FTC_P1 h C0) (a + h0) - primitive h (FTC_P1 h C0) a) + with (RiemannInt H13). + replace (f a) with (RiemannInt (RiemannInt_P14 a (a + h0) (f a)) / h0). + replace + (RiemannInt H13 / h0 - RiemannInt (RiemannInt_P14 a (a + h0) (f a)) / h0) + with ((RiemannInt H13 - RiemannInt (RiemannInt_P14 a (a + h0) (f a))) / h0). + replace (RiemannInt H13 - RiemannInt (RiemannInt_P14 a (a + h0) (f a))) with + (RiemannInt (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a)))). + unfold Rdiv in |- *; rewrite Rabs_mult; + apply Rle_lt_trans with + (RiemannInt + (RiemannInt_P16 + (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a)))) * + Rabs (/ h0)). + do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. + apply Rabs_pos. + apply + (RiemannInt_P17 (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a))) + (RiemannInt_P16 + (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a))))); + left; assumption. + apply Rle_lt_trans with + (RiemannInt (RiemannInt_P14 a (a + h0) (eps / 2)) * Rabs (/ h0)). + do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. + apply Rabs_pos. + apply RiemannInt_P19. + left; assumption. + intros; replace (f x2 + -1 * fct_cte (f a) x2) with (f x2 - f a). + unfold fct_cte in |- *; case (Req_dec a x2); intro. + rewrite H15; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + left; assumption. + elim H8; intros; left; apply H17; repeat split. + assumption. + rewrite Rabs_right. + apply Rplus_lt_reg_r with a; replace (a + (x2 - a)) with x2; [ idtac | ring ]. + apply Rlt_le_trans with (a + h0). + elim H14; intros; assumption. + apply Rplus_le_compat_l; left; apply Rle_lt_trans with (Rabs h0). + apply RRle_abs. + apply Rlt_le_trans with del; + [ assumption + | unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); + [ apply Rmin_r | apply Rmin_l ] ]. + apply Rle_ge; left; apply Rlt_Rminus; elim H14; intros; assumption. + unfold fct_cte in |- *; ring. + rewrite RiemannInt_P15. + rewrite Rmult_assoc; replace ((a + h0 - a) * Rabs (/ h0)) with 1. + rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r; + rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. + rewrite Rabs_right. + rewrite Rplus_comm; unfold Rminus in |- *; rewrite Rplus_assoc; + rewrite Rplus_opp_r; rewrite Rplus_0_r; rewrite <- Rinv_r_sym; + [ reflexivity | assumption ]. + apply Rle_ge; left; apply Rinv_0_lt_compat; assert (H14 := Rge_le _ _ r); + elim H14; intro. + assumption. + elim H10; symmetry in |- *; assumption. + rewrite + (RiemannInt_P13 H13 (RiemannInt_P14 a (a + h0) (f a)) + (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a)))) + ; ring. + unfold Rdiv, Rminus in |- *; rewrite Rmult_plus_distr_r; ring. + rewrite RiemannInt_P15. + rewrite Rplus_comm; unfold Rminus in |- *; rewrite Rplus_assoc; + rewrite Rplus_opp_r; rewrite Rplus_0_r; unfold Rdiv in |- *; + rewrite Rmult_assoc; rewrite <- Rinv_r_sym; [ ring | assumption ]. + cut (a <= a + h0). + cut (a + h0 <= b). + intros; unfold primitive in |- *; case (Rle_dec a (a + h0)); + case (Rle_dec (a + h0) b); case (Rle_dec a a); case (Rle_dec a b); + intros; try (elim n; right; reflexivity) || (elim n; left; assumption). + rewrite RiemannInt_P9; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; apply RiemannInt_P5. + elim n; assumption. + elim n; assumption. + 2: left; assumption. + apply Rplus_le_reg_l with (- a); replace (- a + (a + h0)) with h0; + [ idtac | ring ]. + rewrite Rplus_comm; apply Rle_trans with del; + [ apply Rle_trans with (Rabs h0); [ apply RRle_abs | left; assumption ] + | unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r ]. (*****) -assert (H1 : x = a). -rewrite <- H0 in H; elim H; intros; apply Rle_antisym; assumption. -set (f_a := fun x:R => f a * (x - a)). -assert (H2 : derivable_pt_lim f_a a (f a)). -unfold f_a in |- *; - change (derivable_pt_lim (fct_cte (f a) * (id - fct_cte a)%F) a (f a)) - in |- *; pattern (f a) at 2 in |- *; - replace (f a) with (0 * (id - fct_cte a)%F a + fct_cte (f a) a * 1). -apply derivable_pt_lim_mult. -apply derivable_pt_lim_const. -replace 1 with (1 - 0); [ idtac | ring ]. -apply derivable_pt_lim_minus. -apply derivable_pt_lim_id. -apply derivable_pt_lim_const. -unfold fct_cte in |- *; ring. -set - (f_b := fun x:R => f b * (x - b) + RiemannInt (FTC_P1 h C0 h (Rle_refl b))). -assert (H3 : derivable_pt_lim f_b b (f b)). -unfold f_b in |- *; pattern (f b) at 2 in |- *; replace (f b) with (f b + 0). -change - (derivable_pt_lim - ((fct_cte (f b) * (id - fct_cte b))%F + - fct_cte (RiemannInt (FTC_P1 h C0 h (Rle_refl b)))) b ( - f b + 0)) in |- *. -apply derivable_pt_lim_plus. -pattern (f b) at 2 in |- *; - replace (f b) with (0 * (id - fct_cte b)%F b + fct_cte (f b) b * 1). -apply derivable_pt_lim_mult. -apply derivable_pt_lim_const. -replace 1 with (1 - 0); [ idtac | ring ]. -apply derivable_pt_lim_minus. -apply derivable_pt_lim_id. -apply derivable_pt_lim_const. -unfold fct_cte in |- *; ring. -apply derivable_pt_lim_const. -ring. -unfold derivable_pt_lim in |- *; intros; elim (H2 _ H4); intros; - elim (H3 _ H4); intros; set (del := Rmin x0 x1). -assert (H7 : 0 < del). -unfold del in |- *; unfold Rmin in |- *; case (Rle_dec x0 x1); intro. -apply (cond_pos x0). -apply (cond_pos x1). -split with (mkposreal _ H7); intros; case (Rcase_abs h0); intro. -assert (H10 : a + h0 < a). -pattern a at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; - assumption. -rewrite H1; unfold primitive in |- *; case (Rle_dec a (a + h0)); - case (Rle_dec (a + h0) b); case (Rle_dec a a); case (Rle_dec a b); - intros; try (elim n; right; assumption || reflexivity). -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H10)). -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r2 H10)). -rewrite RiemannInt_P9; replace 0 with (f_a a). -replace (f a * (a + h0 - a)) with (f_a (a + h0)). -apply H5; try assumption. -apply Rlt_le_trans with del; try assumption. -unfold del in |- *; apply Rmin_l. -unfold f_a in |- *; ring. -unfold f_a in |- *; ring. -elim n; rewrite <- H0; left; assumption. -assert (H10 : a < a + h0). -pattern a at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l. -assert (H10 := Rge_le _ _ r); elim H10; intro. -assumption. -elim H8; symmetry in |- *; assumption. -rewrite H0 in H1; rewrite H1; unfold primitive in |- *; - case (Rle_dec a (b + h0)); case (Rle_dec (b + h0) b); - case (Rle_dec a b); case (Rle_dec b b); intros; - try (elim n; right; assumption || reflexivity). -rewrite H0 in H10; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r2 H10)). -repeat rewrite RiemannInt_P9. -replace (RiemannInt (FTC_P1 h C0 r1 r0)) with (f_b b). -fold (f_b (b + h0)) in |- *. -apply H6; try assumption. -apply Rlt_le_trans with del; try assumption. -unfold del in |- *; apply Rmin_r. -unfold f_b in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; - rewrite Rmult_0_r; rewrite Rplus_0_l; apply RiemannInt_P5. -elim n; rewrite <- H0; left; assumption. -elim n0; rewrite <- H0; left; assumption. + assert (H1 : x = a). + rewrite <- H0 in H; elim H; intros; apply Rle_antisym; assumption. + set (f_a := fun x:R => f a * (x - a)). + assert (H2 : derivable_pt_lim f_a a (f a)). + unfold f_a in |- *; + change (derivable_pt_lim (fct_cte (f a) * (id - fct_cte a)%F) a (f a)) + in |- *; pattern (f a) at 2 in |- *; + replace (f a) with (0 * (id - fct_cte a)%F a + fct_cte (f a) a * 1). + apply derivable_pt_lim_mult. + apply derivable_pt_lim_const. + replace 1 with (1 - 0); [ idtac | ring ]. + apply derivable_pt_lim_minus. + apply derivable_pt_lim_id. + apply derivable_pt_lim_const. + unfold fct_cte in |- *; ring. + set + (f_b := fun x:R => f b * (x - b) + RiemannInt (FTC_P1 h C0 h (Rle_refl b))). + assert (H3 : derivable_pt_lim f_b b (f b)). + unfold f_b in |- *; pattern (f b) at 2 in |- *; replace (f b) with (f b + 0). + change + (derivable_pt_lim + ((fct_cte (f b) * (id - fct_cte b))%F + + fct_cte (RiemannInt (FTC_P1 h C0 h (Rle_refl b)))) b ( + f b + 0)) in |- *. + apply derivable_pt_lim_plus. + pattern (f b) at 2 in |- *; + replace (f b) with (0 * (id - fct_cte b)%F b + fct_cte (f b) b * 1). + apply derivable_pt_lim_mult. + apply derivable_pt_lim_const. + replace 1 with (1 - 0); [ idtac | ring ]. + apply derivable_pt_lim_minus. + apply derivable_pt_lim_id. + apply derivable_pt_lim_const. + unfold fct_cte in |- *; ring. + apply derivable_pt_lim_const. + ring. + unfold derivable_pt_lim in |- *; intros; elim (H2 _ H4); intros; + elim (H3 _ H4); intros; set (del := Rmin x0 x1). + assert (H7 : 0 < del). + unfold del in |- *; unfold Rmin in |- *; case (Rle_dec x0 x1); intro. + apply (cond_pos x0). + apply (cond_pos x1). + split with (mkposreal _ H7); intros; case (Rcase_abs h0); intro. + assert (H10 : a + h0 < a). + pattern a at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + assumption. + rewrite H1; unfold primitive in |- *; case (Rle_dec a (a + h0)); + case (Rle_dec (a + h0) b); case (Rle_dec a a); case (Rle_dec a b); + intros; try (elim n; right; assumption || reflexivity). + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H10)). + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r2 H10)). + rewrite RiemannInt_P9; replace 0 with (f_a a). + replace (f a * (a + h0 - a)) with (f_a (a + h0)). + apply H5; try assumption. + apply Rlt_le_trans with del; try assumption. + unfold del in |- *; apply Rmin_l. + unfold f_a in |- *; ring. + unfold f_a in |- *; ring. + elim n; rewrite <- H0; left; assumption. + assert (H10 : a < a + h0). + pattern a at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l. + assert (H10 := Rge_le _ _ r); elim H10; intro. + assumption. + elim H8; symmetry in |- *; assumption. + rewrite H0 in H1; rewrite H1; unfold primitive in |- *; + case (Rle_dec a (b + h0)); case (Rle_dec (b + h0) b); + case (Rle_dec a b); case (Rle_dec b b); intros; + try (elim n; right; assumption || reflexivity). + rewrite H0 in H10; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r2 H10)). + repeat rewrite RiemannInt_P9. + replace (RiemannInt (FTC_P1 h C0 r1 r0)) with (f_b b). + fold (f_b (b + h0)) in |- *. + apply H6; try assumption. + apply Rlt_le_trans with del; try assumption. + unfold del in |- *; apply Rmin_r. + unfold f_b in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rmult_0_r; rewrite Rplus_0_l; apply RiemannInt_P5. + elim n; rewrite <- H0; left; assumption. + elim n0; rewrite <- H0; left; assumption. Qed. Lemma RiemannInt_P29 : - forall (f:R -> R) a b (h:a <= b) - (C0:forall x:R, a <= x <= b -> continuity_pt f x), - antiderivative f (primitive h (FTC_P1 h C0)) a b. -intro f; intros; unfold antiderivative in |- *; split; try assumption; intros; - assert (H0 := RiemannInt_P28 h C0 H); - assert (H1 : derivable_pt (primitive h (FTC_P1 h C0)) x); - [ unfold derivable_pt in |- *; split with (f x); apply H0 - | split with H1; symmetry in |- *; apply derive_pt_eq_0; apply H0 ]. + forall (f:R -> R) a b (h:a <= b) + (C0:forall x:R, a <= x <= b -> continuity_pt f x), + antiderivative f (primitive h (FTC_P1 h C0)) a b. +Proof. + intro f; intros; unfold antiderivative in |- *; split; try assumption; intros; + assert (H0 := RiemannInt_P28 h C0 H); + assert (H1 : derivable_pt (primitive h (FTC_P1 h C0)) x); + [ unfold derivable_pt in |- *; split with (f x); apply H0 + | split with H1; symmetry in |- *; apply derive_pt_eq_0; apply H0 ]. Qed. Lemma RiemannInt_P30 : - forall (f:R -> R) (a b:R), - a <= b -> - (forall x:R, a <= x <= b -> continuity_pt f x) -> - sigT (fun g:R -> R => antiderivative f g a b). -intros; split with (primitive H (FTC_P1 H H0)); apply RiemannInt_P29. + forall (f:R -> R) (a b:R), + a <= b -> + (forall x:R, a <= x <= b -> continuity_pt f x) -> + sigT (fun g:R -> R => antiderivative f g a b). +Proof. + intros; split with (primitive H (FTC_P1 H H0)); apply RiemannInt_P29. Qed. Record C1_fun : Type := mkC1 {c1 :> R -> R; diff0 : derivable c1; cont1 : continuity (derive c1 diff0)}. Lemma RiemannInt_P31 : - forall (f:C1_fun) (a b:R), - a <= b -> antiderivative (derive f (diff0 f)) f a b. -intro f; intros; unfold antiderivative in |- *; split; try assumption; intros; - split with (diff0 f x); reflexivity. + forall (f:C1_fun) (a b:R), + a <= b -> antiderivative (derive f (diff0 f)) f a b. +Proof. + intro f; intros; unfold antiderivative in |- *; split; try assumption; intros; + split with (diff0 f x); reflexivity. Qed. Lemma RiemannInt_P32 : - forall (f:C1_fun) (a b:R), Riemann_integrable (derive f (diff0 f)) a b. -intro f; intros; case (Rle_dec a b); intro; - [ apply continuity_implies_RiemannInt; try assumption; intros; - apply (cont1 f) - | assert (H : b <= a); - [ auto with real - | apply RiemannInt_P1; apply continuity_implies_RiemannInt; - try assumption; intros; apply (cont1 f) ] ]. + forall (f:C1_fun) (a b:R), Riemann_integrable (derive f (diff0 f)) a b. +Proof. + intro f; intros; case (Rle_dec a b); intro; + [ apply continuity_implies_RiemannInt; try assumption; intros; + apply (cont1 f) + | assert (H : b <= a); + [ auto with real + | apply RiemannInt_P1; apply continuity_implies_RiemannInt; + try assumption; intros; apply (cont1 f) ] ]. Qed. Lemma RiemannInt_P33 : - forall (f:C1_fun) (a b:R) (pr:Riemann_integrable (derive f (diff0 f)) a b), - a <= b -> RiemannInt pr = f b - f a. -intro f; intros; - assert - (H0 : forall x:R, a <= x <= b -> continuity_pt (derive f (diff0 f)) x). -intros; apply (cont1 f). -rewrite (RiemannInt_P20 H (FTC_P1 H H0) pr); - assert (H1 := RiemannInt_P29 H H0); assert (H2 := RiemannInt_P31 f H); - elim (antiderivative_Ucte (derive f (diff0 f)) _ _ _ _ H1 H2); - intros C H3; repeat rewrite H3; - [ ring - | split; [ right; reflexivity | assumption ] - | split; [ assumption | right; reflexivity ] ]. + forall (f:C1_fun) (a b:R) (pr:Riemann_integrable (derive f (diff0 f)) a b), + a <= b -> RiemannInt pr = f b - f a. +Proof. + intro f; intros; + assert + (H0 : forall x:R, a <= x <= b -> continuity_pt (derive f (diff0 f)) x). + intros; apply (cont1 f). + rewrite (RiemannInt_P20 H (FTC_P1 H H0) pr); + assert (H1 := RiemannInt_P29 H H0); assert (H2 := RiemannInt_P31 f H); + elim (antiderivative_Ucte (derive f (diff0 f)) _ _ _ _ H1 H2); + intros C H3; repeat rewrite H3; + [ ring + | split; [ right; reflexivity | assumption ] + | split; [ assumption | right; reflexivity ] ]. Qed. Lemma FTC_Riemann : - forall (f:C1_fun) (a b:R) (pr:Riemann_integrable (derive f (diff0 f)) a b), - RiemannInt pr = f b - f a. -intro f; intros; case (Rle_dec a b); intro; - [ apply RiemannInt_P33; assumption - | assert (H : b <= a); - [ auto with real - | assert (H0 := RiemannInt_P1 pr); rewrite (RiemannInt_P8 pr H0); - rewrite (RiemannInt_P33 _ H0 H); ring ] ]. + forall (f:C1_fun) (a b:R) (pr:Riemann_integrable (derive f (diff0 f)) a b), + RiemannInt pr = f b - f a. +Proof. + intro f; intros; case (Rle_dec a b); intro; + [ apply RiemannInt_P33; assumption + | assert (H : b <= a); + [ auto with real + | assert (H0 := RiemannInt_P1 pr); rewrite (RiemannInt_P8 pr H0); + rewrite (RiemannInt_P33 _ H0 H); ring ] ]. Qed. diff --git a/theories/Reals/RiemannInt_SF.v b/theories/Reals/RiemannInt_SF.v index b628de73..0f91d006 100644 --- a/theories/Reals/RiemannInt_SF.v +++ b/theories/Reals/RiemannInt_SF.v @@ -5,8 +5,8 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) - -(*i $Id: RiemannInt_SF.v 8837 2006-05-22 08:41:18Z herbelin $ i*) + +(*i $Id: RiemannInt_SF.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -16,98 +16,100 @@ Open Local Scope R_scope. Set Implicit Arguments. -(**************************************************) -(* Each bounded subset of N has a maximal element *) -(**************************************************) +(*****************************************************) +(** * Each bounded subset of N has a maximal element *) +(*****************************************************) Definition Nbound (I:nat -> Prop) : Prop := - exists n : nat, (forall i:nat, I i -> (i <= n)%nat). + exists n : nat, (forall i:nat, I i -> (i <= n)%nat). Lemma IZN_var : forall z:Z, (0 <= z)%Z -> {n : nat | z = Z_of_nat n}. -intros; apply Z_of_nat_complete_inf; assumption. +Proof. + intros; apply Z_of_nat_complete_inf; assumption. Qed. Lemma Nzorn : - forall I:nat -> Prop, - (exists n : nat, I n) -> - Nbound I -> sigT (fun n:nat => I n /\ (forall i:nat, I i -> (i <= n)%nat)). -intros I H H0; set (E := fun x:R => exists i : nat, I i /\ INR i = x); - assert (H1 : bound E). -unfold Nbound in H0; elim H0; intros N H1; unfold bound in |- *; - exists (INR N); unfold is_upper_bound in |- *; intros; - unfold E in H2; elim H2; intros; elim H3; intros; - rewrite <- H5; apply le_INR; apply H1; assumption. -assert (H2 : exists x : R, E x). -elim H; intros; exists (INR x); unfold E in |- *; exists x; split; - [ assumption | reflexivity ]. -assert (H3 := completeness E H1 H2); elim H3; intros; unfold is_lub in p; - elim p; clear p; intros; unfold is_upper_bound in H4, H5; - assert (H6 : 0 <= x). -elim H2; intros; unfold E in H6; elim H6; intros; elim H7; intros; - apply Rle_trans with x0; - [ rewrite <- H9; change (INR 0 <= INR x1) in |- *; apply le_INR; - apply le_O_n - | apply H4; assumption ]. -assert (H7 := archimed x); elim H7; clear H7; intros; - assert (H9 : x <= IZR (up x) - 1). -apply H5; intros; assert (H10 := H4 _ H9); unfold E in H9; elim H9; intros; - elim H11; intros; rewrite <- H13; apply Rplus_le_reg_l with 1; - replace (1 + (IZR (up x) - 1)) with (IZR (up x)); - [ idtac | ring ]; replace (1 + INR x1) with (INR (S x1)); - [ idtac | rewrite S_INR; ring ]. -assert (H14 : (0 <= up x)%Z). -apply le_IZR; apply Rle_trans with x; [ apply H6 | left; assumption ]. -assert (H15 := IZN _ H14); elim H15; clear H15; intros; rewrite H15; - rewrite <- INR_IZR_INZ; apply le_INR; apply lt_le_S; - apply INR_lt; rewrite H13; apply Rle_lt_trans with x; - [ assumption | rewrite INR_IZR_INZ; rewrite <- H15; assumption ]. -assert (H10 : x = IZR (up x) - 1). -apply Rle_antisym; - [ assumption - | apply Rplus_le_reg_l with (- x + 1); - replace (- x + 1 + (IZR (up x) - 1)) with (IZR (up x) - x); - [ idtac | ring ]; replace (- x + 1 + x) with 1; - [ assumption | ring ] ]. -assert (H11 : (0 <= up x)%Z). -apply le_IZR; apply Rle_trans with x; [ apply H6 | left; assumption ]. -assert (H12 := IZN_var H11); elim H12; clear H12; intros; assert (H13 : E x). -elim (classic (E x)); intro; try assumption. -cut (forall y:R, E y -> y <= x - 1). -intro; assert (H14 := H5 _ H13); cut (x - 1 < x). -intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H14 H15)). -apply Rminus_lt; replace (x - 1 - x) with (-1); [ idtac | ring ]; - rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; apply Rlt_0_1. -intros; assert (H14 := H4 _ H13); elim H14; intro; unfold E in H13; elim H13; - intros; elim H16; intros; apply Rplus_le_reg_l with 1. -replace (1 + (x - 1)) with x; [ idtac | ring ]; rewrite <- H18; - replace (1 + INR x1) with (INR (S x1)); [ idtac | rewrite S_INR; ring ]. -cut (x = INR (pred x0)). -intro; rewrite H19; apply le_INR; apply lt_le_S; apply INR_lt; rewrite H18; - rewrite <- H19; assumption. -rewrite H10; rewrite p; rewrite <- INR_IZR_INZ; replace 1 with (INR 1); - [ idtac | reflexivity ]; rewrite <- minus_INR. -replace (x0 - 1)%nat with (pred x0); - [ reflexivity - | case x0; [ reflexivity | intro; simpl in |- *; apply minus_n_O ] ]. -induction x0 as [| x0 Hrecx0]; - [ rewrite p in H7; rewrite <- INR_IZR_INZ in H7; simpl in H7; - elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 H7)) - | apply le_n_S; apply le_O_n ]. -rewrite H15 in H13; elim H12; assumption. -split with (pred x0); unfold E in H13; elim H13; intros; elim H12; intros; - rewrite H10 in H15; rewrite p in H15; rewrite <- INR_IZR_INZ in H15; - assert (H16 : INR x0 = INR x1 + 1). -rewrite H15; ring. -rewrite <- S_INR in H16; assert (H17 := INR_eq _ _ H16); rewrite H17; - simpl in |- *; split. -assumption. -intros; apply INR_le; rewrite H15; rewrite <- H15; elim H12; intros; - rewrite H20; apply H4; unfold E in |- *; exists i; - split; [ assumption | reflexivity ]. + forall I:nat -> Prop, + (exists n : nat, I n) -> + Nbound I -> sigT (fun n:nat => I n /\ (forall i:nat, I i -> (i <= n)%nat)). +Proof. + intros I H H0; set (E := fun x:R => exists i : nat, I i /\ INR i = x); + assert (H1 : bound E). + unfold Nbound in H0; elim H0; intros N H1; unfold bound in |- *; + exists (INR N); unfold is_upper_bound in |- *; intros; + unfold E in H2; elim H2; intros; elim H3; intros; + rewrite <- H5; apply le_INR; apply H1; assumption. + assert (H2 : exists x : R, E x). + elim H; intros; exists (INR x); unfold E in |- *; exists x; split; + [ assumption | reflexivity ]. + assert (H3 := completeness E H1 H2); elim H3; intros; unfold is_lub in p; + elim p; clear p; intros; unfold is_upper_bound in H4, H5; + assert (H6 : 0 <= x). + elim H2; intros; unfold E in H6; elim H6; intros; elim H7; intros; + apply Rle_trans with x0; + [ rewrite <- H9; change (INR 0 <= INR x1) in |- *; apply le_INR; + apply le_O_n + | apply H4; assumption ]. + assert (H7 := archimed x); elim H7; clear H7; intros; + assert (H9 : x <= IZR (up x) - 1). + apply H5; intros; assert (H10 := H4 _ H9); unfold E in H9; elim H9; intros; + elim H11; intros; rewrite <- H13; apply Rplus_le_reg_l with 1; + replace (1 + (IZR (up x) - 1)) with (IZR (up x)); + [ idtac | ring ]; replace (1 + INR x1) with (INR (S x1)); + [ idtac | rewrite S_INR; ring ]. + assert (H14 : (0 <= up x)%Z). + apply le_IZR; apply Rle_trans with x; [ apply H6 | left; assumption ]. + assert (H15 := IZN _ H14); elim H15; clear H15; intros; rewrite H15; + rewrite <- INR_IZR_INZ; apply le_INR; apply lt_le_S; + apply INR_lt; rewrite H13; apply Rle_lt_trans with x; + [ assumption | rewrite INR_IZR_INZ; rewrite <- H15; assumption ]. + assert (H10 : x = IZR (up x) - 1). + apply Rle_antisym; + [ assumption + | apply Rplus_le_reg_l with (- x + 1); + replace (- x + 1 + (IZR (up x) - 1)) with (IZR (up x) - x); + [ idtac | ring ]; replace (- x + 1 + x) with 1; + [ assumption | ring ] ]. + assert (H11 : (0 <= up x)%Z). + apply le_IZR; apply Rle_trans with x; [ apply H6 | left; assumption ]. + assert (H12 := IZN_var H11); elim H12; clear H12; intros; assert (H13 : E x). + elim (classic (E x)); intro; try assumption. + cut (forall y:R, E y -> y <= x - 1). + intro; assert (H14 := H5 _ H13); cut (x - 1 < x). + intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H14 H15)). + apply Rminus_lt; replace (x - 1 - x) with (-1); [ idtac | ring ]; + rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; apply Rlt_0_1. + intros; assert (H14 := H4 _ H13); elim H14; intro; unfold E in H13; elim H13; + intros; elim H16; intros; apply Rplus_le_reg_l with 1. + replace (1 + (x - 1)) with x; [ idtac | ring ]; rewrite <- H18; + replace (1 + INR x1) with (INR (S x1)); [ idtac | rewrite S_INR; ring ]. + cut (x = INR (pred x0)). + intro; rewrite H19; apply le_INR; apply lt_le_S; apply INR_lt; rewrite H18; + rewrite <- H19; assumption. + rewrite H10; rewrite p; rewrite <- INR_IZR_INZ; replace 1 with (INR 1); + [ idtac | reflexivity ]; rewrite <- minus_INR. + replace (x0 - 1)%nat with (pred x0); + [ reflexivity + | case x0; [ reflexivity | intro; simpl in |- *; apply minus_n_O ] ]. + induction x0 as [| x0 Hrecx0]; + [ rewrite p in H7; rewrite <- INR_IZR_INZ in H7; simpl in H7; + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 H7)) + | apply le_n_S; apply le_O_n ]. + rewrite H15 in H13; elim H12; assumption. + split with (pred x0); unfold E in H13; elim H13; intros; elim H12; intros; + rewrite H10 in H15; rewrite p in H15; rewrite <- INR_IZR_INZ in H15; + assert (H16 : INR x0 = INR x1 + 1). + rewrite H15; ring. + rewrite <- S_INR in H16; assert (H17 := INR_eq _ _ H16); rewrite H17; + simpl in |- *; split. + assumption. + intros; apply INR_le; rewrite H15; rewrite <- H15; elim H12; intros; + rewrite H20; apply H4; unfold E in |- *; exists i; + split; [ assumption | reflexivity ]. Qed. (*******************************************) -(* Step functions *) +(** * Step functions *) (*******************************************) Definition open_interval (a b x:R) : Prop := a < x < b. @@ -119,15 +121,15 @@ Definition adapted_couple (f:R -> R) (a b:R) (l lf:Rlist) : Prop := pos_Rl l (pred (Rlength l)) = Rmax a b /\ Rlength l = S (Rlength lf) /\ (forall i:nat, - (i < pred (Rlength l))%nat -> - constant_D_eq f (open_interval (pos_Rl l i) (pos_Rl l (S i))) - (pos_Rl lf i)). + (i < pred (Rlength l))%nat -> + constant_D_eq f (open_interval (pos_Rl l i) (pos_Rl l (S i))) + (pos_Rl lf i)). Definition adapted_couple_opt (f:R -> R) (a b:R) (l lf:Rlist) := adapted_couple f a b l lf /\ (forall i:nat, - (i < pred (Rlength lf))%nat -> - pos_Rl lf i <> pos_Rl lf (S i) \/ f (pos_Rl l (S i)) <> pos_Rl lf i) /\ + (i < pred (Rlength lf))%nat -> + pos_Rl lf i <> pos_Rl lf (S i) \/ f (pos_Rl l (S i)) <> pos_Rl lf i) /\ (forall i:nat, (i < pred (Rlength l))%nat -> pos_Rl l i <> pos_Rl l (S i)). Definition is_subdivision (f:R -> R) (a b:R) (l:Rlist) : Type := @@ -136,7 +138,7 @@ Definition is_subdivision (f:R -> R) (a b:R) (l:Rlist) : Type := Definition IsStepFun (f:R -> R) (a b:R) : Type := sigT (fun l:Rlist => is_subdivision f a b l). -(* Class of step functions *) +(** ** Class of step functions *) Record StepFun (a b:R) : Type := mkStepFun {fe :> R -> R; pre : IsStepFun fe a b}. @@ -144,2477 +146,2521 @@ Definition subdivision (a b:R) (f:StepFun a b) : Rlist := projT1 (pre f). Definition subdivision_val (a b:R) (f:StepFun a b) : Rlist := match projT2 (pre f) with - | existT a b => a + | existT a b => a end. Boxed Fixpoint Int_SF (l k:Rlist) {struct l} : R := match l with - | nil => 0 - | cons a l' => + | nil => 0 + | cons a l' => match k with - | nil => 0 - | cons x nil => 0 - | cons x (cons y k') => a * (y - x) + Int_SF l' (cons y k') + | nil => 0 + | cons x nil => 0 + | cons x (cons y k') => a * (y - x) + Int_SF l' (cons y k') end end. -(* Integral of step functions *) +(** ** Integral of step functions *) Definition RiemannInt_SF (a b:R) (f:StepFun a b) : R := match Rle_dec a b with - | left _ => Int_SF (subdivision_val f) (subdivision f) - | right _ => - Int_SF (subdivision_val f) (subdivision f) + | left _ => Int_SF (subdivision_val f) (subdivision f) + | right _ => - Int_SF (subdivision_val f) (subdivision f) end. -(********************************) -(* Properties of step functions *) -(********************************) +(************************************) +(** ** Properties of step functions *) +(************************************) Lemma StepFun_P1 : - forall (a b:R) (f:StepFun a b), - adapted_couple f a b (subdivision f) (subdivision_val f). -intros a b f; unfold subdivision_val in |- *; case (projT2 (pre f)); intros; - apply a0. + forall (a b:R) (f:StepFun a b), + adapted_couple f a b (subdivision f) (subdivision_val f). +Proof. + intros a b f; unfold subdivision_val in |- *; case (projT2 (pre f)); intros; + apply a0. Qed. Lemma StepFun_P2 : - forall (a b:R) (f:R -> R) (l lf:Rlist), - adapted_couple f a b l lf -> adapted_couple f b a l lf. -unfold adapted_couple in |- *; intros; decompose [and] H; clear H; - repeat split; try assumption. -rewrite H2; unfold Rmin in |- *; case (Rle_dec a b); intro; - case (Rle_dec b a); intro; try reflexivity. -apply Rle_antisym; assumption. -apply Rle_antisym; auto with real. -rewrite H1; unfold Rmax in |- *; case (Rle_dec a b); intro; - case (Rle_dec b a); intro; try reflexivity. -apply Rle_antisym; assumption. -apply Rle_antisym; auto with real. + forall (a b:R) (f:R -> R) (l lf:Rlist), + adapted_couple f a b l lf -> adapted_couple f b a l lf. +Proof. + unfold adapted_couple in |- *; intros; decompose [and] H; clear H; + repeat split; try assumption. + rewrite H2; unfold Rmin in |- *; case (Rle_dec a b); intro; + case (Rle_dec b a); intro; try reflexivity. + apply Rle_antisym; assumption. + apply Rle_antisym; auto with real. + rewrite H1; unfold Rmax in |- *; case (Rle_dec a b); intro; + case (Rle_dec b a); intro; try reflexivity. + apply Rle_antisym; assumption. + apply Rle_antisym; auto with real. Qed. Lemma StepFun_P3 : - forall a b c:R, - a <= b -> - adapted_couple (fct_cte c) a b (cons a (cons b nil)) (cons c nil). -intros; unfold adapted_couple in |- *; repeat split. -unfold ordered_Rlist in |- *; intros; simpl in H0; inversion H0; - [ simpl in |- *; assumption | elim (le_Sn_O _ H2) ]. -simpl in |- *; unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ]. -simpl in |- *; unfold Rmax in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ]. -unfold constant_D_eq, open_interval in |- *; intros; simpl in H0; - inversion H0; [ reflexivity | elim (le_Sn_O _ H3) ]. + forall a b c:R, + a <= b -> + adapted_couple (fct_cte c) a b (cons a (cons b nil)) (cons c nil). +Proof. + intros; unfold adapted_couple in |- *; repeat split. + unfold ordered_Rlist in |- *; intros; simpl in H0; inversion H0; + [ simpl in |- *; assumption | elim (le_Sn_O _ H2) ]. + simpl in |- *; unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. + simpl in |- *; unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. + unfold constant_D_eq, open_interval in |- *; intros; simpl in H0; + inversion H0; [ reflexivity | elim (le_Sn_O _ H3) ]. Qed. Lemma StepFun_P4 : forall a b c:R, IsStepFun (fct_cte c) a b. -intros; unfold IsStepFun in |- *; case (Rle_dec a b); intro. -apply existT with (cons a (cons b nil)); unfold is_subdivision in |- *; - apply existT with (cons c nil); apply (StepFun_P3 c r). -apply existT with (cons b (cons a nil)); unfold is_subdivision in |- *; - apply existT with (cons c nil); apply StepFun_P2; - apply StepFun_P3; auto with real. +Proof. + intros; unfold IsStepFun in |- *; case (Rle_dec a b); intro. + apply existT with (cons a (cons b nil)); unfold is_subdivision in |- *; + apply existT with (cons c nil); apply (StepFun_P3 c r). + apply existT with (cons b (cons a nil)); unfold is_subdivision in |- *; + apply existT with (cons c nil); apply StepFun_P2; + apply StepFun_P3; auto with real. Qed. Lemma StepFun_P5 : - forall (a b:R) (f:R -> R) (l:Rlist), - is_subdivision f a b l -> is_subdivision f b a l. -destruct 1 as (x,(H0,(H1,(H2,(H3,H4))))); exists x; - repeat split; try assumption. -rewrite H1; apply Rmin_comm. -rewrite H2; apply Rmax_comm. + forall (a b:R) (f:R -> R) (l:Rlist), + is_subdivision f a b l -> is_subdivision f b a l. +Proof. + destruct 1 as (x,(H0,(H1,(H2,(H3,H4))))); exists x; + repeat split; try assumption. + rewrite H1; apply Rmin_comm. + rewrite H2; apply Rmax_comm. Qed. Lemma StepFun_P6 : - forall (f:R -> R) (a b:R), IsStepFun f a b -> IsStepFun f b a. -unfold IsStepFun in |- *; intros; elim X; intros; apply existT with x; - apply StepFun_P5; assumption. + forall (f:R -> R) (a b:R), IsStepFun f a b -> IsStepFun f b a. +Proof. + unfold IsStepFun in |- *; intros; elim X; intros; apply existT with x; + apply StepFun_P5; assumption. Qed. Lemma StepFun_P7 : - forall (a b r1 r2 r3:R) (f:R -> R) (l lf:Rlist), - a <= b -> - adapted_couple f a b (cons r1 (cons r2 l)) (cons r3 lf) -> - adapted_couple f r2 b (cons r2 l) lf. -unfold adapted_couple in |- *; intros; decompose [and] H0; clear H0; - assert (H5 : Rmax a b = b). -unfold Rmax in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ]. -assert (H7 : r2 <= b). -rewrite H5 in H2; rewrite <- H2; apply RList_P7; - [ assumption | simpl in |- *; right; left; reflexivity ]. -repeat split. -apply RList_P4 with r1; assumption. -rewrite H5 in H2; unfold Rmin in |- *; case (Rle_dec r2 b); intro; - [ reflexivity | elim n; assumption ]. -unfold Rmax in |- *; case (Rle_dec r2 b); intro; - [ rewrite H5 in H2; rewrite <- H2; reflexivity | elim n; assumption ]. -simpl in H4; simpl in |- *; apply INR_eq; apply Rplus_eq_reg_l with 1; - do 2 rewrite (Rplus_comm 1); do 2 rewrite <- S_INR; - rewrite H4; reflexivity. -intros; unfold constant_D_eq, open_interval in |- *; intros; - unfold constant_D_eq, open_interval in H6; - assert (H9 : (S i < pred (Rlength (cons r1 (cons r2 l))))%nat). -simpl in |- *; simpl in H0; apply lt_n_S; assumption. -assert (H10 := H6 _ H9); apply H10; assumption. + forall (a b r1 r2 r3:R) (f:R -> R) (l lf:Rlist), + a <= b -> + adapted_couple f a b (cons r1 (cons r2 l)) (cons r3 lf) -> + adapted_couple f r2 b (cons r2 l) lf. +Proof. + unfold adapted_couple in |- *; intros; decompose [and] H0; clear H0; + assert (H5 : Rmax a b = b). + unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. + assert (H7 : r2 <= b). + rewrite H5 in H2; rewrite <- H2; apply RList_P7; + [ assumption | simpl in |- *; right; left; reflexivity ]. + repeat split. + apply RList_P4 with r1; assumption. + rewrite H5 in H2; unfold Rmin in |- *; case (Rle_dec r2 b); intro; + [ reflexivity | elim n; assumption ]. + unfold Rmax in |- *; case (Rle_dec r2 b); intro; + [ rewrite H5 in H2; rewrite <- H2; reflexivity | elim n; assumption ]. + simpl in H4; simpl in |- *; apply INR_eq; apply Rplus_eq_reg_l with 1; + do 2 rewrite (Rplus_comm 1); do 2 rewrite <- S_INR; + rewrite H4; reflexivity. + intros; unfold constant_D_eq, open_interval in |- *; intros; + unfold constant_D_eq, open_interval in H6; + assert (H9 : (S i < pred (Rlength (cons r1 (cons r2 l))))%nat). + simpl in |- *; simpl in H0; apply lt_n_S; assumption. + assert (H10 := H6 _ H9); apply H10; assumption. Qed. Lemma StepFun_P8 : - forall (f:R -> R) (l1 lf1:Rlist) (a b:R), - adapted_couple f a b l1 lf1 -> a = b -> Int_SF lf1 l1 = 0. -simple induction l1. -intros; induction lf1 as [| r lf1 Hreclf1]; reflexivity. -simple induction r0. -intros; induction lf1 as [| r1 lf1 Hreclf1]. -reflexivity. -unfold adapted_couple in H0; decompose [and] H0; clear H0; simpl in H5; - discriminate. -intros; induction lf1 as [| r3 lf1 Hreclf1]. -reflexivity. -simpl in |- *; cut (r = r1). -intro; rewrite H3; rewrite (H0 lf1 r b). -ring. -rewrite H3; apply StepFun_P7 with a r r3; [ right; assumption | assumption ]. -clear H H0 Hreclf1 r0; unfold adapted_couple in H1; decompose [and] H1; - intros; simpl in H4; rewrite H4; unfold Rmin in |- *; - case (Rle_dec a b); intro; [ assumption | reflexivity ]. -unfold adapted_couple in H1; decompose [and] H1; intros; apply Rle_antisym. -apply (H3 0%nat); simpl in |- *; apply lt_O_Sn. -simpl in H5; rewrite H2 in H5; rewrite H5; replace (Rmin b b) with (Rmax a b); - [ rewrite <- H4; apply RList_P7; - [ assumption | simpl in |- *; right; left; reflexivity ] - | unfold Rmin, Rmax in |- *; case (Rle_dec b b); case (Rle_dec a b); intros; - try assumption || reflexivity ]. + forall (f:R -> R) (l1 lf1:Rlist) (a b:R), + adapted_couple f a b l1 lf1 -> a = b -> Int_SF lf1 l1 = 0. +Proof. + simple induction l1. + intros; induction lf1 as [| r lf1 Hreclf1]; reflexivity. + simple induction r0. + intros; induction lf1 as [| r1 lf1 Hreclf1]. + reflexivity. + unfold adapted_couple in H0; decompose [and] H0; clear H0; simpl in H5; + discriminate. + intros; induction lf1 as [| r3 lf1 Hreclf1]. + reflexivity. + simpl in |- *; cut (r = r1). + intro; rewrite H3; rewrite (H0 lf1 r b). + ring. + rewrite H3; apply StepFun_P7 with a r r3; [ right; assumption | assumption ]. + clear H H0 Hreclf1 r0; unfold adapted_couple in H1; decompose [and] H1; + intros; simpl in H4; rewrite H4; unfold Rmin in |- *; + case (Rle_dec a b); intro; [ assumption | reflexivity ]. + unfold adapted_couple in H1; decompose [and] H1; intros; apply Rle_antisym. + apply (H3 0%nat); simpl in |- *; apply lt_O_Sn. + simpl in H5; rewrite H2 in H5; rewrite H5; replace (Rmin b b) with (Rmax a b); + [ rewrite <- H4; apply RList_P7; + [ assumption | simpl in |- *; right; left; reflexivity ] + | unfold Rmin, Rmax in |- *; case (Rle_dec b b); case (Rle_dec a b); intros; + try assumption || reflexivity ]. Qed. Lemma StepFun_P9 : - forall (a b:R) (f:R -> R) (l lf:Rlist), - adapted_couple f a b l lf -> a <> b -> (2 <= Rlength l)%nat. -intros; unfold adapted_couple in H; decompose [and] H; clear H; - induction l as [| r l Hrecl]; - [ simpl in H4; discriminate - | induction l as [| r0 l Hrecl0]; - [ simpl in H3; simpl in H2; generalize H3; generalize H2; - unfold Rmin, Rmax in |- *; case (Rle_dec a b); - intros; elim H0; rewrite <- H5; rewrite <- H7; - reflexivity - | simpl in |- *; do 2 apply le_n_S; apply le_O_n ] ]. + forall (a b:R) (f:R -> R) (l lf:Rlist), + adapted_couple f a b l lf -> a <> b -> (2 <= Rlength l)%nat. +Proof. + intros; unfold adapted_couple in H; decompose [and] H; clear H; + induction l as [| r l Hrecl]; + [ simpl in H4; discriminate + | induction l as [| r0 l Hrecl0]; + [ simpl in H3; simpl in H2; generalize H3; generalize H2; + unfold Rmin, Rmax in |- *; case (Rle_dec a b); + intros; elim H0; rewrite <- H5; rewrite <- H7; + reflexivity + | simpl in |- *; do 2 apply le_n_S; apply le_O_n ] ]. Qed. Lemma StepFun_P10 : - forall (f:R -> R) (l lf:Rlist) (a b:R), - a <= b -> - adapted_couple f a b l lf -> + forall (f:R -> R) (l lf:Rlist) (a b:R), + a <= b -> + adapted_couple f a b l lf -> exists l' : Rlist, - (exists lf' : Rlist, adapted_couple_opt f a b l' lf'). -simple induction l. -intros; unfold adapted_couple in H0; decompose [and] H0; simpl in H4; - discriminate. -intros; case (Req_dec a b); intro. -exists (cons a nil); exists nil; unfold adapted_couple_opt in |- *; - unfold adapted_couple in |- *; unfold ordered_Rlist in |- *; - repeat split; try (intros; simpl in H3; elim (lt_n_O _ H3)). -simpl in |- *; rewrite <- H2; unfold Rmin in |- *; case (Rle_dec a a); intro; - reflexivity. -simpl in |- *; rewrite <- H2; unfold Rmax in |- *; case (Rle_dec a a); intro; - reflexivity. -elim (RList_P20 _ (StepFun_P9 H1 H2)); intros t1 [t2 [t3 H3]]; - induction lf as [| r1 lf Hreclf]. -unfold adapted_couple in H1; decompose [and] H1; rewrite H3 in H7; - simpl in H7; discriminate. -clear Hreclf; assert (H4 : adapted_couple f t2 b r0 lf). -rewrite H3 in H1; assert (H4 := RList_P21 _ _ H3); simpl in H4; rewrite H4; - eapply StepFun_P7; [ apply H0 | apply H1 ]. -cut (t2 <= b). -intro; assert (H6 := H _ _ _ H5 H4); case (Req_dec t1 t2); intro Hyp_eq. -replace a with t2. -apply H6. -rewrite <- Hyp_eq; rewrite H3 in H1; unfold adapted_couple in H1; - decompose [and] H1; clear H1; simpl in H9; rewrite H9; - unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ]. -elim H6; clear H6; intros l' [lf' H6]; case (Req_dec t2 b); intro. -exists (cons a (cons b nil)); exists (cons r1 nil); - unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; - repeat split. -unfold ordered_Rlist in |- *; intros; simpl in H8; inversion H8; - [ simpl in |- *; assumption | elim (le_Sn_O _ H10) ]. -simpl in |- *; unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ]. -simpl in |- *; unfold Rmax in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ]. -intros; simpl in H8; inversion H8. -unfold constant_D_eq, open_interval in |- *; intros; simpl in |- *; - simpl in H9; rewrite H3 in H1; unfold adapted_couple in H1; - decompose [and] H1; apply (H16 0%nat). -simpl in |- *; apply lt_O_Sn. -unfold open_interval in |- *; simpl in |- *; rewrite H7; simpl in H13; - rewrite H13; unfold Rmin in |- *; case (Rle_dec a b); - intro; [ assumption | elim n; assumption ]. -elim (le_Sn_O _ H10). -intros; simpl in H8; elim (lt_n_O _ H8). -intros; simpl in H8; inversion H8; - [ simpl in |- *; assumption | elim (le_Sn_O _ H10) ]. -assert (Hyp_min : Rmin t2 b = t2). -unfold Rmin in |- *; case (Rle_dec t2 b); intro; - [ reflexivity | elim n; assumption ]. -unfold adapted_couple in H6; elim H6; clear H6; intros; - elim (RList_P20 _ (StepFun_P9 H6 H7)); intros s1 [s2 [s3 H9]]; - induction lf' as [| r2 lf' Hreclf']. -unfold adapted_couple in H6; decompose [and] H6; rewrite H9 in H13; - simpl in H13; discriminate. -clear Hreclf'; case (Req_dec r1 r2); intro. -case (Req_dec (f t2) r1); intro. -exists (cons t1 (cons s2 s3)); exists (cons r1 lf'); rewrite H3 in H1; - rewrite H9 in H6; unfold adapted_couple in H6, H1; - decompose [and] H1; decompose [and] H6; clear H1 H6; - unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; - repeat split. -unfold ordered_Rlist in |- *; intros; simpl in H1; - induction i as [| i Hreci]. -simpl in |- *; apply Rle_trans with s1. -replace s1 with t2. -apply (H12 0%nat). -simpl in |- *; apply lt_O_Sn. -simpl in H19; rewrite H19; symmetry in |- *; apply Hyp_min. -apply (H16 0%nat); simpl in |- *; apply lt_O_Sn. -change (pos_Rl (cons s2 s3) i <= pos_Rl (cons s2 s3) (S i)) in |- *; - apply (H16 (S i)); simpl in |- *; assumption. -simpl in |- *; simpl in H14; rewrite H14; reflexivity. -simpl in |- *; simpl in H18; rewrite H18; unfold Rmax in |- *; - case (Rle_dec a b); case (Rle_dec t2 b); intros; reflexivity || elim n; - assumption. -simpl in |- *; simpl in H20; apply H20. -intros; simpl in H1; unfold constant_D_eq, open_interval in |- *; intros; - induction i as [| i Hreci]. -simpl in |- *; simpl in H6; case (total_order_T x t2); intro. -elim s; intro. -apply (H17 0%nat); - [ simpl in |- *; apply lt_O_Sn - | unfold open_interval in |- *; simpl in |- *; elim H6; intros; split; - assumption ]. -rewrite b0; assumption. -rewrite H10; apply (H22 0%nat); - [ simpl in |- *; apply lt_O_Sn - | unfold open_interval in |- *; simpl in |- *; replace s1 with t2; - [ elim H6; intros; split; assumption - | simpl in H19; rewrite H19; rewrite Hyp_min; reflexivity ] ]. -simpl in |- *; simpl in H6; apply (H22 (S i)); - [ simpl in |- *; assumption - | unfold open_interval in |- *; simpl in |- *; apply H6 ]. -intros; simpl in H1; rewrite H10; - change - (pos_Rl (cons r2 lf') i <> pos_Rl (cons r2 lf') (S i) \/ - f (pos_Rl (cons s1 (cons s2 s3)) (S i)) <> pos_Rl (cons r2 lf') i) - in |- *; rewrite <- H9; elim H8; intros; apply H6; - simpl in |- *; apply H1. -intros; induction i as [| i Hreci]. -simpl in |- *; red in |- *; intro; elim Hyp_eq; apply Rle_antisym. -apply (H12 0%nat); simpl in |- *; apply lt_O_Sn. -rewrite <- Hyp_min; rewrite H6; simpl in H19; rewrite <- H19; - apply (H16 0%nat); simpl in |- *; apply lt_O_Sn. -elim H8; intros; rewrite H9 in H21; apply (H21 (S i)); simpl in |- *; - simpl in H1; apply H1. -exists (cons t1 l'); exists (cons r1 (cons r2 lf')); rewrite H9 in H6; - rewrite H3 in H1; unfold adapted_couple in H1, H6; - decompose [and] H6; decompose [and] H1; clear H6 H1; - unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; - repeat split. -rewrite H9; unfold ordered_Rlist in |- *; intros; simpl in H1; - induction i as [| i Hreci]. -simpl in |- *; replace s1 with t2. -apply (H16 0%nat); simpl in |- *; apply lt_O_Sn. -simpl in H14; rewrite H14; rewrite Hyp_min; reflexivity. -change - (pos_Rl (cons s1 (cons s2 s3)) i <= pos_Rl (cons s1 (cons s2 s3)) (S i)) - in |- *; apply (H12 i); simpl in |- *; apply lt_S_n; - assumption. -simpl in |- *; simpl in H19; apply H19. -rewrite H9; simpl in |- *; simpl in H13; rewrite H13; unfold Rmax in |- *; - case (Rle_dec t2 b); case (Rle_dec a b); intros; reflexivity || elim n; - assumption. -rewrite H9; simpl in |- *; simpl in H15; rewrite H15; reflexivity. -intros; simpl in H1; unfold constant_D_eq, open_interval in |- *; intros; - induction i as [| i Hreci]. -simpl in |- *; rewrite H9 in H6; simpl in H6; apply (H22 0%nat). -simpl in |- *; apply lt_O_Sn. -unfold open_interval in |- *; simpl in |- *. -replace t2 with s1. -assumption. -simpl in H14; rewrite H14; rewrite Hyp_min; reflexivity. -change (f x = pos_Rl (cons r2 lf') i) in |- *; clear Hreci; apply (H17 i). -simpl in |- *; rewrite H9 in H1; simpl in H1; apply lt_S_n; apply H1. -rewrite H9 in H6; unfold open_interval in |- *; apply H6. -intros; simpl in H1; induction i as [| i Hreci]. -simpl in |- *; rewrite H9; right; simpl in |- *; replace s1 with t2. -assumption. -simpl in H14; rewrite H14; rewrite Hyp_min; reflexivity. -elim H8; intros; apply (H6 i). -simpl in |- *; apply lt_S_n; apply H1. -intros; rewrite H9; induction i as [| i Hreci]. -simpl in |- *; red in |- *; intro; elim Hyp_eq; apply Rle_antisym. -apply (H16 0%nat); simpl in |- *; apply lt_O_Sn. -rewrite <- Hyp_min; rewrite H6; simpl in H14; rewrite <- H14; right; - reflexivity. -elim H8; intros; rewrite <- H9; apply (H21 i); rewrite H9; rewrite H9 in H1; - simpl in |- *; simpl in H1; apply lt_S_n; apply H1. -exists (cons t1 l'); exists (cons r1 (cons r2 lf')); rewrite H9 in H6; - rewrite H3 in H1; unfold adapted_couple in H1, H6; - decompose [and] H6; decompose [and] H1; clear H6 H1; - unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; - repeat split. -rewrite H9; unfold ordered_Rlist in |- *; intros; simpl in H1; - induction i as [| i Hreci]. -simpl in |- *; replace s1 with t2. -apply (H15 0%nat); simpl in |- *; apply lt_O_Sn. -simpl in H13; rewrite H13; rewrite Hyp_min; reflexivity. -change - (pos_Rl (cons s1 (cons s2 s3)) i <= pos_Rl (cons s1 (cons s2 s3)) (S i)) - in |- *; apply (H11 i); simpl in |- *; apply lt_S_n; - assumption. -simpl in |- *; simpl in H18; apply H18. -rewrite H9; simpl in |- *; simpl in H12; rewrite H12; unfold Rmax in |- *; - case (Rle_dec t2 b); case (Rle_dec a b); intros; reflexivity || elim n; - assumption. -rewrite H9; simpl in |- *; simpl in H14; rewrite H14; reflexivity. -intros; simpl in H1; unfold constant_D_eq, open_interval in |- *; intros; - induction i as [| i Hreci]. -simpl in |- *; rewrite H9 in H6; simpl in H6; apply (H21 0%nat). -simpl in |- *; apply lt_O_Sn. -unfold open_interval in |- *; simpl in |- *; replace t2 with s1. -assumption. -simpl in H13; rewrite H13; rewrite Hyp_min; reflexivity. -change (f x = pos_Rl (cons r2 lf') i) in |- *; clear Hreci; apply (H16 i). -simpl in |- *; rewrite H9 in H1; simpl in H1; apply lt_S_n; apply H1. -rewrite H9 in H6; unfold open_interval in |- *; apply H6. -intros; simpl in H1; induction i as [| i Hreci]. -simpl in |- *; left; assumption. -elim H8; intros; apply (H6 i). -simpl in |- *; apply lt_S_n; apply H1. -intros; rewrite H9; induction i as [| i Hreci]. -simpl in |- *; red in |- *; intro; elim Hyp_eq; apply Rle_antisym. -apply (H15 0%nat); simpl in |- *; apply lt_O_Sn. -rewrite <- Hyp_min; rewrite H6; simpl in H13; rewrite <- H13; right; - reflexivity. -elim H8; intros; rewrite <- H9; apply (H20 i); rewrite H9; rewrite H9 in H1; - simpl in |- *; simpl in H1; apply lt_S_n; apply H1. -rewrite H3 in H1; clear H4; unfold adapted_couple in H1; decompose [and] H1; - clear H1; clear H H7 H9; cut (Rmax a b = b); - [ intro; rewrite H in H5; rewrite <- H5; apply RList_P7; - [ assumption | simpl in |- *; right; left; reflexivity ] - | unfold Rmax in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ] ]. + (exists lf' : Rlist, adapted_couple_opt f a b l' lf'). +Proof. + simple induction l. + intros; unfold adapted_couple in H0; decompose [and] H0; simpl in H4; + discriminate. + intros; case (Req_dec a b); intro. + exists (cons a nil); exists nil; unfold adapted_couple_opt in |- *; + unfold adapted_couple in |- *; unfold ordered_Rlist in |- *; + repeat split; try (intros; simpl in H3; elim (lt_n_O _ H3)). + simpl in |- *; rewrite <- H2; unfold Rmin in |- *; case (Rle_dec a a); intro; + reflexivity. + simpl in |- *; rewrite <- H2; unfold Rmax in |- *; case (Rle_dec a a); intro; + reflexivity. + elim (RList_P20 _ (StepFun_P9 H1 H2)); intros t1 [t2 [t3 H3]]; + induction lf as [| r1 lf Hreclf]. + unfold adapted_couple in H1; decompose [and] H1; rewrite H3 in H7; + simpl in H7; discriminate. + clear Hreclf; assert (H4 : adapted_couple f t2 b r0 lf). + rewrite H3 in H1; assert (H4 := RList_P21 _ _ H3); simpl in H4; rewrite H4; + eapply StepFun_P7; [ apply H0 | apply H1 ]. + cut (t2 <= b). + intro; assert (H6 := H _ _ _ H5 H4); case (Req_dec t1 t2); intro Hyp_eq. + replace a with t2. + apply H6. + rewrite <- Hyp_eq; rewrite H3 in H1; unfold adapted_couple in H1; + decompose [and] H1; clear H1; simpl in H9; rewrite H9; + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. + elim H6; clear H6; intros l' [lf' H6]; case (Req_dec t2 b); intro. + exists (cons a (cons b nil)); exists (cons r1 nil); + unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; + repeat split. + unfold ordered_Rlist in |- *; intros; simpl in H8; inversion H8; + [ simpl in |- *; assumption | elim (le_Sn_O _ H10) ]. + simpl in |- *; unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. + simpl in |- *; unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. + intros; simpl in H8; inversion H8. + unfold constant_D_eq, open_interval in |- *; intros; simpl in |- *; + simpl in H9; rewrite H3 in H1; unfold adapted_couple in H1; + decompose [and] H1; apply (H16 0%nat). + simpl in |- *; apply lt_O_Sn. + unfold open_interval in |- *; simpl in |- *; rewrite H7; simpl in H13; + rewrite H13; unfold Rmin in |- *; case (Rle_dec a b); + intro; [ assumption | elim n; assumption ]. + elim (le_Sn_O _ H10). + intros; simpl in H8; elim (lt_n_O _ H8). + intros; simpl in H8; inversion H8; + [ simpl in |- *; assumption | elim (le_Sn_O _ H10) ]. + assert (Hyp_min : Rmin t2 b = t2). + unfold Rmin in |- *; case (Rle_dec t2 b); intro; + [ reflexivity | elim n; assumption ]. + unfold adapted_couple in H6; elim H6; clear H6; intros; + elim (RList_P20 _ (StepFun_P9 H6 H7)); intros s1 [s2 [s3 H9]]; + induction lf' as [| r2 lf' Hreclf']. + unfold adapted_couple in H6; decompose [and] H6; rewrite H9 in H13; + simpl in H13; discriminate. + clear Hreclf'; case (Req_dec r1 r2); intro. + case (Req_dec (f t2) r1); intro. + exists (cons t1 (cons s2 s3)); exists (cons r1 lf'); rewrite H3 in H1; + rewrite H9 in H6; unfold adapted_couple in H6, H1; + decompose [and] H1; decompose [and] H6; clear H1 H6; + unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; + repeat split. + unfold ordered_Rlist in |- *; intros; simpl in H1; + induction i as [| i Hreci]. + simpl in |- *; apply Rle_trans with s1. + replace s1 with t2. + apply (H12 0%nat). + simpl in |- *; apply lt_O_Sn. + simpl in H19; rewrite H19; symmetry in |- *; apply Hyp_min. + apply (H16 0%nat); simpl in |- *; apply lt_O_Sn. + change (pos_Rl (cons s2 s3) i <= pos_Rl (cons s2 s3) (S i)) in |- *; + apply (H16 (S i)); simpl in |- *; assumption. + simpl in |- *; simpl in H14; rewrite H14; reflexivity. + simpl in |- *; simpl in H18; rewrite H18; unfold Rmax in |- *; + case (Rle_dec a b); case (Rle_dec t2 b); intros; reflexivity || elim n; + assumption. + simpl in |- *; simpl in H20; apply H20. + intros; simpl in H1; unfold constant_D_eq, open_interval in |- *; intros; + induction i as [| i Hreci]. + simpl in |- *; simpl in H6; case (total_order_T x t2); intro. + elim s; intro. + apply (H17 0%nat); + [ simpl in |- *; apply lt_O_Sn + | unfold open_interval in |- *; simpl in |- *; elim H6; intros; split; + assumption ]. + rewrite b0; assumption. + rewrite H10; apply (H22 0%nat); + [ simpl in |- *; apply lt_O_Sn + | unfold open_interval in |- *; simpl in |- *; replace s1 with t2; + [ elim H6; intros; split; assumption + | simpl in H19; rewrite H19; rewrite Hyp_min; reflexivity ] ]. + simpl in |- *; simpl in H6; apply (H22 (S i)); + [ simpl in |- *; assumption + | unfold open_interval in |- *; simpl in |- *; apply H6 ]. + intros; simpl in H1; rewrite H10; + change + (pos_Rl (cons r2 lf') i <> pos_Rl (cons r2 lf') (S i) \/ + f (pos_Rl (cons s1 (cons s2 s3)) (S i)) <> pos_Rl (cons r2 lf') i) + in |- *; rewrite <- H9; elim H8; intros; apply H6; + simpl in |- *; apply H1. + intros; induction i as [| i Hreci]. + simpl in |- *; red in |- *; intro; elim Hyp_eq; apply Rle_antisym. + apply (H12 0%nat); simpl in |- *; apply lt_O_Sn. + rewrite <- Hyp_min; rewrite H6; simpl in H19; rewrite <- H19; + apply (H16 0%nat); simpl in |- *; apply lt_O_Sn. + elim H8; intros; rewrite H9 in H21; apply (H21 (S i)); simpl in |- *; + simpl in H1; apply H1. + exists (cons t1 l'); exists (cons r1 (cons r2 lf')); rewrite H9 in H6; + rewrite H3 in H1; unfold adapted_couple in H1, H6; + decompose [and] H6; decompose [and] H1; clear H6 H1; + unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; + repeat split. + rewrite H9; unfold ordered_Rlist in |- *; intros; simpl in H1; + induction i as [| i Hreci]. + simpl in |- *; replace s1 with t2. + apply (H16 0%nat); simpl in |- *; apply lt_O_Sn. + simpl in H14; rewrite H14; rewrite Hyp_min; reflexivity. + change + (pos_Rl (cons s1 (cons s2 s3)) i <= pos_Rl (cons s1 (cons s2 s3)) (S i)) + in |- *; apply (H12 i); simpl in |- *; apply lt_S_n; + assumption. + simpl in |- *; simpl in H19; apply H19. + rewrite H9; simpl in |- *; simpl in H13; rewrite H13; unfold Rmax in |- *; + case (Rle_dec t2 b); case (Rle_dec a b); intros; reflexivity || elim n; + assumption. + rewrite H9; simpl in |- *; simpl in H15; rewrite H15; reflexivity. + intros; simpl in H1; unfold constant_D_eq, open_interval in |- *; intros; + induction i as [| i Hreci]. + simpl in |- *; rewrite H9 in H6; simpl in H6; apply (H22 0%nat). + simpl in |- *; apply lt_O_Sn. + unfold open_interval in |- *; simpl in |- *. + replace t2 with s1. + assumption. + simpl in H14; rewrite H14; rewrite Hyp_min; reflexivity. + change (f x = pos_Rl (cons r2 lf') i) in |- *; clear Hreci; apply (H17 i). + simpl in |- *; rewrite H9 in H1; simpl in H1; apply lt_S_n; apply H1. + rewrite H9 in H6; unfold open_interval in |- *; apply H6. + intros; simpl in H1; induction i as [| i Hreci]. + simpl in |- *; rewrite H9; right; simpl in |- *; replace s1 with t2. + assumption. + simpl in H14; rewrite H14; rewrite Hyp_min; reflexivity. + elim H8; intros; apply (H6 i). + simpl in |- *; apply lt_S_n; apply H1. + intros; rewrite H9; induction i as [| i Hreci]. + simpl in |- *; red in |- *; intro; elim Hyp_eq; apply Rle_antisym. + apply (H16 0%nat); simpl in |- *; apply lt_O_Sn. + rewrite <- Hyp_min; rewrite H6; simpl in H14; rewrite <- H14; right; + reflexivity. + elim H8; intros; rewrite <- H9; apply (H21 i); rewrite H9; rewrite H9 in H1; + simpl in |- *; simpl in H1; apply lt_S_n; apply H1. + exists (cons t1 l'); exists (cons r1 (cons r2 lf')); rewrite H9 in H6; + rewrite H3 in H1; unfold adapted_couple in H1, H6; + decompose [and] H6; decompose [and] H1; clear H6 H1; + unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; + repeat split. + rewrite H9; unfold ordered_Rlist in |- *; intros; simpl in H1; + induction i as [| i Hreci]. + simpl in |- *; replace s1 with t2. + apply (H15 0%nat); simpl in |- *; apply lt_O_Sn. + simpl in H13; rewrite H13; rewrite Hyp_min; reflexivity. + change + (pos_Rl (cons s1 (cons s2 s3)) i <= pos_Rl (cons s1 (cons s2 s3)) (S i)) + in |- *; apply (H11 i); simpl in |- *; apply lt_S_n; + assumption. + simpl in |- *; simpl in H18; apply H18. + rewrite H9; simpl in |- *; simpl in H12; rewrite H12; unfold Rmax in |- *; + case (Rle_dec t2 b); case (Rle_dec a b); intros; reflexivity || elim n; + assumption. + rewrite H9; simpl in |- *; simpl in H14; rewrite H14; reflexivity. + intros; simpl in H1; unfold constant_D_eq, open_interval in |- *; intros; + induction i as [| i Hreci]. + simpl in |- *; rewrite H9 in H6; simpl in H6; apply (H21 0%nat). + simpl in |- *; apply lt_O_Sn. + unfold open_interval in |- *; simpl in |- *; replace t2 with s1. + assumption. + simpl in H13; rewrite H13; rewrite Hyp_min; reflexivity. + change (f x = pos_Rl (cons r2 lf') i) in |- *; clear Hreci; apply (H16 i). + simpl in |- *; rewrite H9 in H1; simpl in H1; apply lt_S_n; apply H1. + rewrite H9 in H6; unfold open_interval in |- *; apply H6. + intros; simpl in H1; induction i as [| i Hreci]. + simpl in |- *; left; assumption. + elim H8; intros; apply (H6 i). + simpl in |- *; apply lt_S_n; apply H1. + intros; rewrite H9; induction i as [| i Hreci]. + simpl in |- *; red in |- *; intro; elim Hyp_eq; apply Rle_antisym. + apply (H15 0%nat); simpl in |- *; apply lt_O_Sn. + rewrite <- Hyp_min; rewrite H6; simpl in H13; rewrite <- H13; right; + reflexivity. + elim H8; intros; rewrite <- H9; apply (H20 i); rewrite H9; rewrite H9 in H1; + simpl in |- *; simpl in H1; apply lt_S_n; apply H1. + rewrite H3 in H1; clear H4; unfold adapted_couple in H1; decompose [and] H1; + clear H1; clear H H7 H9; cut (Rmax a b = b); + [ intro; rewrite H in H5; rewrite <- H5; apply RList_P7; + [ assumption | simpl in |- *; right; left; reflexivity ] + | unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ] ]. Qed. Lemma StepFun_P11 : - forall (a b r r1 r3 s1 s2 r4:R) (r2 lf1 s3 lf2:Rlist) - (f:R -> R), - a < b -> - adapted_couple f a b (cons r (cons r1 r2)) (cons r3 lf1) -> - adapted_couple_opt f a b (cons s1 (cons s2 s3)) (cons r4 lf2) -> r1 <= s2. -intros; unfold adapted_couple_opt in H1; elim H1; clear H1; intros; - unfold adapted_couple in H0, H1; decompose [and] H0; - decompose [and] H1; clear H0 H1; assert (H12 : r = s1). -simpl in H10; simpl in H5; rewrite H10; rewrite H5; reflexivity. -assert (H14 := H3 0%nat (lt_O_Sn _)); simpl in H14; elim H14; intro. -assert (H15 := H7 0%nat (lt_O_Sn _)); simpl in H15; elim H15; intro. -rewrite <- H12 in H1; case (Rle_dec r1 s2); intro; try assumption. -assert (H16 : s2 < r1); auto with real. -induction s3 as [| r0 s3 Hrecs3]. -simpl in H9; rewrite H9 in H16; cut (r1 <= Rmax a b). -intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H17 H16)). -rewrite <- H4; apply RList_P7; - [ assumption | simpl in |- *; right; left; reflexivity ]. -clear Hrecs3; induction lf2 as [| r5 lf2 Hreclf2]. -simpl in H11; discriminate. -clear Hreclf2; assert (H17 : r3 = r4). -set (x := (r + s2) / 2); assert (H17 := H8 0%nat (lt_O_Sn _)); - assert (H18 := H13 0%nat (lt_O_Sn _)); - unfold constant_D_eq, open_interval in H17, H18; simpl in H17; - simpl in H18; rewrite <- (H17 x). -rewrite <- (H18 x). -reflexivity. -rewrite <- H12; unfold x in |- *; split. -apply Rmult_lt_reg_l with 2; - [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption - | discrR ] ]. -apply Rmult_lt_reg_l with 2; - [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; rewrite (Rplus_comm r); rewrite double; - apply Rplus_lt_compat_l; assumption - | discrR ] ]. -unfold x in |- *; split. -apply Rmult_lt_reg_l with 2; - [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption - | discrR ] ]. -apply Rlt_trans with s2; - [ apply Rmult_lt_reg_l with 2; + forall (a b r r1 r3 s1 s2 r4:R) (r2 lf1 s3 lf2:Rlist) + (f:R -> R), + a < b -> + adapted_couple f a b (cons r (cons r1 r2)) (cons r3 lf1) -> + adapted_couple_opt f a b (cons s1 (cons s2 s3)) (cons r4 lf2) -> r1 <= s2. +Proof. + intros; unfold adapted_couple_opt in H1; elim H1; clear H1; intros; + unfold adapted_couple in H0, H1; decompose [and] H0; + decompose [and] H1; clear H0 H1; assert (H12 : r = s1). + simpl in H10; simpl in H5; rewrite H10; rewrite H5; reflexivity. + assert (H14 := H3 0%nat (lt_O_Sn _)); simpl in H14; elim H14; intro. + assert (H15 := H7 0%nat (lt_O_Sn _)); simpl in H15; elim H15; intro. + rewrite <- H12 in H1; case (Rle_dec r1 s2); intro; try assumption. + assert (H16 : s2 < r1); auto with real. + induction s3 as [| r0 s3 Hrecs3]. + simpl in H9; rewrite H9 in H16; cut (r1 <= Rmax a b). + intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H17 H16)). + rewrite <- H4; apply RList_P7; + [ assumption | simpl in |- *; right; left; reflexivity ]. + clear Hrecs3; induction lf2 as [| r5 lf2 Hreclf2]. + simpl in H11; discriminate. + clear Hreclf2; assert (H17 : r3 = r4). + set (x := (r + s2) / 2); assert (H17 := H8 0%nat (lt_O_Sn _)); + assert (H18 := H13 0%nat (lt_O_Sn _)); + unfold constant_D_eq, open_interval in H17, H18; simpl in H17; + simpl in H18; rewrite <- (H17 x). + rewrite <- (H18 x). + reflexivity. + rewrite <- H12; unfold x in |- *; split. + apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. + apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite (Rplus_comm r); rewrite double; + apply Rplus_lt_compat_l; assumption + | discrR ] ]. + unfold x in |- *; split. + apply Rmult_lt_reg_l with 2; [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); - rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; rewrite (Rplus_comm r); rewrite double; - apply Rplus_lt_compat_l; assumption - | discrR ] ] - | assumption ]. -assert (H18 : f s2 = r3). -apply (H8 0%nat); - [ simpl in |- *; apply lt_O_Sn - | unfold open_interval in |- *; simpl in |- *; split; assumption ]. -assert (H19 : r3 = r5). -assert (H19 := H7 1%nat); simpl in H19; - assert (H20 := H19 (lt_n_S _ _ (lt_O_Sn _))); elim H20; - intro. -set (x := (s2 + Rmin r1 r0) / 2); assert (H22 := H8 0%nat); - assert (H23 := H13 1%nat); simpl in H22; simpl in H23; - rewrite <- (H22 (lt_O_Sn _) x). -rewrite <- (H23 (lt_n_S _ _ (lt_O_Sn _)) x). -reflexivity. -unfold open_interval in |- *; simpl in |- *; unfold x in |- *; split. -apply Rmult_lt_reg_l with 2; - [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; - unfold Rmin in |- *; case (Rle_dec r1 r0); intro; - assumption - | discrR ] ]. -apply Rmult_lt_reg_l with 2; - [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; rewrite double; - apply Rlt_le_trans with (r0 + Rmin r1 r0); - [ do 2 rewrite <- (Rplus_comm (Rmin r1 r0)); apply Rplus_lt_compat_l; - assumption - | apply Rplus_le_compat_l; apply Rmin_r ] - | discrR ] ]. -unfold open_interval in |- *; simpl in |- *; unfold x in |- *; split. -apply Rlt_trans with s2; - [ assumption - | apply Rmult_lt_reg_l with 2; + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. + apply Rlt_trans with s2; + [ apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); + rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite (Rplus_comm r); rewrite double; + apply Rplus_lt_compat_l; assumption + | discrR ] ] + | assumption ]. + assert (H18 : f s2 = r3). + apply (H8 0%nat); + [ simpl in |- *; apply lt_O_Sn + | unfold open_interval in |- *; simpl in |- *; split; assumption ]. + assert (H19 : r3 = r5). + assert (H19 := H7 1%nat); simpl in H19; + assert (H20 := H19 (lt_n_S _ _ (lt_O_Sn _))); elim H20; + intro. + set (x := (s2 + Rmin r1 r0) / 2); assert (H22 := H8 0%nat); + assert (H23 := H13 1%nat); simpl in H22; simpl in H23; + rewrite <- (H22 (lt_O_Sn _) x). + rewrite <- (H23 (lt_n_S _ _ (lt_O_Sn _)) x). + reflexivity. + unfold open_interval in |- *; simpl in |- *; unfold x in |- *; split. + apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; + unfold Rmin in |- *; case (Rle_dec r1 r0); intro; + assumption + | discrR ] ]. + apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; + apply Rlt_le_trans with (r0 + Rmin r1 r0); + [ do 2 rewrite <- (Rplus_comm (Rmin r1 r0)); apply Rplus_lt_compat_l; + assumption + | apply Rplus_le_compat_l; apply Rmin_r ] + | discrR ] ]. + unfold open_interval in |- *; simpl in |- *; unfold x in |- *; split. + apply Rlt_trans with s2; + [ assumption + | apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); + rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; + unfold Rmin in |- *; case (Rle_dec r1 r0); + intro; assumption + | discrR ] ] ]. + apply Rmult_lt_reg_l with 2; [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); - rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; - unfold Rmin in |- *; case (Rle_dec r1 r0); - intro; assumption - | discrR ] ] ]. -apply Rmult_lt_reg_l with 2; - [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; rewrite double; - apply Rlt_le_trans with (r1 + Rmin r1 r0); - [ do 2 rewrite <- (Rplus_comm (Rmin r1 r0)); apply Rplus_lt_compat_l; - assumption - | apply Rplus_le_compat_l; apply Rmin_l ] - | discrR ] ]. -elim H2; clear H2; intros; assert (H23 := H22 1%nat); simpl in H23; - assert (H24 := H23 (lt_n_S _ _ (lt_O_Sn _))); elim H24; - assumption. -elim H2; intros; assert (H22 := H20 0%nat); simpl in H22; - assert (H23 := H22 (lt_O_Sn _)); elim H23; intro; - [ elim H24; rewrite <- H17; rewrite <- H19; reflexivity - | elim H24; rewrite <- H17; assumption ]. -elim H2; clear H2; intros; assert (H17 := H16 0%nat); simpl in H17; - elim (H17 (lt_O_Sn _)); assumption. -rewrite <- H0; rewrite H12; apply (H7 0%nat); simpl in |- *; apply lt_O_Sn. + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; + apply Rlt_le_trans with (r1 + Rmin r1 r0); + [ do 2 rewrite <- (Rplus_comm (Rmin r1 r0)); apply Rplus_lt_compat_l; + assumption + | apply Rplus_le_compat_l; apply Rmin_l ] + | discrR ] ]. + elim H2; clear H2; intros; assert (H23 := H22 1%nat); simpl in H23; + assert (H24 := H23 (lt_n_S _ _ (lt_O_Sn _))); elim H24; + assumption. + elim H2; intros; assert (H22 := H20 0%nat); simpl in H22; + assert (H23 := H22 (lt_O_Sn _)); elim H23; intro; + [ elim H24; rewrite <- H17; rewrite <- H19; reflexivity + | elim H24; rewrite <- H17; assumption ]. + elim H2; clear H2; intros; assert (H17 := H16 0%nat); simpl in H17; + elim (H17 (lt_O_Sn _)); assumption. + rewrite <- H0; rewrite H12; apply (H7 0%nat); simpl in |- *; apply lt_O_Sn. Qed. Lemma StepFun_P12 : - forall (a b:R) (f:R -> R) (l lf:Rlist), - adapted_couple_opt f a b l lf -> adapted_couple_opt f b a l lf. -unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; intros; - decompose [and] H; clear H; repeat split; try assumption. -rewrite H0; unfold Rmin in |- *; case (Rle_dec a b); intro; - case (Rle_dec b a); intro; try reflexivity. -apply Rle_antisym; assumption. -apply Rle_antisym; auto with real. -rewrite H3; unfold Rmax in |- *; case (Rle_dec a b); intro; - case (Rle_dec b a); intro; try reflexivity. -apply Rle_antisym; assumption. -apply Rle_antisym; auto with real. + forall (a b:R) (f:R -> R) (l lf:Rlist), + adapted_couple_opt f a b l lf -> adapted_couple_opt f b a l lf. +Proof. + unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; intros; + decompose [and] H; clear H; repeat split; try assumption. + rewrite H0; unfold Rmin in |- *; case (Rle_dec a b); intro; + case (Rle_dec b a); intro; try reflexivity. + apply Rle_antisym; assumption. + apply Rle_antisym; auto with real. + rewrite H3; unfold Rmax in |- *; case (Rle_dec a b); intro; + case (Rle_dec b a); intro; try reflexivity. + apply Rle_antisym; assumption. + apply Rle_antisym; auto with real. Qed. Lemma StepFun_P13 : - forall (a b r r1 r3 s1 s2 r4:R) (r2 lf1 s3 lf2:Rlist) - (f:R -> R), - a <> b -> - adapted_couple f a b (cons r (cons r1 r2)) (cons r3 lf1) -> - adapted_couple_opt f a b (cons s1 (cons s2 s3)) (cons r4 lf2) -> r1 <= s2. -intros; case (total_order_T a b); intro. -elim s; intro. -eapply StepFun_P11; [ apply a0 | apply H0 | apply H1 ]. -elim H; assumption. -eapply StepFun_P11; - [ apply r0 | apply StepFun_P2; apply H0 | apply StepFun_P12; apply H1 ]. + forall (a b r r1 r3 s1 s2 r4:R) (r2 lf1 s3 lf2:Rlist) + (f:R -> R), + a <> b -> + adapted_couple f a b (cons r (cons r1 r2)) (cons r3 lf1) -> + adapted_couple_opt f a b (cons s1 (cons s2 s3)) (cons r4 lf2) -> r1 <= s2. +Proof. + intros; case (total_order_T a b); intro. + elim s; intro. + eapply StepFun_P11; [ apply a0 | apply H0 | apply H1 ]. + elim H; assumption. + eapply StepFun_P11; + [ apply r0 | apply StepFun_P2; apply H0 | apply StepFun_P12; apply H1 ]. Qed. Lemma StepFun_P14 : - forall (f:R -> R) (l1 l2 lf1 lf2:Rlist) (a b:R), - a <= b -> - adapted_couple f a b l1 lf1 -> - adapted_couple_opt f a b l2 lf2 -> Int_SF lf1 l1 = Int_SF lf2 l2. -simple induction l1. -intros l2 lf1 lf2 a b Hyp H H0; unfold adapted_couple in H; decompose [and] H; - clear H H0 H2 H3 H1 H6; simpl in H4; discriminate. -simple induction r0. -intros; case (Req_dec a b); intro. -unfold adapted_couple_opt in H2; elim H2; intros; rewrite (StepFun_P8 H4 H3); - rewrite (StepFun_P8 H1 H3); reflexivity. -assert (H4 := StepFun_P9 H1 H3); simpl in H4; - elim (le_Sn_O _ (le_S_n _ _ H4)). -intros; clear H; unfold adapted_couple_opt in H3; elim H3; clear H3; intros; - case (Req_dec a b); intro. -rewrite (StepFun_P8 H2 H4); rewrite (StepFun_P8 H H4); reflexivity. -assert (Hyp_min : Rmin a b = a). -unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ]. -assert (Hyp_max : Rmax a b = b). -unfold Rmax in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ]. -elim (RList_P20 _ (StepFun_P9 H H4)); intros s1 [s2 [s3 H5]]; rewrite H5 in H; - rewrite H5; induction lf1 as [| r3 lf1 Hreclf1]. -unfold adapted_couple in H2; decompose [and] H2; - clear H H2 H4 H5 H3 H6 H8 H7 H11; simpl in H9; discriminate. -clear Hreclf1; induction lf2 as [| r4 lf2 Hreclf2]. -unfold adapted_couple in H; decompose [and] H; - clear H H2 H4 H5 H3 H6 H8 H7 H11; simpl in H9; discriminate. -clear Hreclf2; assert (H6 : r = s1). -unfold adapted_couple in H, H2; decompose [and] H; decompose [and] H2; - clear H H2; simpl in H13; simpl in H8; rewrite H13; - rewrite H8; reflexivity. -assert (H7 : r3 = r4 \/ r = r1). -case (Req_dec r r1); intro. -right; assumption. -left; cut (r1 <= s2). -intro; unfold adapted_couple in H2, H; decompose [and] H; decompose [and] H2; - clear H H2; set (x := (r + r1) / 2); assert (H18 := H14 0%nat); - assert (H20 := H19 0%nat); unfold constant_D_eq, open_interval in H18, H20; - simpl in H18; simpl in H20; rewrite <- (H18 (lt_O_Sn _) x). -rewrite <- (H20 (lt_O_Sn _) x). -reflexivity. -assert (H21 := H13 0%nat (lt_O_Sn _)); simpl in H21; elim H21; intro; - [ idtac | elim H7; assumption ]; unfold x in |- *; - split. -apply Rmult_lt_reg_l with 2; - [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; apply H - | discrR ] ]. -apply Rmult_lt_reg_l with 2; - [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; rewrite <- (Rplus_comm r1); rewrite double; - apply Rplus_lt_compat_l; apply H - | discrR ] ]. -rewrite <- H6; assert (H21 := H13 0%nat (lt_O_Sn _)); simpl in H21; elim H21; - intro; [ idtac | elim H7; assumption ]; unfold x in |- *; - split. -apply Rmult_lt_reg_l with 2; - [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; apply H - | discrR ] ]. -apply Rlt_le_trans with r1; - [ apply Rmult_lt_reg_l with 2; + forall (f:R -> R) (l1 l2 lf1 lf2:Rlist) (a b:R), + a <= b -> + adapted_couple f a b l1 lf1 -> + adapted_couple_opt f a b l2 lf2 -> Int_SF lf1 l1 = Int_SF lf2 l2. +Proof. + simple induction l1. + intros l2 lf1 lf2 a b Hyp H H0; unfold adapted_couple in H; decompose [and] H; + clear H H0 H2 H3 H1 H6; simpl in H4; discriminate. + simple induction r0. + intros; case (Req_dec a b); intro. + unfold adapted_couple_opt in H2; elim H2; intros; rewrite (StepFun_P8 H4 H3); + rewrite (StepFun_P8 H1 H3); reflexivity. + assert (H4 := StepFun_P9 H1 H3); simpl in H4; + elim (le_Sn_O _ (le_S_n _ _ H4)). + intros; clear H; unfold adapted_couple_opt in H3; elim H3; clear H3; intros; + case (Req_dec a b); intro. + rewrite (StepFun_P8 H2 H4); rewrite (StepFun_P8 H H4); reflexivity. + assert (Hyp_min : Rmin a b = a). + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. + assert (Hyp_max : Rmax a b = b). + unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. + elim (RList_P20 _ (StepFun_P9 H H4)); intros s1 [s2 [s3 H5]]; rewrite H5 in H; + rewrite H5; induction lf1 as [| r3 lf1 Hreclf1]. + unfold adapted_couple in H2; decompose [and] H2; + clear H H2 H4 H5 H3 H6 H8 H7 H11; simpl in H9; discriminate. + clear Hreclf1; induction lf2 as [| r4 lf2 Hreclf2]. + unfold adapted_couple in H; decompose [and] H; + clear H H2 H4 H5 H3 H6 H8 H7 H11; simpl in H9; discriminate. + clear Hreclf2; assert (H6 : r = s1). + unfold adapted_couple in H, H2; decompose [and] H; decompose [and] H2; + clear H H2; simpl in H13; simpl in H8; rewrite H13; + rewrite H8; reflexivity. + assert (H7 : r3 = r4 \/ r = r1). + case (Req_dec r r1); intro. + right; assumption. + left; cut (r1 <= s2). + intro; unfold adapted_couple in H2, H; decompose [and] H; decompose [and] H2; + clear H H2; set (x := (r + r1) / 2); assert (H18 := H14 0%nat); + assert (H20 := H19 0%nat); unfold constant_D_eq, open_interval in H18, H20; + simpl in H18; simpl in H20; rewrite <- (H18 (lt_O_Sn _) x). + rewrite <- (H20 (lt_O_Sn _) x). + reflexivity. + assert (H21 := H13 0%nat (lt_O_Sn _)); simpl in H21; elim H21; intro; + [ idtac | elim H7; assumption ]; unfold x in |- *; + split. + apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; apply H + | discrR ] ]. + apply Rmult_lt_reg_l with 2; [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); - rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; rewrite <- (Rplus_comm r1); rewrite double; - apply Rplus_lt_compat_l; apply H - | discrR ] ] - | assumption ]. -eapply StepFun_P13. -apply H4. -apply H2. -unfold adapted_couple_opt in |- *; split. -apply H. -rewrite H5 in H3; apply H3. -assert (H8 : r1 <= s2). -eapply StepFun_P13. -apply H4. -apply H2. -unfold adapted_couple_opt in |- *; split. -apply H. -rewrite H5 in H3; apply H3. -elim H7; intro. -simpl in |- *; elim H8; intro. -replace (r4 * (s2 - s1)) with (r3 * (r1 - r) + r3 * (s2 - r1)); - [ idtac | rewrite H9; rewrite H6; ring ]. -rewrite Rplus_assoc; apply Rplus_eq_compat_l; - change - (Int_SF lf1 (cons r1 r2) = Int_SF (cons r3 lf2) (cons r1 (cons s2 s3))) - in |- *; apply H0 with r1 b. -unfold adapted_couple in H2; decompose [and] H2; clear H2; - replace b with (Rmax a b). -rewrite <- H12; apply RList_P7; - [ assumption | simpl in |- *; right; left; reflexivity ]. -eapply StepFun_P7. -apply H1. -apply H2. -unfold adapted_couple_opt in |- *; split. -apply StepFun_P7 with a a r3. -apply H1. -unfold adapted_couple in H2, H; decompose [and] H2; decompose [and] H; - clear H H2; assert (H20 : r = a). -simpl in H13; rewrite H13; apply Hyp_min. -unfold adapted_couple in |- *; repeat split. -unfold ordered_Rlist in |- *; intros; simpl in H; induction i as [| i Hreci]. -simpl in |- *; rewrite <- H20; apply (H11 0%nat). -simpl in |- *; apply lt_O_Sn. -induction i as [| i Hreci0]. -simpl in |- *; assumption. -change (pos_Rl (cons s2 s3) i <= pos_Rl (cons s2 s3) (S i)) in |- *; - apply (H15 (S i)); simpl in |- *; apply lt_S_n; assumption. -simpl in |- *; symmetry in |- *; apply Hyp_min. -rewrite <- H17; reflexivity. -simpl in H19; simpl in |- *; rewrite H19; reflexivity. -intros; simpl in H; unfold constant_D_eq, open_interval in |- *; intros; - induction i as [| i Hreci]. -simpl in |- *; apply (H16 0%nat). -simpl in |- *; apply lt_O_Sn. -simpl in H2; rewrite <- H20 in H2; unfold open_interval in |- *; - simpl in |- *; apply H2. -clear Hreci; induction i as [| i Hreci]. -simpl in |- *; simpl in H2; rewrite H9; apply (H21 0%nat). -simpl in |- *; apply lt_O_Sn. -unfold open_interval in |- *; simpl in |- *; elim H2; intros; split. -apply Rle_lt_trans with r1; try assumption; rewrite <- H6; apply (H11 0%nat); - simpl in |- *; apply lt_O_Sn. -assumption. -clear Hreci; simpl in |- *; apply (H21 (S i)). -simpl in |- *; apply lt_S_n; assumption. -unfold open_interval in |- *; apply H2. -elim H3; clear H3; intros; split. -rewrite H9; - change - (forall i:nat, - (i < pred (Rlength (cons r4 lf2)))%nat -> - pos_Rl (cons r4 lf2) i <> pos_Rl (cons r4 lf2) (S i) \/ - f (pos_Rl (cons s1 (cons s2 s3)) (S i)) <> pos_Rl (cons r4 lf2) i) - in |- *; rewrite <- H5; apply H3. -rewrite H5 in H11; intros; simpl in H12; induction i as [| i Hreci]. -simpl in |- *; red in |- *; intro; rewrite H13 in H10; - elim (Rlt_irrefl _ H10). -clear Hreci; apply (H11 (S i)); simpl in |- *; apply H12. -rewrite H9; rewrite H10; rewrite H6; apply Rplus_eq_compat_l; rewrite <- H10; - apply H0 with r1 b. -unfold adapted_couple in H2; decompose [and] H2; clear H2; - replace b with (Rmax a b). -rewrite <- H12; apply RList_P7; - [ assumption | simpl in |- *; right; left; reflexivity ]. -eapply StepFun_P7. -apply H1. -apply H2. -unfold adapted_couple_opt in |- *; split. -apply StepFun_P7 with a a r3. -apply H1. -unfold adapted_couple in H2, H; decompose [and] H2; decompose [and] H; - clear H H2; assert (H20 : r = a). -simpl in H13; rewrite H13; apply Hyp_min. -unfold adapted_couple in |- *; repeat split. -unfold ordered_Rlist in |- *; intros; simpl in H; induction i as [| i Hreci]. -simpl in |- *; rewrite <- H20; apply (H11 0%nat); simpl in |- *; - apply lt_O_Sn. -rewrite H10; apply (H15 (S i)); simpl in |- *; assumption. -simpl in |- *; symmetry in |- *; apply Hyp_min. -rewrite <- H17; rewrite H10; reflexivity. -simpl in H19; simpl in |- *; apply H19. -intros; simpl in H; unfold constant_D_eq, open_interval in |- *; intros; - induction i as [| i Hreci]. -simpl in |- *; apply (H16 0%nat). -simpl in |- *; apply lt_O_Sn. -simpl in H2; rewrite <- H20 in H2; unfold open_interval in |- *; - simpl in |- *; apply H2. -clear Hreci; simpl in |- *; apply (H21 (S i)). -simpl in |- *; assumption. -rewrite <- H10; unfold open_interval in |- *; apply H2. -elim H3; clear H3; intros; split. -rewrite H5 in H3; intros; apply (H3 (S i)). -simpl in |- *; replace (Rlength lf2) with (S (pred (Rlength lf2))). -apply lt_n_S; apply H12. -symmetry in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *; - intro; rewrite <- H13 in H12; elim (lt_n_O _ H12). -intros; simpl in H12; rewrite H10; rewrite H5 in H11; apply (H11 (S i)); - simpl in |- *; apply lt_n_S; apply H12. -simpl in |- *; rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r; - rewrite Rmult_0_r; rewrite Rplus_0_l; - change - (Int_SF lf1 (cons r1 r2) = Int_SF (cons r4 lf2) (cons s1 (cons s2 s3))) - in |- *; eapply H0. -apply H1. -2: rewrite H5 in H3; unfold adapted_couple_opt in |- *; split; assumption. -assert (H10 : r = a). -unfold adapted_couple in H2; decompose [and] H2; clear H2; simpl in H12; - rewrite H12; apply Hyp_min. -rewrite <- H9; rewrite H10; apply StepFun_P7 with a r r3; - [ apply H1 - | pattern a at 2 in |- *; rewrite <- H10; pattern r at 2 in |- *; rewrite H9; - apply H2 ]. + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite <- (Rplus_comm r1); rewrite double; + apply Rplus_lt_compat_l; apply H + | discrR ] ]. + rewrite <- H6; assert (H21 := H13 0%nat (lt_O_Sn _)); simpl in H21; elim H21; + intro; [ idtac | elim H7; assumption ]; unfold x in |- *; + split. + apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; apply H + | discrR ] ]. + apply Rlt_le_trans with r1; + [ apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); + rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite <- (Rplus_comm r1); rewrite double; + apply Rplus_lt_compat_l; apply H + | discrR ] ] + | assumption ]. + eapply StepFun_P13. + apply H4. + apply H2. + unfold adapted_couple_opt in |- *; split. + apply H. + rewrite H5 in H3; apply H3. + assert (H8 : r1 <= s2). + eapply StepFun_P13. + apply H4. + apply H2. + unfold adapted_couple_opt in |- *; split. + apply H. + rewrite H5 in H3; apply H3. + elim H7; intro. + simpl in |- *; elim H8; intro. + replace (r4 * (s2 - s1)) with (r3 * (r1 - r) + r3 * (s2 - r1)); + [ idtac | rewrite H9; rewrite H6; ring ]. + rewrite Rplus_assoc; apply Rplus_eq_compat_l; + change + (Int_SF lf1 (cons r1 r2) = Int_SF (cons r3 lf2) (cons r1 (cons s2 s3))) + in |- *; apply H0 with r1 b. + unfold adapted_couple in H2; decompose [and] H2; clear H2; + replace b with (Rmax a b). + rewrite <- H12; apply RList_P7; + [ assumption | simpl in |- *; right; left; reflexivity ]. + eapply StepFun_P7. + apply H1. + apply H2. + unfold adapted_couple_opt in |- *; split. + apply StepFun_P7 with a a r3. + apply H1. + unfold adapted_couple in H2, H; decompose [and] H2; decompose [and] H; + clear H H2; assert (H20 : r = a). + simpl in H13; rewrite H13; apply Hyp_min. + unfold adapted_couple in |- *; repeat split. + unfold ordered_Rlist in |- *; intros; simpl in H; induction i as [| i Hreci]. + simpl in |- *; rewrite <- H20; apply (H11 0%nat). + simpl in |- *; apply lt_O_Sn. + induction i as [| i Hreci0]. + simpl in |- *; assumption. + change (pos_Rl (cons s2 s3) i <= pos_Rl (cons s2 s3) (S i)) in |- *; + apply (H15 (S i)); simpl in |- *; apply lt_S_n; assumption. + simpl in |- *; symmetry in |- *; apply Hyp_min. + rewrite <- H17; reflexivity. + simpl in H19; simpl in |- *; rewrite H19; reflexivity. + intros; simpl in H; unfold constant_D_eq, open_interval in |- *; intros; + induction i as [| i Hreci]. + simpl in |- *; apply (H16 0%nat). + simpl in |- *; apply lt_O_Sn. + simpl in H2; rewrite <- H20 in H2; unfold open_interval in |- *; + simpl in |- *; apply H2. + clear Hreci; induction i as [| i Hreci]. + simpl in |- *; simpl in H2; rewrite H9; apply (H21 0%nat). + simpl in |- *; apply lt_O_Sn. + unfold open_interval in |- *; simpl in |- *; elim H2; intros; split. + apply Rle_lt_trans with r1; try assumption; rewrite <- H6; apply (H11 0%nat); + simpl in |- *; apply lt_O_Sn. + assumption. + clear Hreci; simpl in |- *; apply (H21 (S i)). + simpl in |- *; apply lt_S_n; assumption. + unfold open_interval in |- *; apply H2. + elim H3; clear H3; intros; split. + rewrite H9; + change + (forall i:nat, + (i < pred (Rlength (cons r4 lf2)))%nat -> + pos_Rl (cons r4 lf2) i <> pos_Rl (cons r4 lf2) (S i) \/ + f (pos_Rl (cons s1 (cons s2 s3)) (S i)) <> pos_Rl (cons r4 lf2) i) + in |- *; rewrite <- H5; apply H3. + rewrite H5 in H11; intros; simpl in H12; induction i as [| i Hreci]. + simpl in |- *; red in |- *; intro; rewrite H13 in H10; + elim (Rlt_irrefl _ H10). + clear Hreci; apply (H11 (S i)); simpl in |- *; apply H12. + rewrite H9; rewrite H10; rewrite H6; apply Rplus_eq_compat_l; rewrite <- H10; + apply H0 with r1 b. + unfold adapted_couple in H2; decompose [and] H2; clear H2; + replace b with (Rmax a b). + rewrite <- H12; apply RList_P7; + [ assumption | simpl in |- *; right; left; reflexivity ]. + eapply StepFun_P7. + apply H1. + apply H2. + unfold adapted_couple_opt in |- *; split. + apply StepFun_P7 with a a r3. + apply H1. + unfold adapted_couple in H2, H; decompose [and] H2; decompose [and] H; + clear H H2; assert (H20 : r = a). + simpl in H13; rewrite H13; apply Hyp_min. + unfold adapted_couple in |- *; repeat split. + unfold ordered_Rlist in |- *; intros; simpl in H; induction i as [| i Hreci]. + simpl in |- *; rewrite <- H20; apply (H11 0%nat); simpl in |- *; + apply lt_O_Sn. + rewrite H10; apply (H15 (S i)); simpl in |- *; assumption. + simpl in |- *; symmetry in |- *; apply Hyp_min. + rewrite <- H17; rewrite H10; reflexivity. + simpl in H19; simpl in |- *; apply H19. + intros; simpl in H; unfold constant_D_eq, open_interval in |- *; intros; + induction i as [| i Hreci]. + simpl in |- *; apply (H16 0%nat). + simpl in |- *; apply lt_O_Sn. + simpl in H2; rewrite <- H20 in H2; unfold open_interval in |- *; + simpl in |- *; apply H2. + clear Hreci; simpl in |- *; apply (H21 (S i)). + simpl in |- *; assumption. + rewrite <- H10; unfold open_interval in |- *; apply H2. + elim H3; clear H3; intros; split. + rewrite H5 in H3; intros; apply (H3 (S i)). + simpl in |- *; replace (Rlength lf2) with (S (pred (Rlength lf2))). + apply lt_n_S; apply H12. + symmetry in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *; + intro; rewrite <- H13 in H12; elim (lt_n_O _ H12). + intros; simpl in H12; rewrite H10; rewrite H5 in H11; apply (H11 (S i)); + simpl in |- *; apply lt_n_S; apply H12. + simpl in |- *; rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rmult_0_r; rewrite Rplus_0_l; + change + (Int_SF lf1 (cons r1 r2) = Int_SF (cons r4 lf2) (cons s1 (cons s2 s3))) + in |- *; eapply H0. + apply H1. + 2: rewrite H5 in H3; unfold adapted_couple_opt in |- *; split; assumption. + assert (H10 : r = a). + unfold adapted_couple in H2; decompose [and] H2; clear H2; simpl in H12; + rewrite H12; apply Hyp_min. + rewrite <- H9; rewrite H10; apply StepFun_P7 with a r r3; + [ apply H1 + | pattern a at 2 in |- *; rewrite <- H10; pattern r at 2 in |- *; rewrite H9; + apply H2 ]. Qed. Lemma StepFun_P15 : - forall (f:R -> R) (l1 l2 lf1 lf2:Rlist) (a b:R), - adapted_couple f a b l1 lf1 -> - adapted_couple_opt f a b l2 lf2 -> Int_SF lf1 l1 = Int_SF lf2 l2. -intros; case (Rle_dec a b); intro; - [ apply (StepFun_P14 r H H0) - | assert (H1 : b <= a); - [ auto with real - | eapply StepFun_P14; - [ apply H1 | apply StepFun_P2; apply H | apply StepFun_P12; apply H0 ] ] ]. + forall (f:R -> R) (l1 l2 lf1 lf2:Rlist) (a b:R), + adapted_couple f a b l1 lf1 -> + adapted_couple_opt f a b l2 lf2 -> Int_SF lf1 l1 = Int_SF lf2 l2. +Proof. + intros; case (Rle_dec a b); intro; + [ apply (StepFun_P14 r H H0) + | assert (H1 : b <= a); + [ auto with real + | eapply StepFun_P14; + [ apply H1 | apply StepFun_P2; apply H | apply StepFun_P12; apply H0 ] ] ]. Qed. Lemma StepFun_P16 : - forall (f:R -> R) (l lf:Rlist) (a b:R), - adapted_couple f a b l lf -> + forall (f:R -> R) (l lf:Rlist) (a b:R), + adapted_couple f a b l lf -> exists l' : Rlist, - (exists lf' : Rlist, adapted_couple_opt f a b l' lf'). -intros; case (Rle_dec a b); intro; - [ apply (StepFun_P10 r H) - | assert (H1 : b <= a); - [ auto with real - | assert (H2 := StepFun_P10 H1 (StepFun_P2 H)); elim H2; - intros l' [lf' H3]; exists l'; exists lf'; apply StepFun_P12; - assumption ] ]. + (exists lf' : Rlist, adapted_couple_opt f a b l' lf'). +Proof. + intros; case (Rle_dec a b); intro; + [ apply (StepFun_P10 r H) + | assert (H1 : b <= a); + [ auto with real + | assert (H2 := StepFun_P10 H1 (StepFun_P2 H)); elim H2; + intros l' [lf' H3]; exists l'; exists lf'; apply StepFun_P12; + assumption ] ]. Qed. Lemma StepFun_P17 : - forall (f:R -> R) (l1 l2 lf1 lf2:Rlist) (a b:R), - adapted_couple f a b l1 lf1 -> - adapted_couple f a b l2 lf2 -> Int_SF lf1 l1 = Int_SF lf2 l2. -intros; elim (StepFun_P16 H); intros l' [lf' H1]; rewrite (StepFun_P15 H H1); - rewrite (StepFun_P15 H0 H1); reflexivity. + forall (f:R -> R) (l1 l2 lf1 lf2:Rlist) (a b:R), + adapted_couple f a b l1 lf1 -> + adapted_couple f a b l2 lf2 -> Int_SF lf1 l1 = Int_SF lf2 l2. +Proof. + intros; elim (StepFun_P16 H); intros l' [lf' H1]; rewrite (StepFun_P15 H H1); + rewrite (StepFun_P15 H0 H1); reflexivity. Qed. Lemma StepFun_P18 : - forall a b c:R, RiemannInt_SF (mkStepFun (StepFun_P4 a b c)) = c * (b - a). -intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro. -replace - (Int_SF (subdivision_val (mkStepFun (StepFun_P4 a b c))) + forall a b c:R, RiemannInt_SF (mkStepFun (StepFun_P4 a b c)) = c * (b - a). +Proof. + intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro. + replace + (Int_SF (subdivision_val (mkStepFun (StepFun_P4 a b c))) (subdivision (mkStepFun (StepFun_P4 a b c)))) with - (Int_SF (cons c nil) (cons a (cons b nil))); - [ simpl in |- *; ring - | apply StepFun_P17 with (fct_cte c) a b; - [ apply StepFun_P3; assumption - | apply (StepFun_P1 (mkStepFun (StepFun_P4 a b c))) ] ]. -replace - (Int_SF (subdivision_val (mkStepFun (StepFun_P4 a b c))) + (Int_SF (cons c nil) (cons a (cons b nil))); + [ simpl in |- *; ring + | apply StepFun_P17 with (fct_cte c) a b; + [ apply StepFun_P3; assumption + | apply (StepFun_P1 (mkStepFun (StepFun_P4 a b c))) ] ]. + replace + (Int_SF (subdivision_val (mkStepFun (StepFun_P4 a b c))) (subdivision (mkStepFun (StepFun_P4 a b c)))) with - (Int_SF (cons c nil) (cons b (cons a nil))); - [ simpl in |- *; ring - | apply StepFun_P17 with (fct_cte c) a b; - [ apply StepFun_P2; apply StepFun_P3; auto with real - | apply (StepFun_P1 (mkStepFun (StepFun_P4 a b c))) ] ]. + (Int_SF (cons c nil) (cons b (cons a nil))); + [ simpl in |- *; ring + | apply StepFun_P17 with (fct_cte c) a b; + [ apply StepFun_P2; apply StepFun_P3; auto with real + | apply (StepFun_P1 (mkStepFun (StepFun_P4 a b c))) ] ]. Qed. Lemma StepFun_P19 : - forall (l1:Rlist) (f g:R -> R) (l:R), - Int_SF (FF l1 (fun x:R => f x + l * g x)) l1 = - Int_SF (FF l1 f) l1 + l * Int_SF (FF l1 g) l1. -intros; induction l1 as [| r l1 Hrecl1]; - [ simpl in |- *; ring - | induction l1 as [| r0 l1 Hrecl0]; simpl in |- *; - [ ring | simpl in Hrecl1; rewrite Hrecl1; ring ] ]. + forall (l1:Rlist) (f g:R -> R) (l:R), + Int_SF (FF l1 (fun x:R => f x + l * g x)) l1 = + Int_SF (FF l1 f) l1 + l * Int_SF (FF l1 g) l1. +Proof. + intros; induction l1 as [| r l1 Hrecl1]; + [ simpl in |- *; ring + | induction l1 as [| r0 l1 Hrecl0]; simpl in |- *; + [ ring | simpl in Hrecl1; rewrite Hrecl1; ring ] ]. Qed. Lemma StepFun_P20 : - forall (l:Rlist) (f:R -> R), - (0 < Rlength l)%nat -> Rlength l = S (Rlength (FF l f)). -intros l f H; induction l; - [ elim (lt_irrefl _ H) - | simpl in |- *; rewrite RList_P18; rewrite RList_P14; reflexivity ]. + forall (l:Rlist) (f:R -> R), + (0 < Rlength l)%nat -> Rlength l = S (Rlength (FF l f)). +Proof. + intros l f H; induction l; + [ elim (lt_irrefl _ H) + | simpl in |- *; rewrite RList_P18; rewrite RList_P14; reflexivity ]. Qed. Lemma StepFun_P21 : - forall (a b:R) (f:R -> R) (l:Rlist), - is_subdivision f a b l -> adapted_couple f a b l (FF l f). -intros; unfold adapted_couple in |- *; unfold is_subdivision in X; - unfold adapted_couple in X; elim X; clear X; intros; - decompose [and] p; clear p; repeat split; try assumption. -apply StepFun_P20; rewrite H2; apply lt_O_Sn. -intros; assert (H5 := H4 _ H3); unfold constant_D_eq, open_interval in H5; - unfold constant_D_eq, open_interval in |- *; intros; - induction l as [| r l Hrecl]. -discriminate. -unfold FF in |- *; rewrite RList_P12. -simpl in |- *; - change (f x0 = f (pos_Rl (mid_Rlist (cons r l) r) (S i))) in |- *; - rewrite RList_P13; try assumption; rewrite (H5 x0 H6); - rewrite H5. -reflexivity. -split. -apply Rmult_lt_reg_l with 2; - [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; elim H6; - intros; apply Rlt_trans with x0; assumption - | discrR ] ]. -apply Rmult_lt_reg_l with 2; - [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; rewrite double; - rewrite (Rplus_comm (pos_Rl (cons r l) i)); - apply Rplus_lt_compat_l; elim H6; intros; apply Rlt_trans with x0; - assumption - | discrR ] ]. -rewrite RList_P14; simpl in H3; apply H3. + forall (a b:R) (f:R -> R) (l:Rlist), + is_subdivision f a b l -> adapted_couple f a b l (FF l f). +Proof. + intros; unfold adapted_couple in |- *; unfold is_subdivision in X; + unfold adapted_couple in X; elim X; clear X; intros; + decompose [and] p; clear p; repeat split; try assumption. + apply StepFun_P20; rewrite H2; apply lt_O_Sn. + intros; assert (H5 := H4 _ H3); unfold constant_D_eq, open_interval in H5; + unfold constant_D_eq, open_interval in |- *; intros; + induction l as [| r l Hrecl]. + discriminate. + unfold FF in |- *; rewrite RList_P12. + simpl in |- *; + change (f x0 = f (pos_Rl (mid_Rlist (cons r l) r) (S i))) in |- *; + rewrite RList_P13; try assumption; rewrite (H5 x0 H6); + rewrite H5. + reflexivity. + split. + apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; elim H6; + intros; apply Rlt_trans with x0; assumption + | discrR ] ]. + apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; + rewrite (Rplus_comm (pos_Rl (cons r l) i)); + apply Rplus_lt_compat_l; elim H6; intros; apply Rlt_trans with x0; + assumption + | discrR ] ]. + rewrite RList_P14; simpl in H3; apply H3. Qed. Lemma StepFun_P22 : - forall (a b:R) (f g:R -> R) (lf lg:Rlist), - a <= b -> - is_subdivision f a b lf -> - is_subdivision g a b lg -> is_subdivision f a b (cons_ORlist lf lg). -unfold is_subdivision in |- *; intros a b f g lf lg Hyp X X0; elim X; elim X0; - clear X X0; intros lg0 p lf0 p0; assert (Hyp_min : Rmin a b = a). -unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ]. -assert (Hyp_max : Rmax a b = b). -unfold Rmax in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ]. -apply existT with (FF (cons_ORlist lf lg) f); unfold adapted_couple in p, p0; - decompose [and] p; decompose [and] p0; clear p p0; - rewrite Hyp_min in H6; rewrite Hyp_min in H1; rewrite Hyp_max in H0; - rewrite Hyp_max in H5; unfold adapted_couple in |- *; - repeat split. -apply RList_P2; assumption. -rewrite Hyp_min; symmetry in |- *; apply Rle_antisym. -induction lf as [| r lf Hreclf]. -simpl in |- *; right; symmetry in |- *; assumption. -assert - (H10 : - In (pos_Rl (cons_ORlist (cons r lf) lg) 0) (cons_ORlist (cons r lf) lg)). -elim - (RList_P3 (cons_ORlist (cons r lf) lg) - (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros _ H10; - apply H10; exists 0%nat; split; - [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_O_Sn ]. -elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) 0)); - intros H12 _; assert (H13 := H12 H10); elim H13; intro. -elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) 0)); - intros H11 _; assert (H14 := H11 H8); elim H14; intros; - elim H15; clear H15; intros; rewrite H15; rewrite <- H6; - elim (RList_P6 (cons r lf)); intros; apply H17; - [ assumption | apply le_O_n | assumption ]. -elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros H11 _; - assert (H14 := H11 H8); elim H14; intros; elim H15; - clear H15; intros; rewrite H15; rewrite <- H1; elim (RList_P6 lg); - intros; apply H17; [ assumption | apply le_O_n | assumption ]. -induction lf as [| r lf Hreclf]. -simpl in |- *; right; assumption. -assert (H8 : In a (cons_ORlist (cons r lf) lg)). -elim (RList_P9 (cons r lf) lg a); intros; apply H10; left; - elim (RList_P3 (cons r lf) a); intros; apply H12; - exists 0%nat; split; - [ symmetry in |- *; assumption | simpl in |- *; apply lt_O_Sn ]. -apply RList_P5; [ apply RList_P2; assumption | assumption ]. -rewrite Hyp_max; apply Rle_antisym. -induction lf as [| r lf Hreclf]. -simpl in |- *; right; assumption. -assert - (H8 : - In - (pos_Rl (cons_ORlist (cons r lf) lg) - (pred (Rlength (cons_ORlist (cons r lf) lg)))) - (cons_ORlist (cons r lf) lg)). -elim - (RList_P3 (cons_ORlist (cons r lf) lg) - (pos_Rl (cons_ORlist (cons r lf) lg) - (pred (Rlength (cons_ORlist (cons r lf) lg))))); - intros _ H10; apply H10; - exists (pred (Rlength (cons_ORlist (cons r lf) lg))); - split; [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_n_Sn ]. -elim - (RList_P9 (cons r lf) lg - (pos_Rl (cons_ORlist (cons r lf) lg) - (pred (Rlength (cons_ORlist (cons r lf) lg))))); - intros H10 _. -assert (H11 := H10 H8); elim H11; intro. -elim - (RList_P3 (cons r lf) - (pos_Rl (cons_ORlist (cons r lf) lg) - (pred (Rlength (cons_ORlist (cons r lf) lg))))); - intros H13 _; assert (H14 := H13 H12); elim H14; intros; - elim H15; clear H15; intros; rewrite H15; rewrite <- H5; - elim (RList_P6 (cons r lf)); intros; apply H17; - [ assumption - | simpl in |- *; simpl in H14; apply lt_n_Sm_le; assumption - | simpl in |- *; apply lt_n_Sn ]. -elim - (RList_P3 lg - (pos_Rl (cons_ORlist (cons r lf) lg) - (pred (Rlength (cons_ORlist (cons r lf) lg))))); - intros H13 _; assert (H14 := H13 H12); elim H14; intros; - elim H15; clear H15; intros. -rewrite H15; assert (H17 : Rlength lg = S (pred (Rlength lg))). -apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; - rewrite <- H17 in H16; elim (lt_n_O _ H16). -rewrite <- H0; elim (RList_P6 lg); intros; apply H18; - [ assumption - | rewrite H17 in H16; apply lt_n_Sm_le; assumption - | apply lt_pred_n_n; rewrite H17; apply lt_O_Sn ]. -induction lf as [| r lf Hreclf]. -simpl in |- *; right; symmetry in |- *; assumption. -assert (H8 : In b (cons_ORlist (cons r lf) lg)). -elim (RList_P9 (cons r lf) lg b); intros; apply H10; left; - elim (RList_P3 (cons r lf) b); intros; apply H12; - exists (pred (Rlength (cons r lf))); split; - [ symmetry in |- *; assumption | simpl in |- *; apply lt_n_Sn ]. -apply RList_P7; [ apply RList_P2; assumption | assumption ]. -apply StepFun_P20; rewrite RList_P11; rewrite H2; rewrite H7; simpl in |- *; - apply lt_O_Sn. -intros; unfold constant_D_eq, open_interval in |- *; intros; - cut - (exists l : R, - constant_D_eq f - (open_interval (pos_Rl (cons_ORlist lf lg) i) + forall (a b:R) (f g:R -> R) (lf lg:Rlist), + a <= b -> + is_subdivision f a b lf -> + is_subdivision g a b lg -> is_subdivision f a b (cons_ORlist lf lg). +Proof. + unfold is_subdivision in |- *; intros a b f g lf lg Hyp X X0; elim X; elim X0; + clear X X0; intros lg0 p lf0 p0; assert (Hyp_min : Rmin a b = a). + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. + assert (Hyp_max : Rmax a b = b). + unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. + apply existT with (FF (cons_ORlist lf lg) f); unfold adapted_couple in p, p0; + decompose [and] p; decompose [and] p0; clear p p0; + rewrite Hyp_min in H6; rewrite Hyp_min in H1; rewrite Hyp_max in H0; + rewrite Hyp_max in H5; unfold adapted_couple in |- *; + repeat split. + apply RList_P2; assumption. + rewrite Hyp_min; symmetry in |- *; apply Rle_antisym. + induction lf as [| r lf Hreclf]. + simpl in |- *; right; symmetry in |- *; assumption. + assert + (H10 : + In (pos_Rl (cons_ORlist (cons r lf) lg) 0) (cons_ORlist (cons r lf) lg)). + elim + (RList_P3 (cons_ORlist (cons r lf) lg) + (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros _ H10; + apply H10; exists 0%nat; split; + [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_O_Sn ]. + elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) 0)); + intros H12 _; assert (H13 := H12 H10); elim H13; intro. + elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) 0)); + intros H11 _; assert (H14 := H11 H8); elim H14; intros; + elim H15; clear H15; intros; rewrite H15; rewrite <- H6; + elim (RList_P6 (cons r lf)); intros; apply H17; + [ assumption | apply le_O_n | assumption ]. + elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros H11 _; + assert (H14 := H11 H8); elim H14; intros; elim H15; + clear H15; intros; rewrite H15; rewrite <- H1; elim (RList_P6 lg); + intros; apply H17; [ assumption | apply le_O_n | assumption ]. + induction lf as [| r lf Hreclf]. + simpl in |- *; right; assumption. + assert (H8 : In a (cons_ORlist (cons r lf) lg)). + elim (RList_P9 (cons r lf) lg a); intros; apply H10; left; + elim (RList_P3 (cons r lf) a); intros; apply H12; + exists 0%nat; split; + [ symmetry in |- *; assumption | simpl in |- *; apply lt_O_Sn ]. + apply RList_P5; [ apply RList_P2; assumption | assumption ]. + rewrite Hyp_max; apply Rle_antisym. + induction lf as [| r lf Hreclf]. + simpl in |- *; right; assumption. + assert + (H8 : + In + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg)))) + (cons_ORlist (cons r lf) lg)). + elim + (RList_P3 (cons_ORlist (cons r lf) lg) + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg))))); + intros _ H10; apply H10; + exists (pred (Rlength (cons_ORlist (cons r lf) lg))); + split; [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_n_Sn ]. + elim + (RList_P9 (cons r lf) lg + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg))))); + intros H10 _. + assert (H11 := H10 H8); elim H11; intro. + elim + (RList_P3 (cons r lf) + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg))))); + intros H13 _; assert (H14 := H13 H12); elim H14; intros; + elim H15; clear H15; intros; rewrite H15; rewrite <- H5; + elim (RList_P6 (cons r lf)); intros; apply H17; + [ assumption + | simpl in |- *; simpl in H14; apply lt_n_Sm_le; assumption + | simpl in |- *; apply lt_n_Sn ]. + elim + (RList_P3 lg + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg))))); + intros H13 _; assert (H14 := H13 H12); elim H14; intros; + elim H15; clear H15; intros. + rewrite H15; assert (H17 : Rlength lg = S (pred (Rlength lg))). + apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; + rewrite <- H17 in H16; elim (lt_n_O _ H16). + rewrite <- H0; elim (RList_P6 lg); intros; apply H18; + [ assumption + | rewrite H17 in H16; apply lt_n_Sm_le; assumption + | apply lt_pred_n_n; rewrite H17; apply lt_O_Sn ]. + induction lf as [| r lf Hreclf]. + simpl in |- *; right; symmetry in |- *; assumption. + assert (H8 : In b (cons_ORlist (cons r lf) lg)). + elim (RList_P9 (cons r lf) lg b); intros; apply H10; left; + elim (RList_P3 (cons r lf) b); intros; apply H12; + exists (pred (Rlength (cons r lf))); split; + [ symmetry in |- *; assumption | simpl in |- *; apply lt_n_Sn ]. + apply RList_P7; [ apply RList_P2; assumption | assumption ]. + apply StepFun_P20; rewrite RList_P11; rewrite H2; rewrite H7; simpl in |- *; + apply lt_O_Sn. + intros; unfold constant_D_eq, open_interval in |- *; intros; + cut + (exists l : R, + constant_D_eq f + (open_interval (pos_Rl (cons_ORlist lf lg) i) (pos_Rl (cons_ORlist lf lg) (S i))) l). -intros; elim H11; clear H11; intros; assert (H12 := H11); - assert - (Hyp_cons : - exists r : R, (exists r0 : Rlist, cons_ORlist lf lg = cons r r0)). -apply RList_P19; red in |- *; intro; rewrite H13 in H8; elim (lt_n_O _ H8). -elim Hyp_cons; clear Hyp_cons; intros r [r0 Hyp_cons]; rewrite Hyp_cons; - unfold FF in |- *; rewrite RList_P12. -change (f x = f (pos_Rl (mid_Rlist (cons r r0) r) (S i))) in |- *; - rewrite <- Hyp_cons; rewrite RList_P13. -assert (H13 := RList_P2 _ _ H _ H8); elim H13; intro. -unfold constant_D_eq, open_interval in H11, H12; rewrite (H11 x H10); - assert - (H15 : - pos_Rl (cons_ORlist lf lg) i < - (pos_Rl (cons_ORlist lf lg) i + pos_Rl (cons_ORlist lf lg) (S i)) / 2 < - pos_Rl (cons_ORlist lf lg) (S i)). -split. -apply Rmult_lt_reg_l with 2; - [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption - | discrR ] ]. -apply Rmult_lt_reg_l with 2; - [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; rewrite double; - rewrite (Rplus_comm (pos_Rl (cons_ORlist lf lg) i)); - apply Rplus_lt_compat_l; assumption - | discrR ] ]. -rewrite (H11 _ H15); reflexivity. -elim H10; intros; rewrite H14 in H15; - elim (Rlt_irrefl _ (Rlt_trans _ _ _ H16 H15)). -apply H8. -rewrite RList_P14; rewrite Hyp_cons in H8; simpl in H8; apply H8. -assert (H11 : a < b). -apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i). -rewrite <- H6; rewrite <- (RList_P15 lf lg). -elim (RList_P6 (cons_ORlist lf lg)); intros; apply H11. -apply RList_P2; assumption. -apply le_O_n. -apply lt_trans with (pred (Rlength (cons_ORlist lf lg))); - [ assumption - | apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; - rewrite <- H13 in H8; elim (lt_n_O _ H8) ]. -assumption. -assumption. -rewrite H1; assumption. -apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)). -elim H10; intros; apply Rlt_trans with x; assumption. -rewrite <- H5; rewrite <- (RList_P16 lf lg); try assumption. -elim (RList_P6 (cons_ORlist lf lg)); intros; apply H11. -apply RList_P2; assumption. -apply lt_n_Sm_le; apply lt_n_S; assumption. -apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H8; - elim (lt_n_O _ H8). -rewrite H0; assumption. -set - (I := - fun j:nat => - pos_Rl lf j <= pos_Rl (cons_ORlist lf lg) i /\ (j < Rlength lf)%nat); - assert (H12 : Nbound I). -unfold Nbound in |- *; exists (Rlength lf); intros; unfold I in H12; elim H12; - intros; apply lt_le_weak; assumption. -assert (H13 : exists n : nat, I n). -exists 0%nat; unfold I in |- *; split. -apply Rle_trans with (pos_Rl (cons_ORlist lf lg) 0). -right; symmetry in |- *. -apply RList_P15; try assumption; rewrite H1; assumption. -elim (RList_P6 (cons_ORlist lf lg)); intros; apply H13. -apply RList_P2; assumption. -apply le_O_n. -apply lt_trans with (pred (Rlength (cons_ORlist lf lg))). -assumption. -apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H15 in H8; - elim (lt_n_O _ H8). -apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H5; - rewrite <- H6 in H11; rewrite <- H5 in H11; elim (Rlt_irrefl _ H11). -assert (H14 := Nzorn H13 H12); elim H14; clear H14; intros x0 H14; - exists (pos_Rl lf0 x0); unfold constant_D_eq, open_interval in |- *; - intros; assert (H16 := H9 x0); assert (H17 : (x0 < pred (Rlength lf))%nat). -elim H14; clear H14; intros; unfold I in H14; elim H14; clear H14; intros; - apply lt_S_n; replace (S (pred (Rlength lf))) with (Rlength lf). -inversion H18. -2: apply lt_n_S; assumption. -cut (x0 = pred (Rlength lf)). -intro; rewrite H19 in H14; rewrite H5 in H14; - cut (pos_Rl (cons_ORlist lf lg) i < b). -intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H14 H21)). -apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)). -elim H10; intros; apply Rlt_trans with x; assumption. -rewrite <- H5; - apply Rle_trans with - (pos_Rl (cons_ORlist lf lg) (pred (Rlength (cons_ORlist lf lg)))). -elim (RList_P6 (cons_ORlist lf lg)); intros; apply H21. -apply RList_P2; assumption. -apply lt_n_Sm_le; apply lt_n_S; assumption. -apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H23 in H8; - elim (lt_n_O _ H8). -right; apply RList_P16; try assumption; rewrite H0; assumption. -rewrite <- H20; reflexivity. -apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; - rewrite <- H19 in H18; elim (lt_n_O _ H18). -assert (H18 := H16 H17); unfold constant_D_eq, open_interval in H18; - rewrite (H18 x1). -reflexivity. -elim H15; clear H15; intros; elim H14; clear H14; intros; unfold I in H14; - elim H14; clear H14; intros; split. -apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i); assumption. -apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)); try assumption. -assert (H22 : (S x0 < Rlength lf)%nat). -replace (Rlength lf) with (S (pred (Rlength lf))); - [ apply lt_n_S; assumption - | symmetry in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *; - intro; rewrite <- H22 in H21; elim (lt_n_O _ H21) ]. -elim (Rle_dec (pos_Rl lf (S x0)) (pos_Rl (cons_ORlist lf lg) i)); intro. -assert (H23 : (S x0 <= x0)%nat). -apply H20; unfold I in |- *; split; assumption. -elim (le_Sn_n _ H23). -assert (H23 : pos_Rl (cons_ORlist lf lg) i < pos_Rl lf (S x0)). -auto with real. -clear b0; apply RList_P17; try assumption. -apply RList_P2; assumption. -elim (RList_P9 lf lg (pos_Rl lf (S x0))); intros; apply H25; left; - elim (RList_P3 lf (pos_Rl lf (S x0))); intros; apply H27; - exists (S x0); split; [ reflexivity | apply H22 ]. + intros; elim H11; clear H11; intros; assert (H12 := H11); + assert + (Hyp_cons : + exists r : R, (exists r0 : Rlist, cons_ORlist lf lg = cons r r0)). + apply RList_P19; red in |- *; intro; rewrite H13 in H8; elim (lt_n_O _ H8). + elim Hyp_cons; clear Hyp_cons; intros r [r0 Hyp_cons]; rewrite Hyp_cons; + unfold FF in |- *; rewrite RList_P12. + change (f x = f (pos_Rl (mid_Rlist (cons r r0) r) (S i))) in |- *; + rewrite <- Hyp_cons; rewrite RList_P13. + assert (H13 := RList_P2 _ _ H _ H8); elim H13; intro. + unfold constant_D_eq, open_interval in H11, H12; rewrite (H11 x H10); + assert + (H15 : + pos_Rl (cons_ORlist lf lg) i < + (pos_Rl (cons_ORlist lf lg) i + pos_Rl (cons_ORlist lf lg) (S i)) / 2 < + pos_Rl (cons_ORlist lf lg) (S i)). + split. + apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. + apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; + rewrite (Rplus_comm (pos_Rl (cons_ORlist lf lg) i)); + apply Rplus_lt_compat_l; assumption + | discrR ] ]. + rewrite (H11 _ H15); reflexivity. + elim H10; intros; rewrite H14 in H15; + elim (Rlt_irrefl _ (Rlt_trans _ _ _ H16 H15)). + apply H8. + rewrite RList_P14; rewrite Hyp_cons in H8; simpl in H8; apply H8. + assert (H11 : a < b). + apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i). + rewrite <- H6; rewrite <- (RList_P15 lf lg). + elim (RList_P6 (cons_ORlist lf lg)); intros; apply H11. + apply RList_P2; assumption. + apply le_O_n. + apply lt_trans with (pred (Rlength (cons_ORlist lf lg))); + [ assumption + | apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; + rewrite <- H13 in H8; elim (lt_n_O _ H8) ]. + assumption. + assumption. + rewrite H1; assumption. + apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)). + elim H10; intros; apply Rlt_trans with x; assumption. + rewrite <- H5; rewrite <- (RList_P16 lf lg); try assumption. + elim (RList_P6 (cons_ORlist lf lg)); intros; apply H11. + apply RList_P2; assumption. + apply lt_n_Sm_le; apply lt_n_S; assumption. + apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H8; + elim (lt_n_O _ H8). + rewrite H0; assumption. + set + (I := + fun j:nat => + pos_Rl lf j <= pos_Rl (cons_ORlist lf lg) i /\ (j < Rlength lf)%nat); + assert (H12 : Nbound I). + unfold Nbound in |- *; exists (Rlength lf); intros; unfold I in H12; elim H12; + intros; apply lt_le_weak; assumption. + assert (H13 : exists n : nat, I n). + exists 0%nat; unfold I in |- *; split. + apply Rle_trans with (pos_Rl (cons_ORlist lf lg) 0). + right; symmetry in |- *. + apply RList_P15; try assumption; rewrite H1; assumption. + elim (RList_P6 (cons_ORlist lf lg)); intros; apply H13. + apply RList_P2; assumption. + apply le_O_n. + apply lt_trans with (pred (Rlength (cons_ORlist lf lg))). + assumption. + apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H15 in H8; + elim (lt_n_O _ H8). + apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H5; + rewrite <- H6 in H11; rewrite <- H5 in H11; elim (Rlt_irrefl _ H11). + assert (H14 := Nzorn H13 H12); elim H14; clear H14; intros x0 H14; + exists (pos_Rl lf0 x0); unfold constant_D_eq, open_interval in |- *; + intros; assert (H16 := H9 x0); assert (H17 : (x0 < pred (Rlength lf))%nat). + elim H14; clear H14; intros; unfold I in H14; elim H14; clear H14; intros; + apply lt_S_n; replace (S (pred (Rlength lf))) with (Rlength lf). + inversion H18. + 2: apply lt_n_S; assumption. + cut (x0 = pred (Rlength lf)). + intro; rewrite H19 in H14; rewrite H5 in H14; + cut (pos_Rl (cons_ORlist lf lg) i < b). + intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H14 H21)). + apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)). + elim H10; intros; apply Rlt_trans with x; assumption. + rewrite <- H5; + apply Rle_trans with + (pos_Rl (cons_ORlist lf lg) (pred (Rlength (cons_ORlist lf lg)))). + elim (RList_P6 (cons_ORlist lf lg)); intros; apply H21. + apply RList_P2; assumption. + apply lt_n_Sm_le; apply lt_n_S; assumption. + apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H23 in H8; + elim (lt_n_O _ H8). + right; apply RList_P16; try assumption; rewrite H0; assumption. + rewrite <- H20; reflexivity. + apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; + rewrite <- H19 in H18; elim (lt_n_O _ H18). + assert (H18 := H16 H17); unfold constant_D_eq, open_interval in H18; + rewrite (H18 x1). + reflexivity. + elim H15; clear H15; intros; elim H14; clear H14; intros; unfold I in H14; + elim H14; clear H14; intros; split. + apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i); assumption. + apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)); try assumption. + assert (H22 : (S x0 < Rlength lf)%nat). + replace (Rlength lf) with (S (pred (Rlength lf))); + [ apply lt_n_S; assumption + | symmetry in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *; + intro; rewrite <- H22 in H21; elim (lt_n_O _ H21) ]. + elim (Rle_dec (pos_Rl lf (S x0)) (pos_Rl (cons_ORlist lf lg) i)); intro. + assert (H23 : (S x0 <= x0)%nat). + apply H20; unfold I in |- *; split; assumption. + elim (le_Sn_n _ H23). + assert (H23 : pos_Rl (cons_ORlist lf lg) i < pos_Rl lf (S x0)). + auto with real. + clear b0; apply RList_P17; try assumption. + apply RList_P2; assumption. + elim (RList_P9 lf lg (pos_Rl lf (S x0))); intros; apply H25; left; + elim (RList_P3 lf (pos_Rl lf (S x0))); intros; apply H27; + exists (S x0); split; [ reflexivity | apply H22 ]. Qed. Lemma StepFun_P23 : - forall (a b:R) (f g:R -> R) (lf lg:Rlist), - is_subdivision f a b lf -> - is_subdivision g a b lg -> is_subdivision f a b (cons_ORlist lf lg). -intros; case (Rle_dec a b); intro; - [ apply StepFun_P22 with g; assumption - | apply StepFun_P5; apply StepFun_P22 with g; - [ auto with real - | apply StepFun_P5; assumption - | apply StepFun_P5; assumption ] ]. + forall (a b:R) (f g:R -> R) (lf lg:Rlist), + is_subdivision f a b lf -> + is_subdivision g a b lg -> is_subdivision f a b (cons_ORlist lf lg). +Proof. + intros; case (Rle_dec a b); intro; + [ apply StepFun_P22 with g; assumption + | apply StepFun_P5; apply StepFun_P22 with g; + [ auto with real + | apply StepFun_P5; assumption + | apply StepFun_P5; assumption ] ]. Qed. Lemma StepFun_P24 : - forall (a b:R) (f g:R -> R) (lf lg:Rlist), - a <= b -> - is_subdivision f a b lf -> - is_subdivision g a b lg -> is_subdivision g a b (cons_ORlist lf lg). -unfold is_subdivision in |- *; intros a b f g lf lg Hyp X X0; elim X; elim X0; - clear X X0; intros lg0 p lf0 p0; assert (Hyp_min : Rmin a b = a). -unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ]. -assert (Hyp_max : Rmax a b = b). -unfold Rmax in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ]. -apply existT with (FF (cons_ORlist lf lg) g); unfold adapted_couple in p, p0; - decompose [and] p; decompose [and] p0; clear p p0; - rewrite Hyp_min in H1; rewrite Hyp_min in H6; rewrite Hyp_max in H0; - rewrite Hyp_max in H5; unfold adapted_couple in |- *; - repeat split. -apply RList_P2; assumption. -rewrite Hyp_min; symmetry in |- *; apply Rle_antisym. -induction lf as [| r lf Hreclf]. -simpl in |- *; right; symmetry in |- *; assumption. -assert - (H10 : - In (pos_Rl (cons_ORlist (cons r lf) lg) 0) (cons_ORlist (cons r lf) lg)). -elim - (RList_P3 (cons_ORlist (cons r lf) lg) - (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros _ H10; - apply H10; exists 0%nat; split; - [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_O_Sn ]. -elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) 0)); - intros H12 _; assert (H13 := H12 H10); elim H13; intro. -elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) 0)); - intros H11 _; assert (H14 := H11 H8); elim H14; intros; - elim H15; clear H15; intros; rewrite H15; rewrite <- H6; - elim (RList_P6 (cons r lf)); intros; apply H17; - [ assumption | apply le_O_n | assumption ]. -elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros H11 _; - assert (H14 := H11 H8); elim H14; intros; elim H15; - clear H15; intros; rewrite H15; rewrite <- H1; elim (RList_P6 lg); - intros; apply H17; [ assumption | apply le_O_n | assumption ]. -induction lf as [| r lf Hreclf]. -simpl in |- *; right; assumption. -assert (H8 : In a (cons_ORlist (cons r lf) lg)). -elim (RList_P9 (cons r lf) lg a); intros; apply H10; left; - elim (RList_P3 (cons r lf) a); intros; apply H12; - exists 0%nat; split; - [ symmetry in |- *; assumption | simpl in |- *; apply lt_O_Sn ]. -apply RList_P5; [ apply RList_P2; assumption | assumption ]. -rewrite Hyp_max; apply Rle_antisym. -induction lf as [| r lf Hreclf]. -simpl in |- *; right; assumption. -assert - (H8 : - In - (pos_Rl (cons_ORlist (cons r lf) lg) - (pred (Rlength (cons_ORlist (cons r lf) lg)))) - (cons_ORlist (cons r lf) lg)). -elim - (RList_P3 (cons_ORlist (cons r lf) lg) - (pos_Rl (cons_ORlist (cons r lf) lg) - (pred (Rlength (cons_ORlist (cons r lf) lg))))); - intros _ H10; apply H10; - exists (pred (Rlength (cons_ORlist (cons r lf) lg))); - split; [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_n_Sn ]. -elim - (RList_P9 (cons r lf) lg - (pos_Rl (cons_ORlist (cons r lf) lg) - (pred (Rlength (cons_ORlist (cons r lf) lg))))); - intros H10 _; assert (H11 := H10 H8); elim H11; intro. -elim - (RList_P3 (cons r lf) - (pos_Rl (cons_ORlist (cons r lf) lg) - (pred (Rlength (cons_ORlist (cons r lf) lg))))); - intros H13 _; assert (H14 := H13 H12); elim H14; intros; - elim H15; clear H15; intros; rewrite H15; rewrite <- H5; - elim (RList_P6 (cons r lf)); intros; apply H17; - [ assumption - | simpl in |- *; simpl in H14; apply lt_n_Sm_le; assumption - | simpl in |- *; apply lt_n_Sn ]. -elim - (RList_P3 lg - (pos_Rl (cons_ORlist (cons r lf) lg) - (pred (Rlength (cons_ORlist (cons r lf) lg))))); - intros H13 _; assert (H14 := H13 H12); elim H14; intros; - elim H15; clear H15; intros; rewrite H15; - assert (H17 : Rlength lg = S (pred (Rlength lg))). -apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; - rewrite <- H17 in H16; elim (lt_n_O _ H16). -rewrite <- H0; elim (RList_P6 lg); intros; apply H18; - [ assumption - | rewrite H17 in H16; apply lt_n_Sm_le; assumption - | apply lt_pred_n_n; rewrite H17; apply lt_O_Sn ]. -induction lf as [| r lf Hreclf]. -simpl in |- *; right; symmetry in |- *; assumption. -assert (H8 : In b (cons_ORlist (cons r lf) lg)). -elim (RList_P9 (cons r lf) lg b); intros; apply H10; left; - elim (RList_P3 (cons r lf) b); intros; apply H12; - exists (pred (Rlength (cons r lf))); split; - [ symmetry in |- *; assumption | simpl in |- *; apply lt_n_Sn ]. -apply RList_P7; [ apply RList_P2; assumption | assumption ]. -apply StepFun_P20; rewrite RList_P11; rewrite H7; rewrite H2; simpl in |- *; - apply lt_O_Sn. -unfold constant_D_eq, open_interval in |- *; intros; - cut - (exists l : R, - constant_D_eq g - (open_interval (pos_Rl (cons_ORlist lf lg) i) + forall (a b:R) (f g:R -> R) (lf lg:Rlist), + a <= b -> + is_subdivision f a b lf -> + is_subdivision g a b lg -> is_subdivision g a b (cons_ORlist lf lg). +Proof. + unfold is_subdivision in |- *; intros a b f g lf lg Hyp X X0; elim X; elim X0; + clear X X0; intros lg0 p lf0 p0; assert (Hyp_min : Rmin a b = a). + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. + assert (Hyp_max : Rmax a b = b). + unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. + apply existT with (FF (cons_ORlist lf lg) g); unfold adapted_couple in p, p0; + decompose [and] p; decompose [and] p0; clear p p0; + rewrite Hyp_min in H1; rewrite Hyp_min in H6; rewrite Hyp_max in H0; + rewrite Hyp_max in H5; unfold adapted_couple in |- *; + repeat split. + apply RList_P2; assumption. + rewrite Hyp_min; symmetry in |- *; apply Rle_antisym. + induction lf as [| r lf Hreclf]. + simpl in |- *; right; symmetry in |- *; assumption. + assert + (H10 : + In (pos_Rl (cons_ORlist (cons r lf) lg) 0) (cons_ORlist (cons r lf) lg)). + elim + (RList_P3 (cons_ORlist (cons r lf) lg) + (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros _ H10; + apply H10; exists 0%nat; split; + [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_O_Sn ]. + elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) 0)); + intros H12 _; assert (H13 := H12 H10); elim H13; intro. + elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) 0)); + intros H11 _; assert (H14 := H11 H8); elim H14; intros; + elim H15; clear H15; intros; rewrite H15; rewrite <- H6; + elim (RList_P6 (cons r lf)); intros; apply H17; + [ assumption | apply le_O_n | assumption ]. + elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros H11 _; + assert (H14 := H11 H8); elim H14; intros; elim H15; + clear H15; intros; rewrite H15; rewrite <- H1; elim (RList_P6 lg); + intros; apply H17; [ assumption | apply le_O_n | assumption ]. + induction lf as [| r lf Hreclf]. + simpl in |- *; right; assumption. + assert (H8 : In a (cons_ORlist (cons r lf) lg)). + elim (RList_P9 (cons r lf) lg a); intros; apply H10; left; + elim (RList_P3 (cons r lf) a); intros; apply H12; + exists 0%nat; split; + [ symmetry in |- *; assumption | simpl in |- *; apply lt_O_Sn ]. + apply RList_P5; [ apply RList_P2; assumption | assumption ]. + rewrite Hyp_max; apply Rle_antisym. + induction lf as [| r lf Hreclf]. + simpl in |- *; right; assumption. + assert + (H8 : + In + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg)))) + (cons_ORlist (cons r lf) lg)). + elim + (RList_P3 (cons_ORlist (cons r lf) lg) + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg))))); + intros _ H10; apply H10; + exists (pred (Rlength (cons_ORlist (cons r lf) lg))); + split; [ reflexivity | rewrite RList_P11; simpl in |- *; apply lt_n_Sn ]. + elim + (RList_P9 (cons r lf) lg + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg))))); + intros H10 _; assert (H11 := H10 H8); elim H11; intro. + elim + (RList_P3 (cons r lf) + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg))))); + intros H13 _; assert (H14 := H13 H12); elim H14; intros; + elim H15; clear H15; intros; rewrite H15; rewrite <- H5; + elim (RList_P6 (cons r lf)); intros; apply H17; + [ assumption + | simpl in |- *; simpl in H14; apply lt_n_Sm_le; assumption + | simpl in |- *; apply lt_n_Sn ]. + elim + (RList_P3 lg + (pos_Rl (cons_ORlist (cons r lf) lg) + (pred (Rlength (cons_ORlist (cons r lf) lg))))); + intros H13 _; assert (H14 := H13 H12); elim H14; intros; + elim H15; clear H15; intros; rewrite H15; + assert (H17 : Rlength lg = S (pred (Rlength lg))). + apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; + rewrite <- H17 in H16; elim (lt_n_O _ H16). + rewrite <- H0; elim (RList_P6 lg); intros; apply H18; + [ assumption + | rewrite H17 in H16; apply lt_n_Sm_le; assumption + | apply lt_pred_n_n; rewrite H17; apply lt_O_Sn ]. + induction lf as [| r lf Hreclf]. + simpl in |- *; right; symmetry in |- *; assumption. + assert (H8 : In b (cons_ORlist (cons r lf) lg)). + elim (RList_P9 (cons r lf) lg b); intros; apply H10; left; + elim (RList_P3 (cons r lf) b); intros; apply H12; + exists (pred (Rlength (cons r lf))); split; + [ symmetry in |- *; assumption | simpl in |- *; apply lt_n_Sn ]. + apply RList_P7; [ apply RList_P2; assumption | assumption ]. + apply StepFun_P20; rewrite RList_P11; rewrite H7; rewrite H2; simpl in |- *; + apply lt_O_Sn. + unfold constant_D_eq, open_interval in |- *; intros; + cut + (exists l : R, + constant_D_eq g + (open_interval (pos_Rl (cons_ORlist lf lg) i) (pos_Rl (cons_ORlist lf lg) (S i))) l). -intros; elim H11; clear H11; intros; assert (H12 := H11); - assert - (Hyp_cons : - exists r : R, (exists r0 : Rlist, cons_ORlist lf lg = cons r r0)). -apply RList_P19; red in |- *; intro; rewrite H13 in H8; elim (lt_n_O _ H8). -elim Hyp_cons; clear Hyp_cons; intros r [r0 Hyp_cons]; rewrite Hyp_cons; - unfold FF in |- *; rewrite RList_P12. -change (g x = g (pos_Rl (mid_Rlist (cons r r0) r) (S i))) in |- *; - rewrite <- Hyp_cons; rewrite RList_P13. -assert (H13 := RList_P2 _ _ H _ H8); elim H13; intro. -unfold constant_D_eq, open_interval in H11, H12; rewrite (H11 x H10); - assert - (H15 : - pos_Rl (cons_ORlist lf lg) i < - (pos_Rl (cons_ORlist lf lg) i + pos_Rl (cons_ORlist lf lg) (S i)) / 2 < - pos_Rl (cons_ORlist lf lg) (S i)). -split. -apply Rmult_lt_reg_l with 2; - [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption - | discrR ] ]. -apply Rmult_lt_reg_l with 2; - [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; rewrite double; - rewrite (Rplus_comm (pos_Rl (cons_ORlist lf lg) i)); - apply Rplus_lt_compat_l; assumption - | discrR ] ]. -rewrite (H11 _ H15); reflexivity. -elim H10; intros; rewrite H14 in H15; - elim (Rlt_irrefl _ (Rlt_trans _ _ _ H16 H15)). -apply H8. -rewrite RList_P14; rewrite Hyp_cons in H8; simpl in H8; apply H8. -assert (H11 : a < b). -apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i). -rewrite <- H6; rewrite <- (RList_P15 lf lg); try assumption. -elim (RList_P6 (cons_ORlist lf lg)); intros; apply H11. -apply RList_P2; assumption. -apply le_O_n. -apply lt_trans with (pred (Rlength (cons_ORlist lf lg))); - [ assumption - | apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; - rewrite <- H13 in H8; elim (lt_n_O _ H8) ]. -rewrite H1; assumption. -apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)). -elim H10; intros; apply Rlt_trans with x; assumption. -rewrite <- H5; rewrite <- (RList_P16 lf lg); try assumption. -elim (RList_P6 (cons_ORlist lf lg)); intros; apply H11. -apply RList_P2; assumption. -apply lt_n_Sm_le; apply lt_n_S; assumption. -apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H8; - elim (lt_n_O _ H8). -rewrite H0; assumption. -set - (I := - fun j:nat => - pos_Rl lg j <= pos_Rl (cons_ORlist lf lg) i /\ (j < Rlength lg)%nat); - assert (H12 : Nbound I). -unfold Nbound in |- *; exists (Rlength lg); intros; unfold I in H12; elim H12; - intros; apply lt_le_weak; assumption. -assert (H13 : exists n : nat, I n). -exists 0%nat; unfold I in |- *; split. -apply Rle_trans with (pos_Rl (cons_ORlist lf lg) 0). -right; symmetry in |- *; rewrite H1; rewrite <- H6; apply RList_P15; - try assumption; rewrite H1; assumption. -elim (RList_P6 (cons_ORlist lf lg)); intros; apply H13; - [ apply RList_P2; assumption - | apply le_O_n - | apply lt_trans with (pred (Rlength (cons_ORlist lf lg))); + intros; elim H11; clear H11; intros; assert (H12 := H11); + assert + (Hyp_cons : + exists r : R, (exists r0 : Rlist, cons_ORlist lf lg = cons r r0)). + apply RList_P19; red in |- *; intro; rewrite H13 in H8; elim (lt_n_O _ H8). + elim Hyp_cons; clear Hyp_cons; intros r [r0 Hyp_cons]; rewrite Hyp_cons; + unfold FF in |- *; rewrite RList_P12. + change (g x = g (pos_Rl (mid_Rlist (cons r r0) r) (S i))) in |- *; + rewrite <- Hyp_cons; rewrite RList_P13. + assert (H13 := RList_P2 _ _ H _ H8); elim H13; intro. + unfold constant_D_eq, open_interval in H11, H12; rewrite (H11 x H10); + assert + (H15 : + pos_Rl (cons_ORlist lf lg) i < + (pos_Rl (cons_ORlist lf lg) i + pos_Rl (cons_ORlist lf lg) (S i)) / 2 < + pos_Rl (cons_ORlist lf lg) (S i)). + split. + apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. + apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; + rewrite (Rplus_comm (pos_Rl (cons_ORlist lf lg) i)); + apply Rplus_lt_compat_l; assumption + | discrR ] ]. + rewrite (H11 _ H15); reflexivity. + elim H10; intros; rewrite H14 in H15; + elim (Rlt_irrefl _ (Rlt_trans _ _ _ H16 H15)). + apply H8. + rewrite RList_P14; rewrite Hyp_cons in H8; simpl in H8; apply H8. + assert (H11 : a < b). + apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i). + rewrite <- H6; rewrite <- (RList_P15 lf lg); try assumption. + elim (RList_P6 (cons_ORlist lf lg)); intros; apply H11. + apply RList_P2; assumption. + apply le_O_n. + apply lt_trans with (pred (Rlength (cons_ORlist lf lg))); [ assumption - | apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; - rewrite <- H15 in H8; elim (lt_n_O _ H8) ] ]. -apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H0; - rewrite <- H1 in H11; rewrite <- H0 in H11; elim (Rlt_irrefl _ H11). -assert (H14 := Nzorn H13 H12); elim H14; clear H14; intros x0 H14; - exists (pos_Rl lg0 x0); unfold constant_D_eq, open_interval in |- *; - intros; assert (H16 := H4 x0); assert (H17 : (x0 < pred (Rlength lg))%nat). -elim H14; clear H14; intros; unfold I in H14; elim H14; clear H14; intros; - apply lt_S_n; replace (S (pred (Rlength lg))) with (Rlength lg). -inversion H18. -2: apply lt_n_S; assumption. -cut (x0 = pred (Rlength lg)). -intro; rewrite H19 in H14; rewrite H0 in H14; - cut (pos_Rl (cons_ORlist lf lg) i < b). -intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H14 H21)). -apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)). -elim H10; intros; apply Rlt_trans with x; assumption. -rewrite <- H0; - apply Rle_trans with - (pos_Rl (cons_ORlist lf lg) (pred (Rlength (cons_ORlist lf lg)))). -elim (RList_P6 (cons_ORlist lf lg)); intros; apply H21. -apply RList_P2; assumption. -apply lt_n_Sm_le; apply lt_n_S; assumption. -apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H23 in H8; - elim (lt_n_O _ H8). -right; rewrite H0; rewrite <- H5; apply RList_P16; try assumption. -rewrite H0; assumption. -rewrite <- H20; reflexivity. -apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; - rewrite <- H19 in H18; elim (lt_n_O _ H18). -assert (H18 := H16 H17); unfold constant_D_eq, open_interval in H18; - rewrite (H18 x1). -reflexivity. -elim H15; clear H15; intros; elim H14; clear H14; intros; unfold I in H14; - elim H14; clear H14; intros; split. -apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i); assumption. -apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)); try assumption. -assert (H22 : (S x0 < Rlength lg)%nat). -replace (Rlength lg) with (S (pred (Rlength lg))). -apply lt_n_S; assumption. -symmetry in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *; - intro; rewrite <- H22 in H21; elim (lt_n_O _ H21). -elim (Rle_dec (pos_Rl lg (S x0)) (pos_Rl (cons_ORlist lf lg) i)); intro. -assert (H23 : (S x0 <= x0)%nat); - [ apply H20; unfold I in |- *; split; assumption | elim (le_Sn_n _ H23) ]. -assert (H23 : pos_Rl (cons_ORlist lf lg) i < pos_Rl lg (S x0)). -auto with real. -clear b0; apply RList_P17; try assumption; - [ apply RList_P2; assumption - | elim (RList_P9 lf lg (pos_Rl lg (S x0))); intros; apply H25; right; - elim (RList_P3 lg (pos_Rl lg (S x0))); intros; - apply H27; exists (S x0); split; [ reflexivity | apply H22 ] ]. + | apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; + rewrite <- H13 in H8; elim (lt_n_O _ H8) ]. + rewrite H1; assumption. + apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)). + elim H10; intros; apply Rlt_trans with x; assumption. + rewrite <- H5; rewrite <- (RList_P16 lf lg); try assumption. + elim (RList_P6 (cons_ORlist lf lg)); intros; apply H11. + apply RList_P2; assumption. + apply lt_n_Sm_le; apply lt_n_S; assumption. + apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H8; + elim (lt_n_O _ H8). + rewrite H0; assumption. + set + (I := + fun j:nat => + pos_Rl lg j <= pos_Rl (cons_ORlist lf lg) i /\ (j < Rlength lg)%nat); + assert (H12 : Nbound I). + unfold Nbound in |- *; exists (Rlength lg); intros; unfold I in H12; elim H12; + intros; apply lt_le_weak; assumption. + assert (H13 : exists n : nat, I n). + exists 0%nat; unfold I in |- *; split. + apply Rle_trans with (pos_Rl (cons_ORlist lf lg) 0). + right; symmetry in |- *; rewrite H1; rewrite <- H6; apply RList_P15; + try assumption; rewrite H1; assumption. + elim (RList_P6 (cons_ORlist lf lg)); intros; apply H13; + [ apply RList_P2; assumption + | apply le_O_n + | apply lt_trans with (pred (Rlength (cons_ORlist lf lg))); + [ assumption + | apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; + rewrite <- H15 in H8; elim (lt_n_O _ H8) ] ]. + apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H0; + rewrite <- H1 in H11; rewrite <- H0 in H11; elim (Rlt_irrefl _ H11). + assert (H14 := Nzorn H13 H12); elim H14; clear H14; intros x0 H14; + exists (pos_Rl lg0 x0); unfold constant_D_eq, open_interval in |- *; + intros; assert (H16 := H4 x0); assert (H17 : (x0 < pred (Rlength lg))%nat). + elim H14; clear H14; intros; unfold I in H14; elim H14; clear H14; intros; + apply lt_S_n; replace (S (pred (Rlength lg))) with (Rlength lg). + inversion H18. + 2: apply lt_n_S; assumption. + cut (x0 = pred (Rlength lg)). + intro; rewrite H19 in H14; rewrite H0 in H14; + cut (pos_Rl (cons_ORlist lf lg) i < b). + intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H14 H21)). + apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)). + elim H10; intros; apply Rlt_trans with x; assumption. + rewrite <- H0; + apply Rle_trans with + (pos_Rl (cons_ORlist lf lg) (pred (Rlength (cons_ORlist lf lg)))). + elim (RList_P6 (cons_ORlist lf lg)); intros; apply H21. + apply RList_P2; assumption. + apply lt_n_Sm_le; apply lt_n_S; assumption. + apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H23 in H8; + elim (lt_n_O _ H8). + right; rewrite H0; rewrite <- H5; apply RList_P16; try assumption. + rewrite H0; assumption. + rewrite <- H20; reflexivity. + apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; + rewrite <- H19 in H18; elim (lt_n_O _ H18). + assert (H18 := H16 H17); unfold constant_D_eq, open_interval in H18; + rewrite (H18 x1). + reflexivity. + elim H15; clear H15; intros; elim H14; clear H14; intros; unfold I in H14; + elim H14; clear H14; intros; split. + apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i); assumption. + apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)); try assumption. + assert (H22 : (S x0 < Rlength lg)%nat). + replace (Rlength lg) with (S (pred (Rlength lg))). + apply lt_n_S; assumption. + symmetry in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *; + intro; rewrite <- H22 in H21; elim (lt_n_O _ H21). + elim (Rle_dec (pos_Rl lg (S x0)) (pos_Rl (cons_ORlist lf lg) i)); intro. + assert (H23 : (S x0 <= x0)%nat); + [ apply H20; unfold I in |- *; split; assumption | elim (le_Sn_n _ H23) ]. + assert (H23 : pos_Rl (cons_ORlist lf lg) i < pos_Rl lg (S x0)). + auto with real. + clear b0; apply RList_P17; try assumption; + [ apply RList_P2; assumption + | elim (RList_P9 lf lg (pos_Rl lg (S x0))); intros; apply H25; right; + elim (RList_P3 lg (pos_Rl lg (S x0))); intros; + apply H27; exists (S x0); split; [ reflexivity | apply H22 ] ]. Qed. Lemma StepFun_P25 : - forall (a b:R) (f g:R -> R) (lf lg:Rlist), - is_subdivision f a b lf -> - is_subdivision g a b lg -> is_subdivision g a b (cons_ORlist lf lg). -intros a b f g lf lg H H0; case (Rle_dec a b); intro; - [ apply StepFun_P24 with f; assumption - | apply StepFun_P5; apply StepFun_P24 with f; - [ auto with real - | apply StepFun_P5; assumption - | apply StepFun_P5; assumption ] ]. + forall (a b:R) (f g:R -> R) (lf lg:Rlist), + is_subdivision f a b lf -> + is_subdivision g a b lg -> is_subdivision g a b (cons_ORlist lf lg). +Proof. + intros a b f g lf lg H H0; case (Rle_dec a b); intro; + [ apply StepFun_P24 with f; assumption + | apply StepFun_P5; apply StepFun_P24 with f; + [ auto with real + | apply StepFun_P5; assumption + | apply StepFun_P5; assumption ] ]. Qed. Lemma StepFun_P26 : - forall (a b l:R) (f g:R -> R) (l1:Rlist), - is_subdivision f a b l1 -> - is_subdivision g a b l1 -> - is_subdivision (fun x:R => f x + l * g x) a b l1. + forall (a b l:R) (f g:R -> R) (l1:Rlist), + is_subdivision f a b l1 -> + is_subdivision g a b l1 -> + is_subdivision (fun x:R => f x + l * g x) a b l1. Proof. -intros a b l f g l1 (x0,(H0,(H1,(H2,(H3,H4))))) - (x,(_,(_,(_,(_,H9))))). - exists (FF l1 (fun x:R => f x + l * g x)); repeat split; try assumption. -apply StepFun_P20; rewrite H3; auto with arith. -intros i H8 x1 H10; unfold open_interval in H10, H9, H4; - rewrite (H9 _ H8 _ H10); rewrite (H4 _ H8 _ H10); - assert (H11 : l1 <> nil). -red in |- *; intro H11; rewrite H11 in H8; elim (lt_n_O _ H8). -destruct (RList_P19 _ H11) as (r,(r0,H12)); - rewrite H12; unfold FF in |- *; - change - (pos_Rl x0 i + l * pos_Rl x i = - pos_Rl - (app_Rlist (mid_Rlist (cons r r0) r) (fun x2:R => f x2 + l * g x2)) - (S i)) in |- *; rewrite RList_P12. -rewrite RList_P13. -rewrite <- H12; rewrite (H9 _ H8); try rewrite (H4 _ H8); - reflexivity || - (elim H10; clear H10; intros; split; - [ apply Rmult_lt_reg_l with 2; - [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); - rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; - apply Rlt_trans with x1; assumption - | discrR ] ] - | apply Rmult_lt_reg_l with 2; - [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); - rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; rewrite double; - rewrite (Rplus_comm (pos_Rl l1 i)); apply Rplus_lt_compat_l; - apply Rlt_trans with x1; assumption - | discrR ] ] ]). -rewrite <- H12; assumption. -rewrite RList_P14; simpl in |- *; rewrite H12 in H8; simpl in H8; - apply lt_n_S; apply H8. + intros a b l f g l1 (x0,(H0,(H1,(H2,(H3,H4))))) + (x,(_,(_,(_,(_,H9))))). + exists (FF l1 (fun x:R => f x + l * g x)); repeat split; try assumption. + apply StepFun_P20; rewrite H3; auto with arith. + intros i H8 x1 H10; unfold open_interval in H10, H9, H4; + rewrite (H9 _ H8 _ H10); rewrite (H4 _ H8 _ H10); + assert (H11 : l1 <> nil). + red in |- *; intro H11; rewrite H11 in H8; elim (lt_n_O _ H8). + destruct (RList_P19 _ H11) as (r,(r0,H12)); + rewrite H12; unfold FF in |- *; + change + (pos_Rl x0 i + l * pos_Rl x i = + pos_Rl + (app_Rlist (mid_Rlist (cons r r0) r) (fun x2:R => f x2 + l * g x2)) + (S i)) in |- *; rewrite RList_P12. + rewrite RList_P13. + rewrite <- H12; rewrite (H9 _ H8); try rewrite (H4 _ H8); + reflexivity || + (elim H10; clear H10; intros; split; + [ apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); + rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; + apply Rlt_trans with x1; assumption + | discrR ] ] + | apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); + rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; + rewrite (Rplus_comm (pos_Rl l1 i)); apply Rplus_lt_compat_l; + apply Rlt_trans with x1; assumption + | discrR ] ] ]). + rewrite <- H12; assumption. + rewrite RList_P14; simpl in |- *; rewrite H12 in H8; simpl in H8; + apply lt_n_S; apply H8. Qed. Lemma StepFun_P27 : - forall (a b l:R) (f g:R -> R) (lf lg:Rlist), - is_subdivision f a b lf -> - is_subdivision g a b lg -> - is_subdivision (fun x:R => f x + l * g x) a b (cons_ORlist lf lg). -intros a b l f g lf lg H H0; apply StepFun_P26; - [ apply StepFun_P23 with g; assumption - | apply StepFun_P25 with f; assumption ]. + forall (a b l:R) (f g:R -> R) (lf lg:Rlist), + is_subdivision f a b lf -> + is_subdivision g a b lg -> + is_subdivision (fun x:R => f x + l * g x) a b (cons_ORlist lf lg). +Proof. + intros a b l f g lf lg H H0; apply StepFun_P26; + [ apply StepFun_P23 with g; assumption + | apply StepFun_P25 with f; assumption ]. Qed. -(* The set of step functions on [a,b] is a vectorial space *) +(** The set of step functions on [a,b] is a vectorial space *) Lemma StepFun_P28 : - forall (a b l:R) (f g:StepFun a b), IsStepFun (fun x:R => f x + l * g x) a b. -intros a b l f g; unfold IsStepFun in |- *; assert (H := pre f); - assert (H0 := pre g); unfold IsStepFun in H, H0; elim H; - elim H0; intros; apply existT with (cons_ORlist x0 x); - apply StepFun_P27; assumption. + forall (a b l:R) (f g:StepFun a b), IsStepFun (fun x:R => f x + l * g x) a b. +Proof. + intros a b l f g; unfold IsStepFun in |- *; assert (H := pre f); + assert (H0 := pre g); unfold IsStepFun in H, H0; elim H; + elim H0; intros; apply existT with (cons_ORlist x0 x); + apply StepFun_P27; assumption. Qed. Lemma StepFun_P29 : - forall (a b:R) (f:StepFun a b), is_subdivision f a b (subdivision f). -intros a b f; unfold is_subdivision in |- *; - apply existT with (subdivision_val f); apply StepFun_P1. + forall (a b:R) (f:StepFun a b), is_subdivision f a b (subdivision f). +Proof. + intros a b f; unfold is_subdivision in |- *; + apply existT with (subdivision_val f); apply StepFun_P1. Qed. Lemma StepFun_P30 : - forall (a b l:R) (f g:StepFun a b), - RiemannInt_SF (mkStepFun (StepFun_P28 l f g)) = - RiemannInt_SF f + l * RiemannInt_SF g. -intros a b l f g; unfold RiemannInt_SF in |- *; case (Rle_dec a b); - (intro; - replace - (Int_SF (subdivision_val (mkStepFun (StepFun_P28 l f g))) - (subdivision (mkStepFun (StepFun_P28 l f g)))) with - (Int_SF - (FF (cons_ORlist (subdivision f) (subdivision g)) - (fun x:R => f x + l * g x)) - (cons_ORlist (subdivision f) (subdivision g))); - [ rewrite StepFun_P19; + forall (a b l:R) (f g:StepFun a b), + RiemannInt_SF (mkStepFun (StepFun_P28 l f g)) = + RiemannInt_SF f + l * RiemannInt_SF g. +Proof. + intros a b l f g; unfold RiemannInt_SF in |- *; case (Rle_dec a b); + (intro; replace - (Int_SF (FF (cons_ORlist (subdivision f) (subdivision g)) f) + (Int_SF (subdivision_val (mkStepFun (StepFun_P28 l f g))) + (subdivision (mkStepFun (StepFun_P28 l f g)))) with + (Int_SF + (FF (cons_ORlist (subdivision f) (subdivision g)) + (fun x:R => f x + l * g x)) + (cons_ORlist (subdivision f) (subdivision g))); + [ rewrite StepFun_P19; + replace + (Int_SF (FF (cons_ORlist (subdivision f) (subdivision g)) f) (cons_ORlist (subdivision f) (subdivision g))) with - (Int_SF (subdivision_val f) (subdivision f)); - [ replace - (Int_SF (FF (cons_ORlist (subdivision f) (subdivision g)) g) + (Int_SF (subdivision_val f) (subdivision f)); + [ replace + (Int_SF (FF (cons_ORlist (subdivision f) (subdivision g)) g) (cons_ORlist (subdivision f) (subdivision g))) with - (Int_SF (subdivision_val g) (subdivision g)); - [ ring - | apply StepFun_P17 with (fe g) a b; + (Int_SF (subdivision_val g) (subdivision g)); + [ ring + | apply StepFun_P17 with (fe g) a b; + [ apply StepFun_P1 + | apply StepFun_P21; apply StepFun_P25 with (fe f); + apply StepFun_P29 ] ] + | apply StepFun_P17 with (fe f) a b; [ apply StepFun_P1 - | apply StepFun_P21; apply StepFun_P25 with (fe f); - apply StepFun_P29 ] ] - | apply StepFun_P17 with (fe f) a b; - [ apply StepFun_P1 - | apply StepFun_P21; apply StepFun_P23 with (fe g); - apply StepFun_P29 ] ] - | apply StepFun_P17 with (fun x:R => f x + l * g x) a b; - [ apply StepFun_P21; apply StepFun_P27; apply StepFun_P29 - | apply (StepFun_P1 (mkStepFun (StepFun_P28 l f g))) ] ]). + | apply StepFun_P21; apply StepFun_P23 with (fe g); + apply StepFun_P29 ] ] + | apply StepFun_P17 with (fun x:R => f x + l * g x) a b; + [ apply StepFun_P21; apply StepFun_P27; apply StepFun_P29 + | apply (StepFun_P1 (mkStepFun (StepFun_P28 l f g))) ] ]). Qed. Lemma StepFun_P31 : - forall (a b:R) (f:R -> R) (l lf:Rlist), - adapted_couple f a b l lf -> - adapted_couple (fun x:R => Rabs (f x)) a b l (app_Rlist lf Rabs). -unfold adapted_couple in |- *; intros; decompose [and] H; clear H; - repeat split; try assumption. -symmetry in |- *; rewrite H3; rewrite RList_P18; reflexivity. -intros; unfold constant_D_eq, open_interval in |- *; - unfold constant_D_eq, open_interval in H5; intros; - rewrite (H5 _ H _ H4); rewrite RList_P12; - [ reflexivity | rewrite H3 in H; simpl in H; apply H ]. + forall (a b:R) (f:R -> R) (l lf:Rlist), + adapted_couple f a b l lf -> + adapted_couple (fun x:R => Rabs (f x)) a b l (app_Rlist lf Rabs). +Proof. + unfold adapted_couple in |- *; intros; decompose [and] H; clear H; + repeat split; try assumption. + symmetry in |- *; rewrite H3; rewrite RList_P18; reflexivity. + intros; unfold constant_D_eq, open_interval in |- *; + unfold constant_D_eq, open_interval in H5; intros; + rewrite (H5 _ H _ H4); rewrite RList_P12; + [ reflexivity | rewrite H3 in H; simpl in H; apply H ]. Qed. Lemma StepFun_P32 : - forall (a b:R) (f:StepFun a b), IsStepFun (fun x:R => Rabs (f x)) a b. -intros a b f; unfold IsStepFun in |- *; apply existT with (subdivision f); - unfold is_subdivision in |- *; - apply existT with (app_Rlist (subdivision_val f) Rabs); - apply StepFun_P31; apply StepFun_P1. + forall (a b:R) (f:StepFun a b), IsStepFun (fun x:R => Rabs (f x)) a b. +Proof. + intros a b f; unfold IsStepFun in |- *; apply existT with (subdivision f); + unfold is_subdivision in |- *; + apply existT with (app_Rlist (subdivision_val f) Rabs); + apply StepFun_P31; apply StepFun_P1. Qed. Lemma StepFun_P33 : - forall l2 l1:Rlist, - ordered_Rlist l1 -> Rabs (Int_SF l2 l1) <= Int_SF (app_Rlist l2 Rabs) l1. -simple induction l2; intros. -simpl in |- *; rewrite Rabs_R0; right; reflexivity. -simpl in |- *; induction l1 as [| r1 l1 Hrecl1]. -rewrite Rabs_R0; right; reflexivity. -induction l1 as [| r2 l1 Hrecl0]. -rewrite Rabs_R0; right; reflexivity. -apply Rle_trans with (Rabs (r * (r2 - r1)) + Rabs (Int_SF r0 (cons r2 l1))). -apply Rabs_triang. -rewrite Rabs_mult; rewrite (Rabs_right (r2 - r1)); - [ apply Rplus_le_compat_l; apply H; apply RList_P4 with r1; assumption - | apply Rge_minus; apply Rle_ge; apply (H0 0%nat); simpl in |- *; - apply lt_O_Sn ]. + forall l2 l1:Rlist, + ordered_Rlist l1 -> Rabs (Int_SF l2 l1) <= Int_SF (app_Rlist l2 Rabs) l1. +Proof. + simple induction l2; intros. + simpl in |- *; rewrite Rabs_R0; right; reflexivity. + simpl in |- *; induction l1 as [| r1 l1 Hrecl1]. + rewrite Rabs_R0; right; reflexivity. + induction l1 as [| r2 l1 Hrecl0]. + rewrite Rabs_R0; right; reflexivity. + apply Rle_trans with (Rabs (r * (r2 - r1)) + Rabs (Int_SF r0 (cons r2 l1))). + apply Rabs_triang. + rewrite Rabs_mult; rewrite (Rabs_right (r2 - r1)); + [ apply Rplus_le_compat_l; apply H; apply RList_P4 with r1; assumption + | apply Rge_minus; apply Rle_ge; apply (H0 0%nat); simpl in |- *; + apply lt_O_Sn ]. Qed. Lemma StepFun_P34 : - forall (a b:R) (f:StepFun a b), - a <= b -> - Rabs (RiemannInt_SF f) <= RiemannInt_SF (mkStepFun (StepFun_P32 f)). -intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro. -replace - (Int_SF (subdivision_val (mkStepFun (StepFun_P32 f))) + forall (a b:R) (f:StepFun a b), + a <= b -> + Rabs (RiemannInt_SF f) <= RiemannInt_SF (mkStepFun (StepFun_P32 f)). +Proof. + intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro. + replace + (Int_SF (subdivision_val (mkStepFun (StepFun_P32 f))) (subdivision (mkStepFun (StepFun_P32 f)))) with - (Int_SF (app_Rlist (subdivision_val f) Rabs) (subdivision f)). -apply StepFun_P33; assert (H0 := StepFun_P29 f); unfold is_subdivision in H0; - elim H0; intros; unfold adapted_couple in p; decompose [and] p; - assumption. -apply StepFun_P17 with (fun x:R => Rabs (f x)) a b; - [ apply StepFun_P31; apply StepFun_P1 - | apply (StepFun_P1 (mkStepFun (StepFun_P32 f))) ]. -elim n; assumption. + (Int_SF (app_Rlist (subdivision_val f) Rabs) (subdivision f)). + apply StepFun_P33; assert (H0 := StepFun_P29 f); unfold is_subdivision in H0; + elim H0; intros; unfold adapted_couple in p; decompose [and] p; + assumption. + apply StepFun_P17 with (fun x:R => Rabs (f x)) a b; + [ apply StepFun_P31; apply StepFun_P1 + | apply (StepFun_P1 (mkStepFun (StepFun_P32 f))) ]. + elim n; assumption. Qed. Lemma StepFun_P35 : - forall (l:Rlist) (a b:R) (f g:R -> R), - ordered_Rlist l -> - pos_Rl l 0 = a -> - pos_Rl l (pred (Rlength l)) = b -> - (forall x:R, a < x < b -> f x <= g x) -> - Int_SF (FF l f) l <= Int_SF (FF l g) l. -simple induction l; intros. -right; reflexivity. -simpl in |- *; induction r0 as [| r0 r1 Hrecr0]. -right; reflexivity. -simpl in |- *; apply Rplus_le_compat. -case (Req_dec r r0); intro. -rewrite H4; right; ring. -do 2 rewrite <- (Rmult_comm (r0 - r)); apply Rmult_le_compat_l. -apply Rge_le; apply Rge_minus; apply Rle_ge; apply (H0 0%nat); simpl in |- *; - apply lt_O_Sn. -apply H3; split. -apply Rmult_lt_reg_l with 2. -prove_sup0. -unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym. -assert (H5 : r = a). -apply H1. -rewrite H5; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l. -assert (H6 := H0 0%nat (lt_O_Sn _)). -simpl in H6. -elim H6; intro. -rewrite H5 in H7; apply H7. -elim H4; assumption. -discrR. -apply Rmult_lt_reg_l with 2. -prove_sup0. -unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym. -rewrite Rmult_1_l; rewrite double; assert (H5 : r0 <= b). -replace b with - (pos_Rl (cons r (cons r0 r1)) (pred (Rlength (cons r (cons r0 r1))))). -replace r0 with (pos_Rl (cons r (cons r0 r1)) 1). -elim (RList_P6 (cons r (cons r0 r1))); intros; apply H5. -assumption. -simpl in |- *; apply le_n_S. -apply le_O_n. -simpl in |- *; apply lt_n_Sn. -reflexivity. -apply Rle_lt_trans with (r + b). -apply Rplus_le_compat_l; assumption. -rewrite (Rplus_comm r); apply Rplus_lt_compat_l. -apply Rlt_le_trans with r0. -assert (H6 := H0 0%nat (lt_O_Sn _)). -simpl in H6. -elim H6; intro. -apply H7. -elim H4; assumption. -assumption. -discrR. -simpl in H; apply H with r0 b. -apply RList_P4 with r; assumption. -reflexivity. -rewrite <- H2; reflexivity. -intros; apply H3; elim H4; intros; split; try assumption. -apply Rle_lt_trans with r0; try assumption. -rewrite <- H1. -simpl in |- *; apply (H0 0%nat); simpl in |- *; apply lt_O_Sn. + forall (l:Rlist) (a b:R) (f g:R -> R), + ordered_Rlist l -> + pos_Rl l 0 = a -> + pos_Rl l (pred (Rlength l)) = b -> + (forall x:R, a < x < b -> f x <= g x) -> + Int_SF (FF l f) l <= Int_SF (FF l g) l. +Proof. + simple induction l; intros. + right; reflexivity. + simpl in |- *; induction r0 as [| r0 r1 Hrecr0]. + right; reflexivity. + simpl in |- *; apply Rplus_le_compat. + case (Req_dec r r0); intro. + rewrite H4; right; ring. + do 2 rewrite <- (Rmult_comm (r0 - r)); apply Rmult_le_compat_l. + apply Rge_le; apply Rge_minus; apply Rle_ge; apply (H0 0%nat); simpl in |- *; + apply lt_O_Sn. + apply H3; split. + apply Rmult_lt_reg_l with 2. + prove_sup0. + unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. + assert (H5 : r = a). + apply H1. + rewrite H5; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l. + assert (H6 := H0 0%nat (lt_O_Sn _)). + simpl in H6. + elim H6; intro. + rewrite H5 in H7; apply H7. + elim H4; assumption. + discrR. + apply Rmult_lt_reg_l with 2. + prove_sup0. + unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. + rewrite Rmult_1_l; rewrite double; assert (H5 : r0 <= b). + replace b with + (pos_Rl (cons r (cons r0 r1)) (pred (Rlength (cons r (cons r0 r1))))). + replace r0 with (pos_Rl (cons r (cons r0 r1)) 1). + elim (RList_P6 (cons r (cons r0 r1))); intros; apply H5. + assumption. + simpl in |- *; apply le_n_S. + apply le_O_n. + simpl in |- *; apply lt_n_Sn. + reflexivity. + apply Rle_lt_trans with (r + b). + apply Rplus_le_compat_l; assumption. + rewrite (Rplus_comm r); apply Rplus_lt_compat_l. + apply Rlt_le_trans with r0. + assert (H6 := H0 0%nat (lt_O_Sn _)). + simpl in H6. + elim H6; intro. + apply H7. + elim H4; assumption. + assumption. + discrR. + simpl in H; apply H with r0 b. + apply RList_P4 with r; assumption. + reflexivity. + rewrite <- H2; reflexivity. + intros; apply H3; elim H4; intros; split; try assumption. + apply Rle_lt_trans with r0; try assumption. + rewrite <- H1. + simpl in |- *; apply (H0 0%nat); simpl in |- *; apply lt_O_Sn. Qed. Lemma StepFun_P36 : - forall (a b:R) (f g:StepFun a b) (l:Rlist), - a <= b -> - is_subdivision f a b l -> - is_subdivision g a b l -> - (forall x:R, a < x < b -> f x <= g x) -> - RiemannInt_SF f <= RiemannInt_SF g. -intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro. -replace (Int_SF (subdivision_val f) (subdivision f)) with (Int_SF (FF l f) l). -replace (Int_SF (subdivision_val g) (subdivision g)) with (Int_SF (FF l g) l). -unfold is_subdivision in X; elim X; clear X; intros; - unfold adapted_couple in p; decompose [and] p; clear p; - assert (H5 : Rmin a b = a); - [ unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ] - | assert (H7 : Rmax a b = b); - [ unfold Rmax in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ] - | rewrite H5 in H3; rewrite H7 in H2; eapply StepFun_P35 with a b; - assumption ] ]. -apply StepFun_P17 with (fe g) a b; - [ apply StepFun_P21; assumption | apply StepFun_P1 ]. -apply StepFun_P17 with (fe f) a b; - [ apply StepFun_P21; assumption | apply StepFun_P1 ]. -elim n; assumption. + forall (a b:R) (f g:StepFun a b) (l:Rlist), + a <= b -> + is_subdivision f a b l -> + is_subdivision g a b l -> + (forall x:R, a < x < b -> f x <= g x) -> + RiemannInt_SF f <= RiemannInt_SF g. +Proof. + intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro. + replace (Int_SF (subdivision_val f) (subdivision f)) with (Int_SF (FF l f) l). + replace (Int_SF (subdivision_val g) (subdivision g)) with (Int_SF (FF l g) l). + unfold is_subdivision in X; elim X; clear X; intros; + unfold adapted_couple in p; decompose [and] p; clear p; + assert (H5 : Rmin a b = a); + [ unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ] + | assert (H7 : Rmax a b = b); + [ unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ] + | rewrite H5 in H3; rewrite H7 in H2; eapply StepFun_P35 with a b; + assumption ] ]. + apply StepFun_P17 with (fe g) a b; + [ apply StepFun_P21; assumption | apply StepFun_P1 ]. + apply StepFun_P17 with (fe f) a b; + [ apply StepFun_P21; assumption | apply StepFun_P1 ]. + elim n; assumption. Qed. Lemma StepFun_P37 : - forall (a b:R) (f g:StepFun a b), - a <= b -> - (forall x:R, a < x < b -> f x <= g x) -> - RiemannInt_SF f <= RiemannInt_SF g. -intros; eapply StepFun_P36; try assumption. -eapply StepFun_P25; apply StepFun_P29. -eapply StepFun_P23; apply StepFun_P29. + forall (a b:R) (f g:StepFun a b), + a <= b -> + (forall x:R, a < x < b -> f x <= g x) -> + RiemannInt_SF f <= RiemannInt_SF g. +Proof. + intros; eapply StepFun_P36; try assumption. + eapply StepFun_P25; apply StepFun_P29. + eapply StepFun_P23; apply StepFun_P29. Qed. Lemma StepFun_P38 : - forall (l:Rlist) (a b:R) (f:R -> R), - ordered_Rlist l -> - pos_Rl l 0 = a -> - pos_Rl l (pred (Rlength l)) = b -> - sigT - (fun g:StepFun a b => - g b = f b /\ - (forall i:nat, - (i < pred (Rlength l))%nat -> - constant_D_eq g (co_interval (pos_Rl l i) (pos_Rl l (S i))) - (f (pos_Rl l i)))). -intros l a b f; generalize a; clear a; induction l. -intros a H H0 H1; simpl in H0; simpl in H1; - exists (mkStepFun (StepFun_P4 a b (f b))); split. -reflexivity. -intros; elim (lt_n_O _ H2). -intros; destruct l as [| r1 l]. -simpl in H1; simpl in H0; exists (mkStepFun (StepFun_P4 a b (f b))); split. -reflexivity. -intros i H2; elim (lt_n_O _ H2). -intros; assert (H2 : ordered_Rlist (cons r1 l)). -apply RList_P4 with r; assumption. -assert (H3 : pos_Rl (cons r1 l) 0 = r1). -reflexivity. -assert (H4 : pos_Rl (cons r1 l) (pred (Rlength (cons r1 l))) = b). -rewrite <- H1; reflexivity. -elim (IHl r1 H2 H3 H4); intros g [H5 H6]. -set - (g' := - fun x:R => match Rle_dec r1 x with - | left _ => g x - | right _ => f a - end). -assert (H7 : r1 <= b). -rewrite <- H4; apply RList_P7; [ assumption | left; reflexivity ]. -assert (H8 : IsStepFun g' a b). -unfold IsStepFun in |- *; assert (H8 := pre g); unfold IsStepFun in H8; - elim H8; intros lg H9; unfold is_subdivision in H9; - elim H9; clear H9; intros lg2 H9; split with (cons a lg); - unfold is_subdivision in |- *; split with (cons (f a) lg2); - unfold adapted_couple in H9; decompose [and] H9; clear H9; - unfold adapted_couple in |- *; repeat split. -unfold ordered_Rlist in |- *; intros; simpl in H9; - induction i as [| i Hreci]. -simpl in |- *; rewrite H12; replace (Rmin r1 b) with r1. -simpl in H0; rewrite <- H0; apply (H 0%nat); simpl in |- *; apply lt_O_Sn. -unfold Rmin in |- *; case (Rle_dec r1 b); intro; - [ reflexivity | elim n; assumption ]. -apply (H10 i); apply lt_S_n. -replace (S (pred (Rlength lg))) with (Rlength lg). -apply H9. -apply S_pred with 0%nat; apply neq_O_lt; intro; rewrite <- H14 in H9; - elim (lt_n_O _ H9). -simpl in |- *; assert (H14 : a <= b). -rewrite <- H1; simpl in H0; rewrite <- H0; apply RList_P7; - [ assumption | left; reflexivity ]. -unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ]. -assert (H14 : a <= b). -rewrite <- H1; simpl in H0; rewrite <- H0; apply RList_P7; - [ assumption | left; reflexivity ]. -replace (Rmax a b) with (Rmax r1 b). -rewrite <- H11; induction lg as [| r0 lg Hreclg]. -simpl in H13; discriminate. -reflexivity. -unfold Rmax in |- *; case (Rle_dec a b); case (Rle_dec r1 b); intros; - reflexivity || elim n; assumption. -simpl in |- *; rewrite H13; reflexivity. -intros; simpl in H9; induction i as [| i Hreci]. -unfold constant_D_eq, open_interval in |- *; simpl in |- *; intros; - assert (H16 : Rmin r1 b = r1). -unfold Rmin in |- *; case (Rle_dec r1 b); intro; - [ reflexivity | elim n; assumption ]. -rewrite H16 in H12; rewrite H12 in H14; elim H14; clear H14; intros _ H14; - unfold g' in |- *; case (Rle_dec r1 x); intro r3. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H14)). -reflexivity. -change - (constant_D_eq g' (open_interval (pos_Rl lg i) (pos_Rl lg (S i))) - (pos_Rl lg2 i)) in |- *; clear Hreci; assert (H16 := H15 i); - assert (H17 : (i < pred (Rlength lg))%nat). -apply lt_S_n. -replace (S (pred (Rlength lg))) with (Rlength lg). -assumption. -apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; - rewrite <- H14 in H9; elim (lt_n_O _ H9). -assert (H18 := H16 H17); unfold constant_D_eq, open_interval in H18; - unfold constant_D_eq, open_interval in |- *; intros; - assert (H19 := H18 _ H14); rewrite <- H19; unfold g' in |- *; - case (Rle_dec r1 x); intro. -reflexivity. -elim n; replace r1 with (Rmin r1 b). -rewrite <- H12; elim H14; clear H14; intros H14 _; left; - apply Rle_lt_trans with (pos_Rl lg i); try assumption. -apply RList_P5. -assumption. -elim (RList_P3 lg (pos_Rl lg i)); intros; apply H21; exists i; split. -reflexivity. -apply lt_trans with (pred (Rlength lg)); try assumption. -apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H22 in H17; - elim (lt_n_O _ H17). -unfold Rmin in |- *; case (Rle_dec r1 b); intro; - [ reflexivity | elim n0; assumption ]. -exists (mkStepFun H8); split. -simpl in |- *; unfold g' in |- *; case (Rle_dec r1 b); intro. -assumption. -elim n; assumption. -intros; simpl in H9; induction i as [| i Hreci]. -unfold constant_D_eq, co_interval in |- *; simpl in |- *; intros; simpl in H0; - rewrite H0; elim H10; clear H10; intros; unfold g' in |- *; - case (Rle_dec r1 x); intro r3. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H11)). -reflexivity. -clear Hreci; - change - (constant_D_eq (mkStepFun H8) - (co_interval (pos_Rl (cons r1 l) i) (pos_Rl (cons r1 l) (S i))) - (f (pos_Rl (cons r1 l) i))) in |- *; assert (H10 := H6 i); - assert (H11 : (i < pred (Rlength (cons r1 l)))%nat). -simpl in |- *; apply lt_S_n; assumption. -assert (H12 := H10 H11); unfold constant_D_eq, co_interval in H12; - unfold constant_D_eq, co_interval in |- *; intros; - rewrite <- (H12 _ H13); simpl in |- *; unfold g' in |- *; - case (Rle_dec r1 x); intro. -reflexivity. -elim n; elim H13; clear H13; intros; - apply Rle_trans with (pos_Rl (cons r1 l) i); try assumption; - change (pos_Rl (cons r1 l) 0 <= pos_Rl (cons r1 l) i) in |- *; - elim (RList_P6 (cons r1 l)); intros; apply H15; - [ assumption - | apply le_O_n - | simpl in |- *; apply lt_trans with (Rlength l); - [ apply lt_S_n; assumption | apply lt_n_Sn ] ]. + forall (l:Rlist) (a b:R) (f:R -> R), + ordered_Rlist l -> + pos_Rl l 0 = a -> + pos_Rl l (pred (Rlength l)) = b -> + sigT + (fun g:StepFun a b => + g b = f b /\ + (forall i:nat, + (i < pred (Rlength l))%nat -> + constant_D_eq g (co_interval (pos_Rl l i) (pos_Rl l (S i))) + (f (pos_Rl l i)))). +Proof. + intros l a b f; generalize a; clear a; induction l. + intros a H H0 H1; simpl in H0; simpl in H1; + exists (mkStepFun (StepFun_P4 a b (f b))); split. + reflexivity. + intros; elim (lt_n_O _ H2). + intros; destruct l as [| r1 l]. + simpl in H1; simpl in H0; exists (mkStepFun (StepFun_P4 a b (f b))); split. + reflexivity. + intros i H2; elim (lt_n_O _ H2). + intros; assert (H2 : ordered_Rlist (cons r1 l)). + apply RList_P4 with r; assumption. + assert (H3 : pos_Rl (cons r1 l) 0 = r1). + reflexivity. + assert (H4 : pos_Rl (cons r1 l) (pred (Rlength (cons r1 l))) = b). + rewrite <- H1; reflexivity. + elim (IHl r1 H2 H3 H4); intros g [H5 H6]. + set + (g' := + fun x:R => match Rle_dec r1 x with + | left _ => g x + | right _ => f a + end). + assert (H7 : r1 <= b). + rewrite <- H4; apply RList_P7; [ assumption | left; reflexivity ]. + assert (H8 : IsStepFun g' a b). + unfold IsStepFun in |- *; assert (H8 := pre g); unfold IsStepFun in H8; + elim H8; intros lg H9; unfold is_subdivision in H9; + elim H9; clear H9; intros lg2 H9; split with (cons a lg); + unfold is_subdivision in |- *; split with (cons (f a) lg2); + unfold adapted_couple in H9; decompose [and] H9; clear H9; + unfold adapted_couple in |- *; repeat split. + unfold ordered_Rlist in |- *; intros; simpl in H9; + induction i as [| i Hreci]. + simpl in |- *; rewrite H12; replace (Rmin r1 b) with r1. + simpl in H0; rewrite <- H0; apply (H 0%nat); simpl in |- *; apply lt_O_Sn. + unfold Rmin in |- *; case (Rle_dec r1 b); intro; + [ reflexivity | elim n; assumption ]. + apply (H10 i); apply lt_S_n. + replace (S (pred (Rlength lg))) with (Rlength lg). + apply H9. + apply S_pred with 0%nat; apply neq_O_lt; intro; rewrite <- H14 in H9; + elim (lt_n_O _ H9). + simpl in |- *; assert (H14 : a <= b). + rewrite <- H1; simpl in H0; rewrite <- H0; apply RList_P7; + [ assumption | left; reflexivity ]. + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. + assert (H14 : a <= b). + rewrite <- H1; simpl in H0; rewrite <- H0; apply RList_P7; + [ assumption | left; reflexivity ]. + replace (Rmax a b) with (Rmax r1 b). + rewrite <- H11; induction lg as [| r0 lg Hreclg]. + simpl in H13; discriminate. + reflexivity. + unfold Rmax in |- *; case (Rle_dec a b); case (Rle_dec r1 b); intros; + reflexivity || elim n; assumption. + simpl in |- *; rewrite H13; reflexivity. + intros; simpl in H9; induction i as [| i Hreci]. + unfold constant_D_eq, open_interval in |- *; simpl in |- *; intros; + assert (H16 : Rmin r1 b = r1). + unfold Rmin in |- *; case (Rle_dec r1 b); intro; + [ reflexivity | elim n; assumption ]. + rewrite H16 in H12; rewrite H12 in H14; elim H14; clear H14; intros _ H14; + unfold g' in |- *; case (Rle_dec r1 x); intro r3. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H14)). + reflexivity. + change + (constant_D_eq g' (open_interval (pos_Rl lg i) (pos_Rl lg (S i))) + (pos_Rl lg2 i)) in |- *; clear Hreci; assert (H16 := H15 i); + assert (H17 : (i < pred (Rlength lg))%nat). + apply lt_S_n. + replace (S (pred (Rlength lg))) with (Rlength lg). + assumption. + apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro; + rewrite <- H14 in H9; elim (lt_n_O _ H9). + assert (H18 := H16 H17); unfold constant_D_eq, open_interval in H18; + unfold constant_D_eq, open_interval in |- *; intros; + assert (H19 := H18 _ H14); rewrite <- H19; unfold g' in |- *; + case (Rle_dec r1 x); intro. + reflexivity. + elim n; replace r1 with (Rmin r1 b). + rewrite <- H12; elim H14; clear H14; intros H14 _; left; + apply Rle_lt_trans with (pos_Rl lg i); try assumption. + apply RList_P5. + assumption. + elim (RList_P3 lg (pos_Rl lg i)); intros; apply H21; exists i; split. + reflexivity. + apply lt_trans with (pred (Rlength lg)); try assumption. + apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H22 in H17; + elim (lt_n_O _ H17). + unfold Rmin in |- *; case (Rle_dec r1 b); intro; + [ reflexivity | elim n0; assumption ]. + exists (mkStepFun H8); split. + simpl in |- *; unfold g' in |- *; case (Rle_dec r1 b); intro. + assumption. + elim n; assumption. + intros; simpl in H9; induction i as [| i Hreci]. + unfold constant_D_eq, co_interval in |- *; simpl in |- *; intros; simpl in H0; + rewrite H0; elim H10; clear H10; intros; unfold g' in |- *; + case (Rle_dec r1 x); intro r3. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H11)). + reflexivity. + clear Hreci; + change + (constant_D_eq (mkStepFun H8) + (co_interval (pos_Rl (cons r1 l) i) (pos_Rl (cons r1 l) (S i))) + (f (pos_Rl (cons r1 l) i))) in |- *; assert (H10 := H6 i); + assert (H11 : (i < pred (Rlength (cons r1 l)))%nat). + simpl in |- *; apply lt_S_n; assumption. + assert (H12 := H10 H11); unfold constant_D_eq, co_interval in H12; + unfold constant_D_eq, co_interval in |- *; intros; + rewrite <- (H12 _ H13); simpl in |- *; unfold g' in |- *; + case (Rle_dec r1 x); intro. + reflexivity. + elim n; elim H13; clear H13; intros; + apply Rle_trans with (pos_Rl (cons r1 l) i); try assumption; + change (pos_Rl (cons r1 l) 0 <= pos_Rl (cons r1 l) i) in |- *; + elim (RList_P6 (cons r1 l)); intros; apply H15; + [ assumption + | apply le_O_n + | simpl in |- *; apply lt_trans with (Rlength l); + [ apply lt_S_n; assumption | apply lt_n_Sn ] ]. Qed. Lemma StepFun_P39 : - forall (a b:R) (f:StepFun a b), - RiemannInt_SF f = - RiemannInt_SF (mkStepFun (StepFun_P6 (pre f))). -intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); case (Rle_dec b a); - intros. -assert (H : adapted_couple f a b (subdivision f) (subdivision_val f)); - [ apply StepFun_P1 - | assert - (H0 : - adapted_couple (mkStepFun (StepFun_P6 (pre f))) b a - (subdivision (mkStepFun (StepFun_P6 (pre f)))) - (subdivision_val (mkStepFun (StepFun_P6 (pre f))))); + forall (a b:R) (f:StepFun a b), + RiemannInt_SF f = - RiemannInt_SF (mkStepFun (StepFun_P6 (pre f))). +Proof. + intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); case (Rle_dec b a); + intros. + assert (H : adapted_couple f a b (subdivision f) (subdivision_val f)); + [ apply StepFun_P1 + | assert + (H0 : + adapted_couple (mkStepFun (StepFun_P6 (pre f))) b a + (subdivision (mkStepFun (StepFun_P6 (pre f)))) + (subdivision_val (mkStepFun (StepFun_P6 (pre f))))); + [ apply StepFun_P1 + | assert (H1 : a = b); + [ apply Rle_antisym; assumption + | rewrite (StepFun_P8 H H1); assert (H2 : b = a); + [ symmetry in |- *; apply H1 | rewrite (StepFun_P8 H0 H2); ring ] ] ] ]. + rewrite Ropp_involutive; eapply StepFun_P17; + [ apply StepFun_P1 + | apply StepFun_P2; set (H := StepFun_P6 (pre f)); unfold IsStepFun in H; + elim H; intros; unfold is_subdivision in |- *; + elim p; intros; apply p0 ]. + apply Ropp_eq_compat; eapply StepFun_P17; [ apply StepFun_P1 - | assert (H1 : a = b); - [ apply Rle_antisym; assumption - | rewrite (StepFun_P8 H H1); assert (H2 : b = a); - [ symmetry in |- *; apply H1 | rewrite (StepFun_P8 H0 H2); ring ] ] ] ]. -rewrite Ropp_involutive; eapply StepFun_P17; - [ apply StepFun_P1 - | apply StepFun_P2; set (H := StepFun_P6 (pre f)); unfold IsStepFun in H; - elim H; intros; unfold is_subdivision in |- *; - elim p; intros; apply p0 ]. -apply Ropp_eq_compat; eapply StepFun_P17; - [ apply StepFun_P1 - | apply StepFun_P2; set (H := StepFun_P6 (pre f)); unfold IsStepFun in H; - elim H; intros; unfold is_subdivision in |- *; - elim p; intros; apply p0 ]. -assert (H : a < b); - [ auto with real - | assert (H0 : b < a); - [ auto with real | elim (Rlt_irrefl _ (Rlt_trans _ _ _ H H0)) ] ]. + | apply StepFun_P2; set (H := StepFun_P6 (pre f)); unfold IsStepFun in H; + elim H; intros; unfold is_subdivision in |- *; + elim p; intros; apply p0 ]. + assert (H : a < b); + [ auto with real + | assert (H0 : b < a); + [ auto with real | elim (Rlt_irrefl _ (Rlt_trans _ _ _ H H0)) ] ]. Qed. Lemma StepFun_P40 : - forall (f:R -> R) (a b c:R) (l1 l2 lf1 lf2:Rlist), - a < b -> - b < c -> - adapted_couple f a b l1 lf1 -> - adapted_couple f b c l2 lf2 -> - adapted_couple f a c (cons_Rlist l1 l2) (FF (cons_Rlist l1 l2) f). -intros f a b c l1 l2 lf1 lf2 H H0 H1 H2; unfold adapted_couple in H1, H2; - unfold adapted_couple in |- *; decompose [and] H1; - decompose [and] H2; clear H1 H2; repeat split. -apply RList_P25; try assumption. -rewrite H10; rewrite H4; unfold Rmin, Rmax in |- *; case (Rle_dec a b); - case (Rle_dec b c); intros; - (right; reflexivity) || (elim n; left; assumption). -rewrite RList_P22. -rewrite H5; unfold Rmin, Rmax in |- *; case (Rle_dec a b); case (Rle_dec a c); - intros; - [ reflexivity - | elim n; apply Rle_trans with b; left; assumption - | elim n; left; assumption - | elim n0; left; assumption ]. -red in |- *; intro; rewrite H1 in H6; discriminate. -rewrite RList_P24. -rewrite H9; unfold Rmin, Rmax in |- *; case (Rle_dec b c); case (Rle_dec a c); - intros; - [ reflexivity - | elim n; apply Rle_trans with b; left; assumption - | elim n; left; assumption - | elim n0; left; assumption ]. -red in |- *; intro; rewrite H1 in H11; discriminate. -apply StepFun_P20. -rewrite RList_P23; apply neq_O_lt; red in |- *; intro. -assert (H2 : (Rlength l1 + Rlength l2)%nat = 0%nat). -symmetry in |- *; apply H1. -elim (plus_is_O _ _ H2); intros; rewrite H12 in H6; discriminate. -unfold constant_D_eq, open_interval in |- *; intros; - elim (le_or_lt (S (S i)) (Rlength l1)); intro. -assert (H14 : pos_Rl (cons_Rlist l1 l2) i = pos_Rl l1 i). -apply RList_P26; apply lt_S_n; apply le_lt_n_Sm; apply le_S_n; - apply le_trans with (Rlength l1); [ assumption | apply le_n_Sn ]. -assert (H15 : pos_Rl (cons_Rlist l1 l2) (S i) = pos_Rl l1 (S i)). -apply RList_P26; apply lt_S_n; apply le_lt_n_Sm; assumption. -rewrite H14 in H2; rewrite H15 in H2; assert (H16 : (2 <= Rlength l1)%nat). -apply le_trans with (S (S i)); - [ repeat apply le_n_S; apply le_O_n | assumption ]. -elim (RList_P20 _ H16); intros r1 [r2 [r3 H17]]; rewrite H17; - change - (f x = pos_Rl (app_Rlist (mid_Rlist (cons_Rlist (cons r2 r3) l2) r1) f) i) - in |- *; rewrite RList_P12. -induction i as [| i Hreci]. -simpl in |- *; assert (H18 := H8 0%nat); - unfold constant_D_eq, open_interval in H18; - assert (H19 : (0 < pred (Rlength l1))%nat). -rewrite H17; simpl in |- *; apply lt_O_Sn. -assert (H20 := H18 H19); repeat rewrite H20. -reflexivity. -assert (H21 : r1 <= r2). -rewrite H17 in H3; apply (H3 0%nat). -simpl in |- *; apply lt_O_Sn. -elim H21; intro. -split. -rewrite H17; simpl in |- *; apply Rmult_lt_reg_l with 2; - [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption - | discrR ] ]. -rewrite H17; simpl in |- *; apply Rmult_lt_reg_l with 2; - [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; rewrite (Rplus_comm r1); rewrite double; - apply Rplus_lt_compat_l; assumption - | discrR ] ]. -elim H2; intros; rewrite H17 in H23; rewrite H17 in H24; simpl in H24; - simpl in H23; rewrite H22 in H23; - elim (Rlt_irrefl _ (Rlt_trans _ _ _ H23 H24)). -assumption. -clear Hreci; rewrite RList_P13. -rewrite H17 in H14; rewrite H17 in H15; - change - (pos_Rl (cons_Rlist (cons r2 r3) l2) i = - pos_Rl (cons r1 (cons r2 r3)) (S i)) in H14; rewrite H14; - change - (pos_Rl (cons_Rlist (cons r2 r3) l2) (S i) = - pos_Rl (cons r1 (cons r2 r3)) (S (S i))) in H15; - rewrite H15; assert (H18 := H8 (S i)); - unfold constant_D_eq, open_interval in H18; - assert (H19 : (S i < pred (Rlength l1))%nat). -apply lt_pred; apply lt_S_n; apply le_lt_n_Sm; assumption. -assert (H20 := H18 H19); repeat rewrite H20. -reflexivity. -rewrite <- H17; assert (H21 : pos_Rl l1 (S i) <= pos_Rl l1 (S (S i))). -apply (H3 (S i)); apply lt_pred; apply lt_S_n; apply le_lt_n_Sm; assumption. -elim H21; intro. -split. -apply Rmult_lt_reg_l with 2; - [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption - | discrR ] ]. -apply Rmult_lt_reg_l with 2; - [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; rewrite (Rplus_comm (pos_Rl l1 (S i))); - rewrite double; apply Rplus_lt_compat_l; assumption - | discrR ] ]. -elim H2; intros; rewrite H22 in H23; - elim (Rlt_irrefl _ (Rlt_trans _ _ _ H23 H24)). -assumption. -simpl in |- *; rewrite H17 in H1; simpl in H1; apply lt_S_n; assumption. -rewrite RList_P14; rewrite H17 in H1; simpl in H1; apply H1. -inversion H12. -assert (H16 : pos_Rl (cons_Rlist l1 l2) (S i) = b). -rewrite RList_P29. -rewrite H15; rewrite <- minus_n_n; rewrite H10; unfold Rmin in |- *; - case (Rle_dec b c); intro; [ reflexivity | elim n; left; assumption ]. -rewrite H15; apply le_n. -induction l1 as [| r l1 Hrecl1]. -simpl in H15; discriminate. -clear Hrecl1; simpl in H1; simpl in |- *; apply lt_n_S; assumption. -assert (H17 : pos_Rl (cons_Rlist l1 l2) i = b). -rewrite RList_P26. -replace i with (pred (Rlength l1)); - [ rewrite H4; unfold Rmax in |- *; case (Rle_dec a b); intro; + forall (f:R -> R) (a b c:R) (l1 l2 lf1 lf2:Rlist), + a < b -> + b < c -> + adapted_couple f a b l1 lf1 -> + adapted_couple f b c l2 lf2 -> + adapted_couple f a c (cons_Rlist l1 l2) (FF (cons_Rlist l1 l2) f). +Proof. + intros f a b c l1 l2 lf1 lf2 H H0 H1 H2; unfold adapted_couple in H1, H2; + unfold adapted_couple in |- *; decompose [and] H1; + decompose [and] H2; clear H1 H2; repeat split. + apply RList_P25; try assumption. + rewrite H10; rewrite H4; unfold Rmin, Rmax in |- *; case (Rle_dec a b); + case (Rle_dec b c); intros; + (right; reflexivity) || (elim n; left; assumption). + rewrite RList_P22. + rewrite H5; unfold Rmin, Rmax in |- *; case (Rle_dec a b); case (Rle_dec a c); + intros; + [ reflexivity + | elim n; apply Rle_trans with b; left; assumption + | elim n; left; assumption + | elim n0; left; assumption ]. + red in |- *; intro; rewrite H1 in H6; discriminate. + rewrite RList_P24. + rewrite H9; unfold Rmin, Rmax in |- *; case (Rle_dec b c); case (Rle_dec a c); + intros; + [ reflexivity + | elim n; apply Rle_trans with b; left; assumption + | elim n; left; assumption + | elim n0; left; assumption ]. + red in |- *; intro; rewrite H1 in H11; discriminate. + apply StepFun_P20. + rewrite RList_P23; apply neq_O_lt; red in |- *; intro. + assert (H2 : (Rlength l1 + Rlength l2)%nat = 0%nat). + symmetry in |- *; apply H1. + elim (plus_is_O _ _ H2); intros; rewrite H12 in H6; discriminate. + unfold constant_D_eq, open_interval in |- *; intros; + elim (le_or_lt (S (S i)) (Rlength l1)); intro. + assert (H14 : pos_Rl (cons_Rlist l1 l2) i = pos_Rl l1 i). + apply RList_P26; apply lt_S_n; apply le_lt_n_Sm; apply le_S_n; + apply le_trans with (Rlength l1); [ assumption | apply le_n_Sn ]. + assert (H15 : pos_Rl (cons_Rlist l1 l2) (S i) = pos_Rl l1 (S i)). + apply RList_P26; apply lt_S_n; apply le_lt_n_Sm; assumption. + rewrite H14 in H2; rewrite H15 in H2; assert (H16 : (2 <= Rlength l1)%nat). + apply le_trans with (S (S i)); + [ repeat apply le_n_S; apply le_O_n | assumption ]. + elim (RList_P20 _ H16); intros r1 [r2 [r3 H17]]; rewrite H17; + change + (f x = pos_Rl (app_Rlist (mid_Rlist (cons_Rlist (cons r2 r3) l2) r1) f) i) + in |- *; rewrite RList_P12. + induction i as [| i Hreci]. + simpl in |- *; assert (H18 := H8 0%nat); + unfold constant_D_eq, open_interval in H18; + assert (H19 : (0 < pred (Rlength l1))%nat). + rewrite H17; simpl in |- *; apply lt_O_Sn. + assert (H20 := H18 H19); repeat rewrite H20. + reflexivity. + assert (H21 : r1 <= r2). + rewrite H17 in H3; apply (H3 0%nat). + simpl in |- *; apply lt_O_Sn. + elim H21; intro. + split. + rewrite H17; simpl in |- *; apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. + rewrite H17; simpl in |- *; apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite (Rplus_comm r1); rewrite double; + apply Rplus_lt_compat_l; assumption + | discrR ] ]. + elim H2; intros; rewrite H17 in H23; rewrite H17 in H24; simpl in H24; + simpl in H23; rewrite H22 in H23; + elim (Rlt_irrefl _ (Rlt_trans _ _ _ H23 H24)). + assumption. + clear Hreci; rewrite RList_P13. + rewrite H17 in H14; rewrite H17 in H15; + change + (pos_Rl (cons_Rlist (cons r2 r3) l2) i = + pos_Rl (cons r1 (cons r2 r3)) (S i)) in H14; rewrite H14; + change + (pos_Rl (cons_Rlist (cons r2 r3) l2) (S i) = + pos_Rl (cons r1 (cons r2 r3)) (S (S i))) in H15; + rewrite H15; assert (H18 := H8 (S i)); + unfold constant_D_eq, open_interval in H18; + assert (H19 : (S i < pred (Rlength l1))%nat). + apply lt_pred; apply lt_S_n; apply le_lt_n_Sm; assumption. + assert (H20 := H18 H19); repeat rewrite H20. + reflexivity. + rewrite <- H17; assert (H21 : pos_Rl l1 (S i) <= pos_Rl l1 (S (S i))). + apply (H3 (S i)); apply lt_pred; apply lt_S_n; apply le_lt_n_Sm; assumption. + elim H21; intro. + split. + apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. + apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite (Rplus_comm (pos_Rl l1 (S i))); + rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. + elim H2; intros; rewrite H22 in H23; + elim (Rlt_irrefl _ (Rlt_trans _ _ _ H23 H24)). + assumption. + simpl in |- *; rewrite H17 in H1; simpl in H1; apply lt_S_n; assumption. + rewrite RList_P14; rewrite H17 in H1; simpl in H1; apply H1. + inversion H12. + assert (H16 : pos_Rl (cons_Rlist l1 l2) (S i) = b). + rewrite RList_P29. + rewrite H15; rewrite <- minus_n_n; rewrite H10; unfold Rmin in |- *; + case (Rle_dec b c); intro; [ reflexivity | elim n; left; assumption ]. + rewrite H15; apply le_n. + induction l1 as [| r l1 Hrecl1]. + simpl in H15; discriminate. + clear Hrecl1; simpl in H1; simpl in |- *; apply lt_n_S; assumption. + assert (H17 : pos_Rl (cons_Rlist l1 l2) i = b). + rewrite RList_P26. + replace i with (pred (Rlength l1)); + [ rewrite H4; unfold Rmax in |- *; case (Rle_dec a b); intro; [ reflexivity | elim n; left; assumption ] - | rewrite H15; reflexivity ]. -rewrite H15; apply lt_n_Sn. -rewrite H16 in H2; rewrite H17 in H2; elim H2; intros; - elim (Rlt_irrefl _ (Rlt_trans _ _ _ H14 H18)). -assert (H16 : pos_Rl (cons_Rlist l1 l2) i = pos_Rl l2 (i - Rlength l1)). -apply RList_P29. -apply le_S_n; assumption. -apply lt_le_trans with (pred (Rlength (cons_Rlist l1 l2))); - [ assumption | apply le_pred_n ]. -assert - (H17 : pos_Rl (cons_Rlist l1 l2) (S i) = pos_Rl l2 (S (i - Rlength l1))). -replace (S (i - Rlength l1)) with (S i - Rlength l1)%nat. -apply RList_P29. -apply le_S_n; apply le_trans with (S i); [ assumption | apply le_n_Sn ]. -induction l1 as [| r l1 Hrecl1]. -simpl in H6; discriminate. -clear Hrecl1; simpl in H1; simpl in |- *; apply lt_n_S; assumption. -symmetry in |- *; apply minus_Sn_m; apply le_S_n; assumption. -assert (H18 : (2 <= Rlength l1)%nat). -clear f c l2 lf2 H0 H3 H8 H7 H10 H9 H11 H13 i H1 x H2 H12 m H14 H15 H16 H17; - induction l1 as [| r l1 Hrecl1]. -discriminate. -clear Hrecl1; induction l1 as [| r0 l1 Hrecl1]. -simpl in H5; simpl in H4; assert (H0 : Rmin a b < Rmax a b). -unfold Rmin, Rmax in |- *; case (Rle_dec a b); intro; - [ assumption | elim n; left; assumption ]. -rewrite <- H5 in H0; rewrite <- H4 in H0; elim (Rlt_irrefl _ H0). -clear Hrecl1; simpl in |- *; repeat apply le_n_S; apply le_O_n. -elim (RList_P20 _ H18); intros r1 [r2 [r3 H19]]; rewrite H19; - change - (f x = pos_Rl (app_Rlist (mid_Rlist (cons_Rlist (cons r2 r3) l2) r1) f) i) - in |- *; rewrite RList_P12. -induction i as [| i Hreci]. -assert (H20 := le_S_n _ _ H15); assert (H21 := le_trans _ _ _ H18 H20); - elim (le_Sn_O _ H21). -clear Hreci; rewrite RList_P13. -rewrite H19 in H16; rewrite H19 in H17; - change - (pos_Rl (cons_Rlist (cons r2 r3) l2) i = - pos_Rl l2 (S i - Rlength (cons r1 (cons r2 r3)))) - in H16; rewrite H16; - change - (pos_Rl (cons_Rlist (cons r2 r3) l2) (S i) = - pos_Rl l2 (S (S i - Rlength (cons r1 (cons r2 r3))))) - in H17; rewrite H17; assert (H20 := H13 (S i - Rlength l1)%nat); - unfold constant_D_eq, open_interval in H20; - assert (H21 : (S i - Rlength l1 < pred (Rlength l2))%nat). -apply lt_pred; rewrite minus_Sn_m. -apply plus_lt_reg_l with (Rlength l1); rewrite <- le_plus_minus. -rewrite H19 in H1; simpl in H1; rewrite H19; simpl in |- *; - rewrite RList_P23 in H1; apply lt_n_S; assumption. -apply le_trans with (S i); [ apply le_S_n; assumption | apply le_n_Sn ]. -apply le_S_n; assumption. -assert (H22 := H20 H21); repeat rewrite H22. -reflexivity. -rewrite <- H19; - assert - (H23 : pos_Rl l2 (S i - Rlength l1) <= pos_Rl l2 (S (S i - Rlength l1))). -apply H7; apply lt_pred. -rewrite minus_Sn_m. -apply plus_lt_reg_l with (Rlength l1); rewrite <- le_plus_minus. -rewrite H19 in H1; simpl in H1; rewrite H19; simpl in |- *; - rewrite RList_P23 in H1; apply lt_n_S; assumption. -apply le_trans with (S i); [ apply le_S_n; assumption | apply le_n_Sn ]. -apply le_S_n; assumption. -elim H23; intro. -split. -apply Rmult_lt_reg_l with 2; - [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption - | discrR ] ]. -apply Rmult_lt_reg_l with 2; - [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym; - [ rewrite Rmult_1_l; rewrite (Rplus_comm (pos_Rl l2 (S i - Rlength l1))); - rewrite double; apply Rplus_lt_compat_l; assumption - | discrR ] ]. -rewrite <- H19 in H16; rewrite <- H19 in H17; elim H2; intros; - rewrite H19 in H25; rewrite H19 in H26; simpl in H25; - simpl in H16; rewrite H16 in H25; simpl in H26; simpl in H17; - rewrite H17 in H26; simpl in H24; rewrite H24 in H25; - elim (Rlt_irrefl _ (Rlt_trans _ _ _ H25 H26)). -assert (H23 : pos_Rl (cons_Rlist l1 l2) (S i) = pos_Rl l2 (S i - Rlength l1)). -rewrite H19; simpl in |- *; simpl in H16; apply H16. -assert - (H24 : - pos_Rl (cons_Rlist l1 l2) (S (S i)) = pos_Rl l2 (S (S i - Rlength l1))). -rewrite H19; simpl in |- *; simpl in H17; apply H17. -rewrite <- H23; rewrite <- H24; assumption. -simpl in |- *; rewrite H19 in H1; simpl in H1; apply lt_S_n; assumption. -rewrite RList_P14; rewrite H19 in H1; simpl in H1; simpl in |- *; apply H1. + | rewrite H15; reflexivity ]. + rewrite H15; apply lt_n_Sn. + rewrite H16 in H2; rewrite H17 in H2; elim H2; intros; + elim (Rlt_irrefl _ (Rlt_trans _ _ _ H14 H18)). + assert (H16 : pos_Rl (cons_Rlist l1 l2) i = pos_Rl l2 (i - Rlength l1)). + apply RList_P29. + apply le_S_n; assumption. + apply lt_le_trans with (pred (Rlength (cons_Rlist l1 l2))); + [ assumption | apply le_pred_n ]. + assert + (H17 : pos_Rl (cons_Rlist l1 l2) (S i) = pos_Rl l2 (S (i - Rlength l1))). + replace (S (i - Rlength l1)) with (S i - Rlength l1)%nat. + apply RList_P29. + apply le_S_n; apply le_trans with (S i); [ assumption | apply le_n_Sn ]. + induction l1 as [| r l1 Hrecl1]. + simpl in H6; discriminate. + clear Hrecl1; simpl in H1; simpl in |- *; apply lt_n_S; assumption. + symmetry in |- *; apply minus_Sn_m; apply le_S_n; assumption. + assert (H18 : (2 <= Rlength l1)%nat). + clear f c l2 lf2 H0 H3 H8 H7 H10 H9 H11 H13 i H1 x H2 H12 m H14 H15 H16 H17; + induction l1 as [| r l1 Hrecl1]. + discriminate. + clear Hrecl1; induction l1 as [| r0 l1 Hrecl1]. + simpl in H5; simpl in H4; assert (H0 : Rmin a b < Rmax a b). + unfold Rmin, Rmax in |- *; case (Rle_dec a b); intro; + [ assumption | elim n; left; assumption ]. + rewrite <- H5 in H0; rewrite <- H4 in H0; elim (Rlt_irrefl _ H0). + clear Hrecl1; simpl in |- *; repeat apply le_n_S; apply le_O_n. + elim (RList_P20 _ H18); intros r1 [r2 [r3 H19]]; rewrite H19; + change + (f x = pos_Rl (app_Rlist (mid_Rlist (cons_Rlist (cons r2 r3) l2) r1) f) i) + in |- *; rewrite RList_P12. + induction i as [| i Hreci]. + assert (H20 := le_S_n _ _ H15); assert (H21 := le_trans _ _ _ H18 H20); + elim (le_Sn_O _ H21). + clear Hreci; rewrite RList_P13. + rewrite H19 in H16; rewrite H19 in H17; + change + (pos_Rl (cons_Rlist (cons r2 r3) l2) i = + pos_Rl l2 (S i - Rlength (cons r1 (cons r2 r3)))) + in H16; rewrite H16; + change + (pos_Rl (cons_Rlist (cons r2 r3) l2) (S i) = + pos_Rl l2 (S (S i - Rlength (cons r1 (cons r2 r3))))) + in H17; rewrite H17; assert (H20 := H13 (S i - Rlength l1)%nat); + unfold constant_D_eq, open_interval in H20; + assert (H21 : (S i - Rlength l1 < pred (Rlength l2))%nat). + apply lt_pred; rewrite minus_Sn_m. + apply plus_lt_reg_l with (Rlength l1); rewrite <- le_plus_minus. + rewrite H19 in H1; simpl in H1; rewrite H19; simpl in |- *; + rewrite RList_P23 in H1; apply lt_n_S; assumption. + apply le_trans with (S i); [ apply le_S_n; assumption | apply le_n_Sn ]. + apply le_S_n; assumption. + assert (H22 := H20 H21); repeat rewrite H22. + reflexivity. + rewrite <- H19; + assert + (H23 : pos_Rl l2 (S i - Rlength l1) <= pos_Rl l2 (S (S i - Rlength l1))). + apply H7; apply lt_pred. + rewrite minus_Sn_m. + apply plus_lt_reg_l with (Rlength l1); rewrite <- le_plus_minus. + rewrite H19 in H1; simpl in H1; rewrite H19; simpl in |- *; + rewrite RList_P23 in H1; apply lt_n_S; assumption. + apply le_trans with (S i); [ apply le_S_n; assumption | apply le_n_Sn ]. + apply le_S_n; assumption. + elim H23; intro. + split. + apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. + apply Rmult_lt_reg_l with 2; + [ prove_sup0 + | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym; + [ rewrite Rmult_1_l; rewrite (Rplus_comm (pos_Rl l2 (S i - Rlength l1))); + rewrite double; apply Rplus_lt_compat_l; assumption + | discrR ] ]. + rewrite <- H19 in H16; rewrite <- H19 in H17; elim H2; intros; + rewrite H19 in H25; rewrite H19 in H26; simpl in H25; + simpl in H16; rewrite H16 in H25; simpl in H26; simpl in H17; + rewrite H17 in H26; simpl in H24; rewrite H24 in H25; + elim (Rlt_irrefl _ (Rlt_trans _ _ _ H25 H26)). + assert (H23 : pos_Rl (cons_Rlist l1 l2) (S i) = pos_Rl l2 (S i - Rlength l1)). + rewrite H19; simpl in |- *; simpl in H16; apply H16. + assert + (H24 : + pos_Rl (cons_Rlist l1 l2) (S (S i)) = pos_Rl l2 (S (S i - Rlength l1))). + rewrite H19; simpl in |- *; simpl in H17; apply H17. + rewrite <- H23; rewrite <- H24; assumption. + simpl in |- *; rewrite H19 in H1; simpl in H1; apply lt_S_n; assumption. + rewrite RList_P14; rewrite H19 in H1; simpl in H1; simpl in |- *; apply H1. Qed. Lemma StepFun_P41 : - forall (f:R -> R) (a b c:R), - a <= b -> b <= c -> IsStepFun f a b -> IsStepFun f b c -> IsStepFun f a c. + forall (f:R -> R) (a b c:R), + a <= b -> b <= c -> IsStepFun f a b -> IsStepFun f b c -> IsStepFun f a c. Proof. -intros f a b c H H0 (l1,(lf1,H1)) (l2,(lf2,H2)); - destruct (total_order_T a b) as [[Hltab|Hab]|Hgtab]. - destruct (total_order_T b c) as [[Hltbc|Hbc]|Hgtbc]. -exists (cons_Rlist l1 l2); exists (FF (cons_Rlist l1 l2) f); - apply StepFun_P40 with b lf1 lf2; assumption. -exists l1; exists lf1; rewrite Hbc in H1; assumption. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 Hgtbc)). -exists l2; exists lf2; rewrite <- Hab in H2; assumption. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H Hgtab)). + intros f a b c H H0 (l1,(lf1,H1)) (l2,(lf2,H2)); + destruct (total_order_T a b) as [[Hltab|Hab]|Hgtab]. + destruct (total_order_T b c) as [[Hltbc|Hbc]|Hgtbc]. + exists (cons_Rlist l1 l2); exists (FF (cons_Rlist l1 l2) f); + apply StepFun_P40 with b lf1 lf2; assumption. + exists l1; exists lf1; rewrite Hbc in H1; assumption. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 Hgtbc)). + exists l2; exists lf2; rewrite <- Hab in H2; assumption. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H Hgtab)). Qed. Lemma StepFun_P42 : - forall (l1 l2:Rlist) (f:R -> R), - pos_Rl l1 (pred (Rlength l1)) = pos_Rl l2 0 -> - Int_SF (FF (cons_Rlist l1 l2) f) (cons_Rlist l1 l2) = - Int_SF (FF l1 f) l1 + Int_SF (FF l2 f) l2. -intros l1 l2 f; induction l1 as [| r l1 IHl1]; intros H; - [ simpl in |- *; ring - | destruct l1 as [| r0 r1]; - [ simpl in H; simpl in |- *; destruct l2 as [| r0 r1]; - [ simpl in |- *; ring | simpl in |- *; simpl in H; rewrite H; ring ] - | simpl in |- *; rewrite Rplus_assoc; apply Rplus_eq_compat_l; apply IHl1; - rewrite <- H; reflexivity ] ]. + forall (l1 l2:Rlist) (f:R -> R), + pos_Rl l1 (pred (Rlength l1)) = pos_Rl l2 0 -> + Int_SF (FF (cons_Rlist l1 l2) f) (cons_Rlist l1 l2) = + Int_SF (FF l1 f) l1 + Int_SF (FF l2 f) l2. +Proof. + intros l1 l2 f; induction l1 as [| r l1 IHl1]; intros H; + [ simpl in |- *; ring + | destruct l1 as [| r0 r1]; + [ simpl in H; simpl in |- *; destruct l2 as [| r0 r1]; + [ simpl in |- *; ring | simpl in |- *; simpl in H; rewrite H; ring ] + | simpl in |- *; rewrite Rplus_assoc; apply Rplus_eq_compat_l; apply IHl1; + rewrite <- H; reflexivity ] ]. Qed. Lemma StepFun_P43 : - forall (f:R -> R) (a b c:R) (pr1:IsStepFun f a b) - (pr2:IsStepFun f b c) (pr3:IsStepFun f a c), - RiemannInt_SF (mkStepFun pr1) + RiemannInt_SF (mkStepFun pr2) = - RiemannInt_SF (mkStepFun pr3). -intros f; intros; - assert - (H1 : - sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f a b l l0))). -apply pr1. -assert - (H2 : - sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f b c l l0))). -apply pr2. -assert - (H3 : - sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f a c l l0))). -apply pr3. -elim H1; clear H1; intros l1 [lf1 H1]; elim H2; clear H2; intros l2 [lf2 H2]; - elim H3; clear H3; intros l3 [lf3 H3]. -replace (RiemannInt_SF (mkStepFun pr1)) with - match Rle_dec a b with - | left _ => Int_SF lf1 l1 - | right _ => - Int_SF lf1 l1 - end. -replace (RiemannInt_SF (mkStepFun pr2)) with - match Rle_dec b c with - | left _ => Int_SF lf2 l2 - | right _ => - Int_SF lf2 l2 - end. -replace (RiemannInt_SF (mkStepFun pr3)) with - match Rle_dec a c with - | left _ => Int_SF lf3 l3 - | right _ => - Int_SF lf3 l3 - end. -case (Rle_dec a b); case (Rle_dec b c); case (Rle_dec a c); intros. -elim r1; intro. -elim r0; intro. -replace (Int_SF lf3 l3) with - (Int_SF (FF (cons_Rlist l1 l2) f) (cons_Rlist l1 l2)). -replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1). -replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2). -symmetry in |- *; apply StepFun_P42. -unfold adapted_couple in H1, H2; decompose [and] H1; decompose [and] H2; - clear H1 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *; - case (Rle_dec a b); case (Rle_dec b c); intros; reflexivity || elim n; - assumption. -eapply StepFun_P17; - [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2; - assumption - | assumption ]. -eapply StepFun_P17; - [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1 - | assumption ]. -eapply StepFun_P17; [ apply (StepFun_P40 H H0 H1 H2) | apply H3 ]. -replace (Int_SF lf2 l2) with 0. -rewrite Rplus_0_r; eapply StepFun_P17; - [ apply H1 | rewrite <- H0 in H3; apply H3 ]. -symmetry in |- *; eapply StepFun_P8; [ apply H2 | assumption ]. -replace (Int_SF lf1 l1) with 0. -rewrite Rplus_0_l; eapply StepFun_P17; - [ apply H2 | rewrite H in H3; apply H3 ]. -symmetry in |- *; eapply StepFun_P8; [ apply H1 | assumption ]. -elim n; apply Rle_trans with b; assumption. -apply Rplus_eq_reg_l with (Int_SF lf2 l2); - replace (Int_SF lf2 l2 + (Int_SF lf1 l1 + - Int_SF lf2 l2)) with - (Int_SF lf1 l1); [ idtac | ring ]. -assert (H : c < b). -auto with real. -elim r; intro. -rewrite Rplus_comm; - replace (Int_SF lf1 l1) with - (Int_SF (FF (cons_Rlist l3 l2) f) (cons_Rlist l3 l2)). -replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3). -replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2). -apply StepFun_P42. -unfold adapted_couple in H2, H3; decompose [and] H2; decompose [and] H3; - clear H3 H2; rewrite H10; rewrite H6; unfold Rmax, Rmin in |- *; - case (Rle_dec a c); case (Rle_dec b c); intros; - [ elim n; assumption - | reflexivity - | elim n0; assumption - | elim n1; assumption ]. -eapply StepFun_P17; - [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2 - | assumption ]. -eapply StepFun_P17; - [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3 - | assumption ]. -eapply StepFun_P17; - [ apply (StepFun_P40 H0 H H3 (StepFun_P2 H2)) | apply H1 ]. -replace (Int_SF lf3 l3) with 0. -rewrite Rplus_0_r; eapply StepFun_P17; - [ apply H1 | apply StepFun_P2; rewrite <- H0 in H2; apply H2 ]. -symmetry in |- *; eapply StepFun_P8; [ apply H3 | assumption ]. -replace (Int_SF lf2 l2) with (Int_SF lf3 l3 + Int_SF lf1 l1). -ring. -elim r; intro. -replace (Int_SF lf2 l2) with - (Int_SF (FF (cons_Rlist l3 l1) f) (cons_Rlist l3 l1)). -replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3). -replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1). -symmetry in |- *; apply StepFun_P42. -unfold adapted_couple in H1, H3; decompose [and] H1; decompose [and] H3; - clear H3 H1; rewrite H9; rewrite H5; unfold Rmax, Rmin in |- *; - case (Rle_dec a c); case (Rle_dec a b); intros; - [ elim n; assumption - | elim n1; assumption - | reflexivity - | elim n1; assumption ]. -eapply StepFun_P17; - [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1 - | assumption ]. -eapply StepFun_P17; - [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3 - | assumption ]. -eapply StepFun_P17. -assert (H0 : c < a). -auto with real. -apply (StepFun_P40 H0 H (StepFun_P2 H3) H1). -apply StepFun_P2; apply H2. -replace (Int_SF lf1 l1) with 0. -rewrite Rplus_0_r; eapply StepFun_P17; - [ apply H3 | rewrite <- H in H2; apply H2 ]. -symmetry in |- *; eapply StepFun_P8; [ apply H1 | assumption ]. -assert (H : b < a). -auto with real. -replace (Int_SF lf2 l2) with (Int_SF lf3 l3 + Int_SF lf1 l1). -ring. -rewrite Rplus_comm; elim r; intro. -replace (Int_SF lf2 l2) with - (Int_SF (FF (cons_Rlist l1 l3) f) (cons_Rlist l1 l3)). -replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3). -replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1). -symmetry in |- *; apply StepFun_P42. -unfold adapted_couple in H1, H3; decompose [and] H1; decompose [and] H3; - clear H3 H1; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *; - case (Rle_dec a c); case (Rle_dec a b); intros; - [ elim n; assumption - | reflexivity - | elim n0; assumption - | elim n1; assumption ]. -eapply StepFun_P17; - [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1 - | assumption ]. -eapply StepFun_P17; - [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3 - | assumption ]. -eapply StepFun_P17. -apply (StepFun_P40 H H0 (StepFun_P2 H1) H3). -apply H2. -replace (Int_SF lf3 l3) with 0. -rewrite Rplus_0_r; eapply StepFun_P17; - [ apply H1 | rewrite <- H0 in H2; apply StepFun_P2; apply H2 ]. -symmetry in |- *; eapply StepFun_P8; [ apply H3 | assumption ]. -assert (H : c < a). -auto with real. -replace (Int_SF lf1 l1) with (Int_SF lf2 l2 + Int_SF lf3 l3). -ring. -elim r; intro. -replace (Int_SF lf1 l1) with - (Int_SF (FF (cons_Rlist l2 l3) f) (cons_Rlist l2 l3)). -replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3). -replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2). -symmetry in |- *; apply StepFun_P42. -unfold adapted_couple in H2, H3; decompose [and] H2; decompose [and] H3; - clear H3 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *; - case (Rle_dec a c); case (Rle_dec b c); intros; - [ elim n; assumption - | elim n1; assumption - | reflexivity - | elim n1; assumption ]. -eapply StepFun_P17; - [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2 - | assumption ]. -eapply StepFun_P17; - [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3 - | assumption ]. -eapply StepFun_P17. -apply (StepFun_P40 H0 H H2 (StepFun_P2 H3)). -apply StepFun_P2; apply H1. -replace (Int_SF lf2 l2) with 0. -rewrite Rplus_0_l; eapply StepFun_P17; - [ apply H3 | rewrite H0 in H1; apply H1 ]. -symmetry in |- *; eapply StepFun_P8; [ apply H2 | assumption ]. -elim n; apply Rle_trans with a; try assumption. -auto with real. -assert (H : c < b). -auto with real. -assert (H0 : b < a). -auto with real. -replace (Int_SF lf3 l3) with (Int_SF lf2 l2 + Int_SF lf1 l1). -ring. -replace (Int_SF lf3 l3) with - (Int_SF (FF (cons_Rlist l2 l1) f) (cons_Rlist l2 l1)). -replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1). -replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2). -symmetry in |- *; apply StepFun_P42. -unfold adapted_couple in H2, H1; decompose [and] H2; decompose [and] H1; - clear H1 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *; - case (Rle_dec a b); case (Rle_dec b c); intros; - [ elim n1; assumption - | elim n1; assumption - | elim n0; assumption - | reflexivity ]. -eapply StepFun_P17; - [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2 - | assumption ]. -eapply StepFun_P17; - [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1 - | assumption ]. -eapply StepFun_P17. -apply (StepFun_P40 H H0 (StepFun_P2 H2) (StepFun_P2 H1)). -apply StepFun_P2; apply H3. -unfold RiemannInt_SF in |- *; case (Rle_dec a c); intro. -eapply StepFun_P17. -apply H3. -change - (adapted_couple (mkStepFun pr3) a c (subdivision (mkStepFun pr3)) - (subdivision_val (mkStepFun pr3))) in |- *; apply StepFun_P1. -apply Ropp_eq_compat; eapply StepFun_P17. -apply H3. -change - (adapted_couple (mkStepFun pr3) a c (subdivision (mkStepFun pr3)) - (subdivision_val (mkStepFun pr3))) in |- *; apply StepFun_P1. -unfold RiemannInt_SF in |- *; case (Rle_dec b c); intro. -eapply StepFun_P17. -apply H2. -change - (adapted_couple (mkStepFun pr2) b c (subdivision (mkStepFun pr2)) - (subdivision_val (mkStepFun pr2))) in |- *; apply StepFun_P1. -apply Ropp_eq_compat; eapply StepFun_P17. -apply H2. -change - (adapted_couple (mkStepFun pr2) b c (subdivision (mkStepFun pr2)) - (subdivision_val (mkStepFun pr2))) in |- *; apply StepFun_P1. -unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro. -eapply StepFun_P17. -apply H1. -change - (adapted_couple (mkStepFun pr1) a b (subdivision (mkStepFun pr1)) - (subdivision_val (mkStepFun pr1))) in |- *; apply StepFun_P1. -apply Ropp_eq_compat; eapply StepFun_P17. -apply H1. -change - (adapted_couple (mkStepFun pr1) a b (subdivision (mkStepFun pr1)) - (subdivision_val (mkStepFun pr1))) in |- *; apply StepFun_P1. + forall (f:R -> R) (a b c:R) (pr1:IsStepFun f a b) + (pr2:IsStepFun f b c) (pr3:IsStepFun f a c), + RiemannInt_SF (mkStepFun pr1) + RiemannInt_SF (mkStepFun pr2) = + RiemannInt_SF (mkStepFun pr3). +Proof. + intros f; intros; + assert + (H1 : + sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f a b l l0))). + apply pr1. + assert + (H2 : + sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f b c l l0))). + apply pr2. + assert + (H3 : + sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f a c l l0))). + apply pr3. + elim H1; clear H1; intros l1 [lf1 H1]; elim H2; clear H2; intros l2 [lf2 H2]; + elim H3; clear H3; intros l3 [lf3 H3]. + replace (RiemannInt_SF (mkStepFun pr1)) with + match Rle_dec a b with + | left _ => Int_SF lf1 l1 + | right _ => - Int_SF lf1 l1 + end. + replace (RiemannInt_SF (mkStepFun pr2)) with + match Rle_dec b c with + | left _ => Int_SF lf2 l2 + | right _ => - Int_SF lf2 l2 + end. + replace (RiemannInt_SF (mkStepFun pr3)) with + match Rle_dec a c with + | left _ => Int_SF lf3 l3 + | right _ => - Int_SF lf3 l3 + end. + case (Rle_dec a b); case (Rle_dec b c); case (Rle_dec a c); intros. + elim r1; intro. + elim r0; intro. + replace (Int_SF lf3 l3) with + (Int_SF (FF (cons_Rlist l1 l2) f) (cons_Rlist l1 l2)). + replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1). + replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2). + symmetry in |- *; apply StepFun_P42. + unfold adapted_couple in H1, H2; decompose [and] H1; decompose [and] H2; + clear H1 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *; + case (Rle_dec a b); case (Rle_dec b c); intros; reflexivity || elim n; + assumption. + eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2; + assumption + | assumption ]. + eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1 + | assumption ]. + eapply StepFun_P17; [ apply (StepFun_P40 H H0 H1 H2) | apply H3 ]. + replace (Int_SF lf2 l2) with 0. + rewrite Rplus_0_r; eapply StepFun_P17; + [ apply H1 | rewrite <- H0 in H3; apply H3 ]. + symmetry in |- *; eapply StepFun_P8; [ apply H2 | assumption ]. + replace (Int_SF lf1 l1) with 0. + rewrite Rplus_0_l; eapply StepFun_P17; + [ apply H2 | rewrite H in H3; apply H3 ]. + symmetry in |- *; eapply StepFun_P8; [ apply H1 | assumption ]. + elim n; apply Rle_trans with b; assumption. + apply Rplus_eq_reg_l with (Int_SF lf2 l2); + replace (Int_SF lf2 l2 + (Int_SF lf1 l1 + - Int_SF lf2 l2)) with + (Int_SF lf1 l1); [ idtac | ring ]. + assert (H : c < b). + auto with real. + elim r; intro. + rewrite Rplus_comm; + replace (Int_SF lf1 l1) with + (Int_SF (FF (cons_Rlist l3 l2) f) (cons_Rlist l3 l2)). + replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3). + replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2). + apply StepFun_P42. + unfold adapted_couple in H2, H3; decompose [and] H2; decompose [and] H3; + clear H3 H2; rewrite H10; rewrite H6; unfold Rmax, Rmin in |- *; + case (Rle_dec a c); case (Rle_dec b c); intros; + [ elim n; assumption + | reflexivity + | elim n0; assumption + | elim n1; assumption ]. + eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2 + | assumption ]. + eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3 + | assumption ]. + eapply StepFun_P17; + [ apply (StepFun_P40 H0 H H3 (StepFun_P2 H2)) | apply H1 ]. + replace (Int_SF lf3 l3) with 0. + rewrite Rplus_0_r; eapply StepFun_P17; + [ apply H1 | apply StepFun_P2; rewrite <- H0 in H2; apply H2 ]. + symmetry in |- *; eapply StepFun_P8; [ apply H3 | assumption ]. + replace (Int_SF lf2 l2) with (Int_SF lf3 l3 + Int_SF lf1 l1). + ring. + elim r; intro. + replace (Int_SF lf2 l2) with + (Int_SF (FF (cons_Rlist l3 l1) f) (cons_Rlist l3 l1)). + replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3). + replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1). + symmetry in |- *; apply StepFun_P42. + unfold adapted_couple in H1, H3; decompose [and] H1; decompose [and] H3; + clear H3 H1; rewrite H9; rewrite H5; unfold Rmax, Rmin in |- *; + case (Rle_dec a c); case (Rle_dec a b); intros; + [ elim n; assumption + | elim n1; assumption + | reflexivity + | elim n1; assumption ]. + eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1 + | assumption ]. + eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3 + | assumption ]. + eapply StepFun_P17. + assert (H0 : c < a). + auto with real. + apply (StepFun_P40 H0 H (StepFun_P2 H3) H1). + apply StepFun_P2; apply H2. + replace (Int_SF lf1 l1) with 0. + rewrite Rplus_0_r; eapply StepFun_P17; + [ apply H3 | rewrite <- H in H2; apply H2 ]. + symmetry in |- *; eapply StepFun_P8; [ apply H1 | assumption ]. + assert (H : b < a). + auto with real. + replace (Int_SF lf2 l2) with (Int_SF lf3 l3 + Int_SF lf1 l1). + ring. + rewrite Rplus_comm; elim r; intro. + replace (Int_SF lf2 l2) with + (Int_SF (FF (cons_Rlist l1 l3) f) (cons_Rlist l1 l3)). + replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3). + replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1). + symmetry in |- *; apply StepFun_P42. + unfold adapted_couple in H1, H3; decompose [and] H1; decompose [and] H3; + clear H3 H1; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *; + case (Rle_dec a c); case (Rle_dec a b); intros; + [ elim n; assumption + | reflexivity + | elim n0; assumption + | elim n1; assumption ]. + eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1 + | assumption ]. + eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3 + | assumption ]. + eapply StepFun_P17. + apply (StepFun_P40 H H0 (StepFun_P2 H1) H3). + apply H2. + replace (Int_SF lf3 l3) with 0. + rewrite Rplus_0_r; eapply StepFun_P17; + [ apply H1 | rewrite <- H0 in H2; apply StepFun_P2; apply H2 ]. + symmetry in |- *; eapply StepFun_P8; [ apply H3 | assumption ]. + assert (H : c < a). + auto with real. + replace (Int_SF lf1 l1) with (Int_SF lf2 l2 + Int_SF lf3 l3). + ring. + elim r; intro. + replace (Int_SF lf1 l1) with + (Int_SF (FF (cons_Rlist l2 l3) f) (cons_Rlist l2 l3)). + replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3). + replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2). + symmetry in |- *; apply StepFun_P42. + unfold adapted_couple in H2, H3; decompose [and] H2; decompose [and] H3; + clear H3 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *; + case (Rle_dec a c); case (Rle_dec b c); intros; + [ elim n; assumption + | elim n1; assumption + | reflexivity + | elim n1; assumption ]. + eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2 + | assumption ]. + eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3 + | assumption ]. + eapply StepFun_P17. + apply (StepFun_P40 H0 H H2 (StepFun_P2 H3)). + apply StepFun_P2; apply H1. + replace (Int_SF lf2 l2) with 0. + rewrite Rplus_0_l; eapply StepFun_P17; + [ apply H3 | rewrite H0 in H1; apply H1 ]. + symmetry in |- *; eapply StepFun_P8; [ apply H2 | assumption ]. + elim n; apply Rle_trans with a; try assumption. + auto with real. + assert (H : c < b). + auto with real. + assert (H0 : b < a). + auto with real. + replace (Int_SF lf3 l3) with (Int_SF lf2 l2 + Int_SF lf1 l1). + ring. + replace (Int_SF lf3 l3) with + (Int_SF (FF (cons_Rlist l2 l1) f) (cons_Rlist l2 l1)). + replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1). + replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2). + symmetry in |- *; apply StepFun_P42. + unfold adapted_couple in H2, H1; decompose [and] H2; decompose [and] H1; + clear H1 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *; + case (Rle_dec a b); case (Rle_dec b c); intros; + [ elim n1; assumption + | elim n1; assumption + | elim n0; assumption + | reflexivity ]. + eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2 + | assumption ]. + eapply StepFun_P17; + [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1 + | assumption ]. + eapply StepFun_P17. + apply (StepFun_P40 H H0 (StepFun_P2 H2) (StepFun_P2 H1)). + apply StepFun_P2; apply H3. + unfold RiemannInt_SF in |- *; case (Rle_dec a c); intro. + eapply StepFun_P17. + apply H3. + change + (adapted_couple (mkStepFun pr3) a c (subdivision (mkStepFun pr3)) + (subdivision_val (mkStepFun pr3))) in |- *; apply StepFun_P1. + apply Ropp_eq_compat; eapply StepFun_P17. + apply H3. + change + (adapted_couple (mkStepFun pr3) a c (subdivision (mkStepFun pr3)) + (subdivision_val (mkStepFun pr3))) in |- *; apply StepFun_P1. + unfold RiemannInt_SF in |- *; case (Rle_dec b c); intro. + eapply StepFun_P17. + apply H2. + change + (adapted_couple (mkStepFun pr2) b c (subdivision (mkStepFun pr2)) + (subdivision_val (mkStepFun pr2))) in |- *; apply StepFun_P1. + apply Ropp_eq_compat; eapply StepFun_P17. + apply H2. + change + (adapted_couple (mkStepFun pr2) b c (subdivision (mkStepFun pr2)) + (subdivision_val (mkStepFun pr2))) in |- *; apply StepFun_P1. + unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro. + eapply StepFun_P17. + apply H1. + change + (adapted_couple (mkStepFun pr1) a b (subdivision (mkStepFun pr1)) + (subdivision_val (mkStepFun pr1))) in |- *; apply StepFun_P1. + apply Ropp_eq_compat; eapply StepFun_P17. + apply H1. + change + (adapted_couple (mkStepFun pr1) a b (subdivision (mkStepFun pr1)) + (subdivision_val (mkStepFun pr1))) in |- *; apply StepFun_P1. Qed. Lemma StepFun_P44 : - forall (f:R -> R) (a b c:R), - IsStepFun f a b -> a <= c <= b -> IsStepFun f a c. -intros f; intros; assert (H0 : a <= b). -elim H; intros; apply Rle_trans with c; assumption. -elim H; clear H; intros; unfold IsStepFun in X; unfold is_subdivision in X; - elim X; clear X; intros l1 [lf1 H2]; - cut - (forall (l1 lf1:Rlist) (a b c:R) (f:R -> R), - adapted_couple f a b l1 lf1 -> - a <= c <= b -> - sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f a c l l0))). -intro X; unfold IsStepFun in |- *; unfold is_subdivision in |- *; eapply X. -apply H2. -split; assumption. -clear f a b c H0 H H1 H2 l1 lf1; simple induction l1. -intros; unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4; - discriminate. -simple induction r0. -intros X lf1 a b c f H H0; assert (H1 : a = b). -unfold adapted_couple in H; decompose [and] H; clear H; simpl in H3; - simpl in H2; assert (H7 : a <= b). -elim H0; intros; apply Rle_trans with c; assumption. -replace a with (Rmin a b). -pattern b at 2 in |- *; replace b with (Rmax a b). -rewrite <- H2; rewrite H3; reflexivity. -unfold Rmax in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ]. -unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ]. -split with (cons r nil); split with lf1; assert (H2 : c = b). -rewrite H1 in H0; elim H0; intros; apply Rle_antisym; assumption. -rewrite H2; assumption. -intros r1 r2 _ X0 lf1 a b c f H H0; induction lf1 as [| r3 lf1 Hreclf1]. -unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4; - discriminate. -clear Hreclf1; assert (H1 : {c <= r1} + {r1 < c}). -case (Rle_dec c r1); intro; [ left; assumption | right; auto with real ]. -elim H1; intro. -split with (cons r (cons c nil)); split with (cons r3 nil); - unfold adapted_couple in H; decompose [and] H; clear H; - assert (H6 : r = a). -simpl in H4; rewrite H4; unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity - | elim n; elim H0; intros; apply Rle_trans with c; assumption ]. -elim H0; clear H0; intros; unfold adapted_couple in |- *; repeat split. -rewrite H6; unfold ordered_Rlist in |- *; intros; simpl in H8; inversion H8; - [ simpl in |- *; assumption | elim (le_Sn_O _ H10) ]. -simpl in |- *; unfold Rmin in |- *; case (Rle_dec a c); intro; - [ assumption | elim n; assumption ]. -simpl in |- *; unfold Rmax in |- *; case (Rle_dec a c); intro; - [ reflexivity | elim n; assumption ]. -unfold constant_D_eq, open_interval in |- *; intros; simpl in H8; - inversion H8. -simpl in |- *; assert (H10 := H7 0%nat); - assert (H12 : (0 < pred (Rlength (cons r (cons r1 r2))))%nat). -simpl in |- *; apply lt_O_Sn. -apply (H10 H12); unfold open_interval in |- *; simpl in |- *; - rewrite H11 in H9; simpl in H9; elim H9; clear H9; - intros; split; try assumption. -apply Rlt_le_trans with c; assumption. -elim (le_Sn_O _ H11). -cut (adapted_couple f r1 b (cons r1 r2) lf1). -cut (r1 <= c <= b). -intros. -elim (X0 _ _ _ _ _ H3 H2); intros l1' [lf1' H4]; split with (cons r l1'); - split with (cons r3 lf1'); unfold adapted_couple in H, H4; - decompose [and] H; decompose [and] H4; clear H H4 X0; - assert (H14 : a <= b). -elim H0; intros; apply Rle_trans with c; assumption. -assert (H16 : r = a). -simpl in H7; rewrite H7; unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ]. -induction l1' as [| r4 l1' Hrecl1']. -simpl in H13; discriminate. -clear Hrecl1'; unfold adapted_couple in |- *; repeat split. -unfold ordered_Rlist in |- *; intros; simpl in H; induction i as [| i Hreci]. -simpl in |- *; replace r4 with r1. -apply (H5 0%nat). -simpl in |- *; apply lt_O_Sn. -simpl in H12; rewrite H12; unfold Rmin in |- *; case (Rle_dec r1 c); intro; - [ reflexivity | elim n; left; assumption ]. -apply (H9 i); simpl in |- *; apply lt_S_n; assumption. -simpl in |- *; unfold Rmin in |- *; case (Rle_dec a c); intro; - [ assumption | elim n; elim H0; intros; assumption ]. -replace (Rmax a c) with (Rmax r1 c). -rewrite <- H11; reflexivity. -unfold Rmax in |- *; case (Rle_dec r1 c); case (Rle_dec a c); intros; - [ reflexivity - | elim n; elim H0; intros; assumption - | elim n; left; assumption - | elim n0; left; assumption ]. -simpl in |- *; simpl in H13; rewrite H13; reflexivity. -intros; simpl in H; unfold constant_D_eq, open_interval in |- *; intros; - induction i as [| i Hreci]. -simpl in |- *; assert (H17 := H10 0%nat); - assert (H18 : (0 < pred (Rlength (cons r (cons r1 r2))))%nat). -simpl in |- *; apply lt_O_Sn. -apply (H17 H18); unfold open_interval in |- *; simpl in |- *; simpl in H4; - elim H4; clear H4; intros; split; try assumption; - replace r1 with r4. -assumption. -simpl in H12; rewrite H12; unfold Rmin in |- *; case (Rle_dec r1 c); intro; - [ reflexivity | elim n; left; assumption ]. -clear Hreci; simpl in |- *; apply H15. -simpl in |- *; apply lt_S_n; assumption. -unfold open_interval in |- *; apply H4. -split. -left; assumption. -elim H0; intros; assumption. -eapply StepFun_P7; - [ elim H0; intros; apply Rle_trans with c; [ apply H2 | apply H3 ] - | apply H ]. + forall (f:R -> R) (a b c:R), + IsStepFun f a b -> a <= c <= b -> IsStepFun f a c. +Proof. + intros f; intros; assert (H0 : a <= b). + elim H; intros; apply Rle_trans with c; assumption. + elim H; clear H; intros; unfold IsStepFun in X; unfold is_subdivision in X; + elim X; clear X; intros l1 [lf1 H2]; + cut + (forall (l1 lf1:Rlist) (a b c:R) (f:R -> R), + adapted_couple f a b l1 lf1 -> + a <= c <= b -> + sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f a c l l0))). + intro X; unfold IsStepFun in |- *; unfold is_subdivision in |- *; eapply X. + apply H2. + split; assumption. + clear f a b c H0 H H1 H2 l1 lf1; simple induction l1. + intros; unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4; + discriminate. + simple induction r0. + intros X lf1 a b c f H H0; assert (H1 : a = b). + unfold adapted_couple in H; decompose [and] H; clear H; simpl in H3; + simpl in H2; assert (H7 : a <= b). + elim H0; intros; apply Rle_trans with c; assumption. + replace a with (Rmin a b). + pattern b at 2 in |- *; replace b with (Rmax a b). + rewrite <- H2; rewrite H3; reflexivity. + unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. + split with (cons r nil); split with lf1; assert (H2 : c = b). + rewrite H1 in H0; elim H0; intros; apply Rle_antisym; assumption. + rewrite H2; assumption. + intros r1 r2 _ X0 lf1 a b c f H H0; induction lf1 as [| r3 lf1 Hreclf1]. + unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4; + discriminate. + clear Hreclf1; assert (H1 : {c <= r1} + {r1 < c}). + case (Rle_dec c r1); intro; [ left; assumption | right; auto with real ]. + elim H1; intro. + split with (cons r (cons c nil)); split with (cons r3 nil); + unfold adapted_couple in H; decompose [and] H; clear H; + assert (H6 : r = a). + simpl in H4; rewrite H4; unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity + | elim n; elim H0; intros; apply Rle_trans with c; assumption ]. + elim H0; clear H0; intros; unfold adapted_couple in |- *; repeat split. + rewrite H6; unfold ordered_Rlist in |- *; intros; simpl in H8; inversion H8; + [ simpl in |- *; assumption | elim (le_Sn_O _ H10) ]. + simpl in |- *; unfold Rmin in |- *; case (Rle_dec a c); intro; + [ assumption | elim n; assumption ]. + simpl in |- *; unfold Rmax in |- *; case (Rle_dec a c); intro; + [ reflexivity | elim n; assumption ]. + unfold constant_D_eq, open_interval in |- *; intros; simpl in H8; + inversion H8. + simpl in |- *; assert (H10 := H7 0%nat); + assert (H12 : (0 < pred (Rlength (cons r (cons r1 r2))))%nat). + simpl in |- *; apply lt_O_Sn. + apply (H10 H12); unfold open_interval in |- *; simpl in |- *; + rewrite H11 in H9; simpl in H9; elim H9; clear H9; + intros; split; try assumption. + apply Rlt_le_trans with c; assumption. + elim (le_Sn_O _ H11). + cut (adapted_couple f r1 b (cons r1 r2) lf1). + cut (r1 <= c <= b). + intros. + elim (X0 _ _ _ _ _ H3 H2); intros l1' [lf1' H4]; split with (cons r l1'); + split with (cons r3 lf1'); unfold adapted_couple in H, H4; + decompose [and] H; decompose [and] H4; clear H H4 X0; + assert (H14 : a <= b). + elim H0; intros; apply Rle_trans with c; assumption. + assert (H16 : r = a). + simpl in H7; rewrite H7; unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. + induction l1' as [| r4 l1' Hrecl1']. + simpl in H13; discriminate. + clear Hrecl1'; unfold adapted_couple in |- *; repeat split. + unfold ordered_Rlist in |- *; intros; simpl in H; induction i as [| i Hreci]. + simpl in |- *; replace r4 with r1. + apply (H5 0%nat). + simpl in |- *; apply lt_O_Sn. + simpl in H12; rewrite H12; unfold Rmin in |- *; case (Rle_dec r1 c); intro; + [ reflexivity | elim n; left; assumption ]. + apply (H9 i); simpl in |- *; apply lt_S_n; assumption. + simpl in |- *; unfold Rmin in |- *; case (Rle_dec a c); intro; + [ assumption | elim n; elim H0; intros; assumption ]. + replace (Rmax a c) with (Rmax r1 c). + rewrite <- H11; reflexivity. + unfold Rmax in |- *; case (Rle_dec r1 c); case (Rle_dec a c); intros; + [ reflexivity + | elim n; elim H0; intros; assumption + | elim n; left; assumption + | elim n0; left; assumption ]. + simpl in |- *; simpl in H13; rewrite H13; reflexivity. + intros; simpl in H; unfold constant_D_eq, open_interval in |- *; intros; + induction i as [| i Hreci]. + simpl in |- *; assert (H17 := H10 0%nat); + assert (H18 : (0 < pred (Rlength (cons r (cons r1 r2))))%nat). + simpl in |- *; apply lt_O_Sn. + apply (H17 H18); unfold open_interval in |- *; simpl in |- *; simpl in H4; + elim H4; clear H4; intros; split; try assumption; + replace r1 with r4. + assumption. + simpl in H12; rewrite H12; unfold Rmin in |- *; case (Rle_dec r1 c); intro; + [ reflexivity | elim n; left; assumption ]. + clear Hreci; simpl in |- *; apply H15. + simpl in |- *; apply lt_S_n; assumption. + unfold open_interval in |- *; apply H4. + split. + left; assumption. + elim H0; intros; assumption. + eapply StepFun_P7; + [ elim H0; intros; apply Rle_trans with c; [ apply H2 | apply H3 ] + | apply H ]. Qed. Lemma StepFun_P45 : - forall (f:R -> R) (a b c:R), - IsStepFun f a b -> a <= c <= b -> IsStepFun f c b. -intros f; intros; assert (H0 : a <= b). -elim H; intros; apply Rle_trans with c; assumption. -elim H; clear H; intros; unfold IsStepFun in X; unfold is_subdivision in X; - elim X; clear X; intros l1 [lf1 H2]; - cut - (forall (l1 lf1:Rlist) (a b c:R) (f:R -> R), - adapted_couple f a b l1 lf1 -> - a <= c <= b -> - sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f c b l l0))). -intro X; unfold IsStepFun in |- *; unfold is_subdivision in |- *; eapply X; - [ apply H2 | split; assumption ]. -clear f a b c H0 H H1 H2 l1 lf1; simple induction l1. -intros; unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4; - discriminate. -simple induction r0. -intros X lf1 a b c f H H0; assert (H1 : a = b). -unfold adapted_couple in H; decompose [and] H; clear H; simpl in H3; - simpl in H2; assert (H7 : a <= b). -elim H0; intros; apply Rle_trans with c; assumption. -replace a with (Rmin a b). -pattern b at 2 in |- *; replace b with (Rmax a b). -rewrite <- H2; rewrite H3; reflexivity. -unfold Rmax in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ]. -unfold Rmin in |- *; case (Rle_dec a b); intro; - [ reflexivity | elim n; assumption ]. -split with (cons r nil); split with lf1; assert (H2 : c = b). -rewrite H1 in H0; elim H0; intros; apply Rle_antisym; assumption. -rewrite <- H2 in H1; rewrite <- H1; assumption. -intros r1 r2 _ X0 lf1 a b c f H H0; induction lf1 as [| r3 lf1 Hreclf1]. -unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4; - discriminate. -clear Hreclf1; assert (H1 : {c <= r1} + {r1 < c}). -case (Rle_dec c r1); intro; [ left; assumption | right; auto with real ]. -elim H1; intro. -split with (cons c (cons r1 r2)); split with (cons r3 lf1); - unfold adapted_couple in H; decompose [and] H; clear H; - unfold adapted_couple in |- *; repeat split. -unfold ordered_Rlist in |- *; intros; simpl in H; induction i as [| i Hreci]. -simpl in |- *; assumption. -clear Hreci; apply (H2 (S i)); simpl in |- *; assumption. -simpl in |- *; unfold Rmin in |- *; case (Rle_dec c b); intro; - [ reflexivity | elim n; elim H0; intros; assumption ]. -replace (Rmax c b) with (Rmax a b). -rewrite <- H3; reflexivity. -unfold Rmax in |- *; case (Rle_dec a b); case (Rle_dec c b); intros; - [ reflexivity - | elim n; elim H0; intros; assumption - | elim n; elim H0; intros; apply Rle_trans with c; assumption - | elim n0; elim H0; intros; apply Rle_trans with c; assumption ]. -simpl in |- *; simpl in H5; apply H5. -intros; simpl in H; induction i as [| i Hreci]. -unfold constant_D_eq, open_interval in |- *; intros; simpl in |- *; - apply (H7 0%nat). -simpl in |- *; apply lt_O_Sn. -unfold open_interval in |- *; simpl in |- *; simpl in H6; elim H6; clear H6; - intros; split; try assumption; apply Rle_lt_trans with c; - try assumption; replace r with a. -elim H0; intros; assumption. -simpl in H4; rewrite H4; unfold Rmin in |- *; case (Rle_dec a b); intros; - [ reflexivity - | elim n; elim H0; intros; apply Rle_trans with c; assumption ]. -clear Hreci; apply (H7 (S i)); simpl in |- *; assumption. -cut (adapted_couple f r1 b (cons r1 r2) lf1). -cut (r1 <= c <= b). -intros; elim (X0 _ _ _ _ _ H3 H2); intros l1' [lf1' H4]; split with l1'; - split with lf1'; assumption. -split; [ left; assumption | elim H0; intros; assumption ]. -eapply StepFun_P7; - [ elim H0; intros; apply Rle_trans with c; [ apply H2 | apply H3 ] - | apply H ]. + forall (f:R -> R) (a b c:R), + IsStepFun f a b -> a <= c <= b -> IsStepFun f c b. +Proof. + intros f; intros; assert (H0 : a <= b). + elim H; intros; apply Rle_trans with c; assumption. + elim H; clear H; intros; unfold IsStepFun in X; unfold is_subdivision in X; + elim X; clear X; intros l1 [lf1 H2]; + cut + (forall (l1 lf1:Rlist) (a b c:R) (f:R -> R), + adapted_couple f a b l1 lf1 -> + a <= c <= b -> + sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f c b l l0))). + intro X; unfold IsStepFun in |- *; unfold is_subdivision in |- *; eapply X; + [ apply H2 | split; assumption ]. + clear f a b c H0 H H1 H2 l1 lf1; simple induction l1. + intros; unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4; + discriminate. + simple induction r0. + intros X lf1 a b c f H H0; assert (H1 : a = b). + unfold adapted_couple in H; decompose [and] H; clear H; simpl in H3; + simpl in H2; assert (H7 : a <= b). + elim H0; intros; apply Rle_trans with c; assumption. + replace a with (Rmin a b). + pattern b at 2 in |- *; replace b with (Rmax a b). + rewrite <- H2; rewrite H3; reflexivity. + unfold Rmax in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. + unfold Rmin in |- *; case (Rle_dec a b); intro; + [ reflexivity | elim n; assumption ]. + split with (cons r nil); split with lf1; assert (H2 : c = b). + rewrite H1 in H0; elim H0; intros; apply Rle_antisym; assumption. + rewrite <- H2 in H1; rewrite <- H1; assumption. + intros r1 r2 _ X0 lf1 a b c f H H0; induction lf1 as [| r3 lf1 Hreclf1]. + unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4; + discriminate. + clear Hreclf1; assert (H1 : {c <= r1} + {r1 < c}). + case (Rle_dec c r1); intro; [ left; assumption | right; auto with real ]. + elim H1; intro. + split with (cons c (cons r1 r2)); split with (cons r3 lf1); + unfold adapted_couple in H; decompose [and] H; clear H; + unfold adapted_couple in |- *; repeat split. + unfold ordered_Rlist in |- *; intros; simpl in H; induction i as [| i Hreci]. + simpl in |- *; assumption. + clear Hreci; apply (H2 (S i)); simpl in |- *; assumption. + simpl in |- *; unfold Rmin in |- *; case (Rle_dec c b); intro; + [ reflexivity | elim n; elim H0; intros; assumption ]. + replace (Rmax c b) with (Rmax a b). + rewrite <- H3; reflexivity. + unfold Rmax in |- *; case (Rle_dec a b); case (Rle_dec c b); intros; + [ reflexivity + | elim n; elim H0; intros; assumption + | elim n; elim H0; intros; apply Rle_trans with c; assumption + | elim n0; elim H0; intros; apply Rle_trans with c; assumption ]. + simpl in |- *; simpl in H5; apply H5. + intros; simpl in H; induction i as [| i Hreci]. + unfold constant_D_eq, open_interval in |- *; intros; simpl in |- *; + apply (H7 0%nat). + simpl in |- *; apply lt_O_Sn. + unfold open_interval in |- *; simpl in |- *; simpl in H6; elim H6; clear H6; + intros; split; try assumption; apply Rle_lt_trans with c; + try assumption; replace r with a. + elim H0; intros; assumption. + simpl in H4; rewrite H4; unfold Rmin in |- *; case (Rle_dec a b); intros; + [ reflexivity + | elim n; elim H0; intros; apply Rle_trans with c; assumption ]. + clear Hreci; apply (H7 (S i)); simpl in |- *; assumption. + cut (adapted_couple f r1 b (cons r1 r2) lf1). + cut (r1 <= c <= b). + intros; elim (X0 _ _ _ _ _ H3 H2); intros l1' [lf1' H4]; split with l1'; + split with lf1'; assumption. + split; [ left; assumption | elim H0; intros; assumption ]. + eapply StepFun_P7; + [ elim H0; intros; apply Rle_trans with c; [ apply H2 | apply H3 ] + | apply H ]. Qed. Lemma StepFun_P46 : - forall (f:R -> R) (a b c:R), - IsStepFun f a b -> IsStepFun f b c -> IsStepFun f a c. -intros f; intros; case (Rle_dec a b); case (Rle_dec b c); intros. -apply StepFun_P41 with b; assumption. -case (Rle_dec a c); intro. -apply StepFun_P44 with b; try assumption. -split; [ assumption | auto with real ]. -apply StepFun_P6; apply StepFun_P44 with b. -apply StepFun_P6; assumption. -split; auto with real. -case (Rle_dec a c); intro. -apply StepFun_P45 with b; try assumption. -split; auto with real. -apply StepFun_P6; apply StepFun_P45 with b. -apply StepFun_P6; assumption. -split; [ assumption | auto with real ]. -apply StepFun_P6; apply StepFun_P41 with b; - auto with real || apply StepFun_P6; assumption. + forall (f:R -> R) (a b c:R), + IsStepFun f a b -> IsStepFun f b c -> IsStepFun f a c. +Proof. + intros f; intros; case (Rle_dec a b); case (Rle_dec b c); intros. + apply StepFun_P41 with b; assumption. + case (Rle_dec a c); intro. + apply StepFun_P44 with b; try assumption. + split; [ assumption | auto with real ]. + apply StepFun_P6; apply StepFun_P44 with b. + apply StepFun_P6; assumption. + split; auto with real. + case (Rle_dec a c); intro. + apply StepFun_P45 with b; try assumption. + split; auto with real. + apply StepFun_P6; apply StepFun_P45 with b. + apply StepFun_P6; assumption. + split; [ assumption | auto with real ]. + apply StepFun_P6; apply StepFun_P41 with b; + auto with real || apply StepFun_P6; assumption. Qed. diff --git a/theories/Reals/Rlimit.v b/theories/Reals/Rlimit.v index b8d304b1..76579ccb 100644 --- a/theories/Reals/Rlimit.v +++ b/theories/Reals/Rlimit.v @@ -6,10 +6,10 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Rlimit.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Rlimit.v 9245 2006-10-17 12:53:34Z notin $ i*) (*********************************************************) -(* Definition of the limit *) +(** Definition of the limit *) (* *) (*********************************************************) @@ -19,76 +19,82 @@ Require Import Classical_Prop. Require Import Fourier. Open Local Scope R_scope. (*******************************) -(* Calculus *) +(** * Calculus *) (*******************************) (*********) Lemma eps2_Rgt_R0 : forall eps:R, eps > 0 -> eps * / 2 > 0. -intros; fourier. +Proof. + intros; fourier. Qed. (*********) Lemma eps2 : forall eps:R, eps * / 2 + eps * / 2 = eps. -intro esp. -assert (H := double_var esp). -unfold Rdiv in H. -symmetry in |- *; exact H. +Proof. + intro esp. + assert (H := double_var esp). + unfold Rdiv in H. + symmetry in |- *; exact H. Qed. (*********) Lemma eps4 : forall eps:R, eps * / (2 + 2) + eps * / (2 + 2) = eps * / 2. -intro eps. -replace (2 + 2) with 4. -pattern eps at 3 in |- *; rewrite double_var. -rewrite (Rmult_plus_distr_r (eps / 2) (eps / 2) (/ 2)). -unfold Rdiv in |- *. -repeat rewrite Rmult_assoc. -rewrite <- Rinv_mult_distr. -reflexivity. -discrR. -discrR. -ring. +Proof. + intro eps. + replace (2 + 2) with 4. + pattern eps at 3 in |- *; rewrite double_var. + rewrite (Rmult_plus_distr_r (eps / 2) (eps / 2) (/ 2)). + unfold Rdiv in |- *. + repeat rewrite Rmult_assoc. + rewrite <- Rinv_mult_distr. + reflexivity. + discrR. + discrR. + ring. Qed. (*********) Lemma Rlt_eps2_eps : forall eps:R, eps > 0 -> eps * / 2 < eps. -intros. -pattern eps at 2 in |- *; rewrite <- Rmult_1_r. -repeat rewrite (Rmult_comm eps). -apply Rmult_lt_compat_r. -exact H. -apply Rmult_lt_reg_l with 2. -fourier. -rewrite Rmult_1_r; rewrite <- Rinv_r_sym. -fourier. -discrR. +Proof. + intros. + pattern eps at 2 in |- *; rewrite <- Rmult_1_r. + repeat rewrite (Rmult_comm eps). + apply Rmult_lt_compat_r. + exact H. + apply Rmult_lt_reg_l with 2. + fourier. + rewrite Rmult_1_r; rewrite <- Rinv_r_sym. + fourier. + discrR. Qed. (*********) Lemma Rlt_eps4_eps : forall eps:R, eps > 0 -> eps * / (2 + 2) < eps. -intros. -replace (2 + 2) with 4. -pattern eps at 2 in |- *; rewrite <- Rmult_1_r. -repeat rewrite (Rmult_comm eps). -apply Rmult_lt_compat_r. -exact H. -apply Rmult_lt_reg_l with 4. -replace 4 with 4. -apply Rmult_lt_0_compat; fourier. -ring. -rewrite Rmult_1_r; rewrite <- Rinv_r_sym. -fourier. -discrR. -ring. +Proof. + intros. + replace (2 + 2) with 4. + pattern eps at 2 in |- *; rewrite <- Rmult_1_r. + repeat rewrite (Rmult_comm eps). + apply Rmult_lt_compat_r. + exact H. + apply Rmult_lt_reg_l with 4. + replace 4 with 4. + apply Rmult_lt_0_compat; fourier. + ring. + rewrite Rmult_1_r; rewrite <- Rinv_r_sym. + fourier. + discrR. + ring. Qed. (*********) Lemma prop_eps : forall r:R, (forall eps:R, eps > 0 -> r < eps) -> r <= 0. -intros; elim (Rtotal_order r 0); intro. -apply Rlt_le; assumption. -elim H0; intro. -apply Req_le; assumption. -clear H0; generalize (H r H1); intro; generalize (Rlt_irrefl r); intro; - elimtype False; auto. +Proof. + intros; elim (Rtotal_order r 0); intro. + apply Rlt_le; assumption. + elim H0; intro. + apply Req_le; assumption. + clear H0; generalize (H r H1); intro; generalize (Rlt_irrefl r); intro; + elimtype False; auto. Qed. (*********) @@ -96,59 +102,61 @@ Definition mul_factor (l l':R) := / (1 + (Rabs l + Rabs l')). (*********) Lemma mul_factor_wd : forall l l':R, 1 + (Rabs l + Rabs l') <> 0. -intros; rewrite (Rplus_comm 1 (Rabs l + Rabs l')); apply tech_Rplus. -cut (Rabs (l + l') <= Rabs l + Rabs l'). -cut (0 <= Rabs (l + l')). -exact (Rle_trans _ _ _). -exact (Rabs_pos (l + l')). -exact (Rabs_triang _ _). -exact Rlt_0_1. +Proof. + intros; rewrite (Rplus_comm 1 (Rabs l + Rabs l')); apply tech_Rplus. + cut (Rabs (l + l') <= Rabs l + Rabs l'). + cut (0 <= Rabs (l + l')). + exact (Rle_trans _ _ _). + exact (Rabs_pos (l + l')). + exact (Rabs_triang _ _). + exact Rlt_0_1. Qed. (*********) Lemma mul_factor_gt : forall eps l l':R, eps > 0 -> eps * mul_factor l l' > 0. -intros; unfold Rgt in |- *; rewrite <- (Rmult_0_r eps); - apply Rmult_lt_compat_l. -assumption. -unfold mul_factor in |- *; apply Rinv_0_lt_compat; - cut (1 <= 1 + (Rabs l + Rabs l')). -cut (0 < 1). -exact (Rlt_le_trans _ _ _). -exact Rlt_0_1. -replace (1 <= 1 + (Rabs l + Rabs l')) with (1 + 0 <= 1 + (Rabs l + Rabs l')). -apply Rplus_le_compat_l. -cut (Rabs (l + l') <= Rabs l + Rabs l'). -cut (0 <= Rabs (l + l')). -exact (Rle_trans _ _ _). -exact (Rabs_pos _). -exact (Rabs_triang _ _). -rewrite (proj1 (Rplus_ne 1)); trivial. +Proof. + intros; unfold Rgt in |- *; rewrite <- (Rmult_0_r eps); + apply Rmult_lt_compat_l. + assumption. + unfold mul_factor in |- *; apply Rinv_0_lt_compat; + cut (1 <= 1 + (Rabs l + Rabs l')). + cut (0 < 1). + exact (Rlt_le_trans _ _ _). + exact Rlt_0_1. + replace (1 <= 1 + (Rabs l + Rabs l')) with (1 + 0 <= 1 + (Rabs l + Rabs l')). + apply Rplus_le_compat_l. + cut (Rabs (l + l') <= Rabs l + Rabs l'). + cut (0 <= Rabs (l + l')). + exact (Rle_trans _ _ _). + exact (Rabs_pos _). + exact (Rabs_triang _ _). + rewrite (proj1 (Rplus_ne 1)); trivial. Qed. (*********) Lemma mul_factor_gt_f : - forall eps l l':R, eps > 0 -> Rmin 1 (eps * mul_factor l l') > 0. -intros; apply Rmin_Rgt_r; split. -exact Rlt_0_1. -exact (mul_factor_gt eps l l' H). + forall eps l l':R, eps > 0 -> Rmin 1 (eps * mul_factor l l') > 0. + intros; apply Rmin_Rgt_r; split. + exact Rlt_0_1. + exact (mul_factor_gt eps l l' H). Qed. (*******************************) -(* Metric space *) +(** * Metric space *) (*******************************) (*********) Record Metric_Space : Type := {Base : Type; - dist : Base -> Base -> R; - dist_pos : forall x y:Base, dist x y >= 0; - dist_sym : forall x y:Base, dist x y = dist y x; - dist_refl : forall x y:Base, dist x y = 0 <-> x = y; - dist_tri : forall x y z:Base, dist x y <= dist x z + dist z y}. + dist : Base -> Base -> R; + dist_pos : forall x y:Base, dist x y >= 0; + dist_sym : forall x y:Base, dist x y = dist y x; + dist_refl : forall x y:Base, dist x y = 0 <-> x = y; + dist_tri : forall x y z:Base, dist x y <= dist x z + dist z y}. (*******************************) -(* Limit in Metric space *) +(** ** Limit in Metric space *) (*******************************) (*********) @@ -156,12 +164,12 @@ Definition limit_in (X X':Metric_Space) (f:Base X -> Base X') (D:Base X -> Prop) (x0:Base X) (l:Base X') := forall eps:R, eps > 0 -> - exists alp : R, + exists alp : R, alp > 0 /\ (forall x:Base X, D x /\ dist X x x0 < alp -> dist X' (f x) l < eps). (*******************************) -(* R is a metric space *) +(** ** R is a metric space *) (*******************************) (*********) @@ -169,7 +177,7 @@ Definition R_met : Metric_Space := Build_Metric_Space R R_dist R_dist_pos R_dist_sym R_dist_refl R_dist_tri. (*******************************) -(* Limit 1 arg *) +(** * Limit 1 arg *) (*******************************) (*********) Definition Dgf (Df Dg:R -> Prop) (f:R -> R) (x:R) := Df x /\ Dg (f x). @@ -180,145 +188,153 @@ Definition limit1_in (f:R -> R) (D:R -> Prop) (l x0:R) : Prop := (*********) Lemma tech_limit : - forall (f:R -> R) (D:R -> Prop) (l x0:R), - D x0 -> limit1_in f D l x0 -> l = f x0. -intros f D l x0 H H0. -case (Rabs_pos (f x0 - l)); intros H1. -absurd (dist R_met (f x0) l < dist R_met (f x0) l). -apply Rlt_irrefl. -case (H0 (dist R_met (f x0) l)); auto. -intros alpha1 [H2 H3]; apply H3; auto; split; auto. -case (dist_refl R_met x0 x0); intros Hr1 Hr2; rewrite Hr2; auto. -case (dist_refl R_met (f x0) l); intros Hr1 Hr2; apply sym_eq; auto. + forall (f:R -> R) (D:R -> Prop) (l x0:R), + D x0 -> limit1_in f D l x0 -> l = f x0. +Proof. + intros f D l x0 H H0. + case (Rabs_pos (f x0 - l)); intros H1. + absurd (dist R_met (f x0) l < dist R_met (f x0) l). + apply Rlt_irrefl. + case (H0 (dist R_met (f x0) l)); auto. + intros alpha1 [H2 H3]; apply H3; auto; split; auto. + case (dist_refl R_met x0 x0); intros Hr1 Hr2; rewrite Hr2; auto. + case (dist_refl R_met (f x0) l); intros Hr1 Hr2; apply sym_eq; auto. Qed. (*********) Lemma tech_limit_contr : - forall (f:R -> R) (D:R -> Prop) (l x0:R), - D x0 -> l <> f x0 -> ~ limit1_in f D l x0. -intros; generalize (tech_limit f D l x0); tauto. + forall (f:R -> R) (D:R -> Prop) (l x0:R), + D x0 -> l <> f x0 -> ~ limit1_in f D l x0. +Proof. + intros; generalize (tech_limit f D l x0); tauto. Qed. (*********) Lemma lim_x : forall (D:R -> Prop) (x0:R), limit1_in (fun x:R => x) D x0 x0. -unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros; - split with eps; split; auto; intros; elim H0; intros; - auto. +Proof. + unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros; + split with eps; split; auto; intros; elim H0; intros; + auto. Qed. (*********) Lemma limit_plus : - forall (f g:R -> R) (D:R -> Prop) (l l' x0:R), - limit1_in f D l x0 -> - limit1_in g D l' x0 -> limit1_in (fun x:R => f x + g x) D (l + l') x0. -intros; unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; - intros; elim (H (eps * / 2) (eps2_Rgt_R0 eps H1)); - elim (H0 (eps * / 2) (eps2_Rgt_R0 eps H1)); simpl in |- *; - clear H H0; intros; elim H; elim H0; clear H H0; intros; - split with (Rmin x1 x); split. -exact (Rmin_Rgt_r x1 x 0 (conj H H2)). -intros; elim H4; clear H4; intros; - cut (R_dist (f x2) l + R_dist (g x2) l' < eps). - cut (R_dist (f x2 + g x2) (l + l') <= R_dist (f x2) l + R_dist (g x2) l'). -exact (Rle_lt_trans _ _ _). -exact (R_dist_plus _ _ _ _). -elim (Rmin_Rgt_l x1 x (R_dist x2 x0) H5); clear H5; intros. -generalize (H3 x2 (conj H4 H6)); generalize (H0 x2 (conj H4 H5)); intros; - replace eps with (eps * / 2 + eps * / 2). -exact (Rplus_lt_compat _ _ _ _ H7 H8). -exact (eps2 eps). + forall (f g:R -> R) (D:R -> Prop) (l l' x0:R), + limit1_in f D l x0 -> + limit1_in g D l' x0 -> limit1_in (fun x:R => f x + g x) D (l + l') x0. +Proof. + intros; unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; + intros; elim (H (eps * / 2) (eps2_Rgt_R0 eps H1)); + elim (H0 (eps * / 2) (eps2_Rgt_R0 eps H1)); simpl in |- *; + clear H H0; intros; elim H; elim H0; clear H H0; intros; + split with (Rmin x1 x); split. + exact (Rmin_Rgt_r x1 x 0 (conj H H2)). + intros; elim H4; clear H4; intros; + cut (R_dist (f x2) l + R_dist (g x2) l' < eps). + cut (R_dist (f x2 + g x2) (l + l') <= R_dist (f x2) l + R_dist (g x2) l'). + exact (Rle_lt_trans _ _ _). + exact (R_dist_plus _ _ _ _). + elim (Rmin_Rgt_l x1 x (R_dist x2 x0) H5); clear H5; intros. + generalize (H3 x2 (conj H4 H6)); generalize (H0 x2 (conj H4 H5)); intros; + replace eps with (eps * / 2 + eps * / 2). + exact (Rplus_lt_compat _ _ _ _ H7 H8). + exact (eps2 eps). Qed. (*********) Lemma limit_Ropp : - forall (f:R -> R) (D:R -> Prop) (l x0:R), - limit1_in f D l x0 -> limit1_in (fun x:R => - f x) D (- l) x0. -unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros; - elim (H eps H0); clear H; intros; elim H; clear H; - intros; split with x; split; auto; intros; generalize (H1 x1 H2); - clear H1; intro; unfold R_dist in |- *; unfold Rminus in |- *; - rewrite (Ropp_involutive l); rewrite (Rplus_comm (- f x1) l); - fold (l - f x1) in |- *; fold (R_dist l (f x1)) in |- *; - rewrite R_dist_sym; assumption. + forall (f:R -> R) (D:R -> Prop) (l x0:R), + limit1_in f D l x0 -> limit1_in (fun x:R => - f x) D (- l) x0. +Proof. + unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros; + elim (H eps H0); clear H; intros; elim H; clear H; + intros; split with x; split; auto; intros; generalize (H1 x1 H2); + clear H1; intro; unfold R_dist in |- *; unfold Rminus in |- *; + rewrite (Ropp_involutive l); rewrite (Rplus_comm (- f x1) l); + fold (l - f x1) in |- *; fold (R_dist l (f x1)) in |- *; + rewrite R_dist_sym; assumption. Qed. (*********) Lemma limit_minus : - forall (f g:R -> R) (D:R -> Prop) (l l' x0:R), - limit1_in f D l x0 -> - limit1_in g D l' x0 -> limit1_in (fun x:R => f x - g x) D (l - l') x0. -intros; unfold Rminus in |- *; generalize (limit_Ropp g D l' x0 H0); intro; - exact (limit_plus f (fun x:R => - g x) D l (- l') x0 H H1). + forall (f g:R -> R) (D:R -> Prop) (l l' x0:R), + limit1_in f D l x0 -> + limit1_in g D l' x0 -> limit1_in (fun x:R => f x - g x) D (l - l') x0. +Proof. + intros; unfold Rminus in |- *; generalize (limit_Ropp g D l' x0 H0); intro; + exact (limit_plus f (fun x:R => - g x) D l (- l') x0 H H1). Qed. (*********) Lemma limit_free : - forall (f:R -> R) (D:R -> Prop) (x x0:R), - limit1_in (fun h:R => f x) D (f x) x0. -unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros; - split with eps; split; auto; intros; elim (R_dist_refl (f x) (f x)); - intros a b; rewrite (b (refl_equal (f x))); unfold Rgt in H; - assumption. + forall (f:R -> R) (D:R -> Prop) (x x0:R), + limit1_in (fun h:R => f x) D (f x) x0. +Proof. + unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros; + split with eps; split; auto; intros; elim (R_dist_refl (f x) (f x)); + intros a b; rewrite (b (refl_equal (f x))); unfold Rgt in H; + assumption. Qed. (*********) Lemma limit_mul : - forall (f g:R -> R) (D:R -> Prop) (l l' x0:R), - limit1_in f D l x0 -> - limit1_in g D l' x0 -> limit1_in (fun x:R => f x * g x) D (l * l') x0. -intros; unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; - intros; - elim (H (Rmin 1 (eps * mul_factor l l')) (mul_factor_gt_f eps l l' H1)); - elim (H0 (eps * mul_factor l l') (mul_factor_gt eps l l' H1)); - clear H H0; simpl in |- *; intros; elim H; elim H0; - clear H H0; intros; split with (Rmin x1 x); split. -exact (Rmin_Rgt_r x1 x 0 (conj H H2)). -intros; elim H4; clear H4; intros; unfold R_dist in |- *; - replace (f x2 * g x2 - l * l') with (f x2 * (g x2 - l') + l' * (f x2 - l)). -cut (Rabs (f x2 * (g x2 - l')) + Rabs (l' * (f x2 - l)) < eps). -cut - (Rabs (f x2 * (g x2 - l') + l' * (f x2 - l)) <= - Rabs (f x2 * (g x2 - l')) + Rabs (l' * (f x2 - l))). -exact (Rle_lt_trans _ _ _). -exact (Rabs_triang _ _). -rewrite (Rabs_mult (f x2) (g x2 - l')); rewrite (Rabs_mult l' (f x2 - l)); - cut - ((1 + Rabs l) * (eps * mul_factor l l') + Rabs l' * (eps * mul_factor l l') <= - eps). -cut - (Rabs (f x2) * Rabs (g x2 - l') + Rabs l' * Rabs (f x2 - l) < - (1 + Rabs l) * (eps * mul_factor l l') + Rabs l' * (eps * mul_factor l l')). -exact (Rlt_le_trans _ _ _). -elim (Rmin_Rgt_l x1 x (R_dist x2 x0) H5); clear H5; intros; - generalize (H0 x2 (conj H4 H5)); intro; generalize (Rmin_Rgt_l _ _ _ H7); - intro; elim H8; intros; clear H0 H8; apply Rplus_lt_le_compat. -apply Rmult_ge_0_gt_0_lt_compat. -apply Rle_ge. -exact (Rabs_pos (g x2 - l')). -rewrite (Rplus_comm 1 (Rabs l)); unfold Rgt in |- *; apply Rle_lt_0_plus_1; - exact (Rabs_pos l). -unfold R_dist in H9; - apply (Rplus_lt_reg_r (- Rabs l) (Rabs (f x2)) (1 + Rabs l)). -rewrite <- (Rplus_assoc (- Rabs l) 1 (Rabs l)); - rewrite (Rplus_comm (- Rabs l) 1); - rewrite (Rplus_assoc 1 (- Rabs l) (Rabs l)); rewrite (Rplus_opp_l (Rabs l)); - rewrite (proj1 (Rplus_ne 1)); rewrite (Rplus_comm (- Rabs l) (Rabs (f x2))); - generalize H9; cut (Rabs (f x2) - Rabs l <= Rabs (f x2 - l)). -exact (Rle_lt_trans _ _ _). -exact (Rabs_triang_inv _ _). -generalize (H3 x2 (conj H4 H6)); trivial. -apply Rmult_le_compat_l. -exact (Rabs_pos l'). -unfold Rle in |- *; left; assumption. -rewrite (Rmult_comm (1 + Rabs l) (eps * mul_factor l l')); - rewrite (Rmult_comm (Rabs l') (eps * mul_factor l l')); - rewrite <- - (Rmult_plus_distr_l (eps * mul_factor l l') (1 + Rabs l) (Rabs l')) - ; rewrite (Rmult_assoc eps (mul_factor l l') (1 + Rabs l + Rabs l')); - rewrite (Rplus_assoc 1 (Rabs l) (Rabs l')); unfold mul_factor in |- *; - rewrite (Rinv_l (1 + (Rabs l + Rabs l')) (mul_factor_wd l l')); - rewrite (proj1 (Rmult_ne eps)); apply Req_le; trivial. -ring. + forall (f g:R -> R) (D:R -> Prop) (l l' x0:R), + limit1_in f D l x0 -> + limit1_in g D l' x0 -> limit1_in (fun x:R => f x * g x) D (l * l') x0. +Proof. + intros; unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; + intros; + elim (H (Rmin 1 (eps * mul_factor l l')) (mul_factor_gt_f eps l l' H1)); + elim (H0 (eps * mul_factor l l') (mul_factor_gt eps l l' H1)); + clear H H0; simpl in |- *; intros; elim H; elim H0; + clear H H0; intros; split with (Rmin x1 x); split. + exact (Rmin_Rgt_r x1 x 0 (conj H H2)). + intros; elim H4; clear H4; intros; unfold R_dist in |- *; + replace (f x2 * g x2 - l * l') with (f x2 * (g x2 - l') + l' * (f x2 - l)). + cut (Rabs (f x2 * (g x2 - l')) + Rabs (l' * (f x2 - l)) < eps). + cut + (Rabs (f x2 * (g x2 - l') + l' * (f x2 - l)) <= + Rabs (f x2 * (g x2 - l')) + Rabs (l' * (f x2 - l))). + exact (Rle_lt_trans _ _ _). + exact (Rabs_triang _ _). + rewrite (Rabs_mult (f x2) (g x2 - l')); rewrite (Rabs_mult l' (f x2 - l)); + cut + ((1 + Rabs l) * (eps * mul_factor l l') + Rabs l' * (eps * mul_factor l l') <= + eps). + cut + (Rabs (f x2) * Rabs (g x2 - l') + Rabs l' * Rabs (f x2 - l) < + (1 + Rabs l) * (eps * mul_factor l l') + Rabs l' * (eps * mul_factor l l')). + exact (Rlt_le_trans _ _ _). + elim (Rmin_Rgt_l x1 x (R_dist x2 x0) H5); clear H5; intros; + generalize (H0 x2 (conj H4 H5)); intro; generalize (Rmin_Rgt_l _ _ _ H7); + intro; elim H8; intros; clear H0 H8; apply Rplus_lt_le_compat. + apply Rmult_ge_0_gt_0_lt_compat. + apply Rle_ge. + exact (Rabs_pos (g x2 - l')). + rewrite (Rplus_comm 1 (Rabs l)); unfold Rgt in |- *; apply Rle_lt_0_plus_1; + exact (Rabs_pos l). + unfold R_dist in H9; + apply (Rplus_lt_reg_r (- Rabs l) (Rabs (f x2)) (1 + Rabs l)). + rewrite <- (Rplus_assoc (- Rabs l) 1 (Rabs l)); + rewrite (Rplus_comm (- Rabs l) 1); + rewrite (Rplus_assoc 1 (- Rabs l) (Rabs l)); rewrite (Rplus_opp_l (Rabs l)); + rewrite (proj1 (Rplus_ne 1)); rewrite (Rplus_comm (- Rabs l) (Rabs (f x2))); + generalize H9; cut (Rabs (f x2) - Rabs l <= Rabs (f x2 - l)). + exact (Rle_lt_trans _ _ _). + exact (Rabs_triang_inv _ _). + generalize (H3 x2 (conj H4 H6)); trivial. + apply Rmult_le_compat_l. + exact (Rabs_pos l'). + unfold Rle in |- *; left; assumption. + rewrite (Rmult_comm (1 + Rabs l) (eps * mul_factor l l')); + rewrite (Rmult_comm (Rabs l') (eps * mul_factor l l')); + rewrite <- + (Rmult_plus_distr_l (eps * mul_factor l l') (1 + Rabs l) (Rabs l')) + ; rewrite (Rmult_assoc eps (mul_factor l l') (1 + Rabs l + Rabs l')); + rewrite (Rplus_assoc 1 (Rabs l) (Rabs l')); unfold mul_factor in |- *; + rewrite (Rinv_l (1 + (Rabs l + Rabs l')) (mul_factor_wd l l')); + rewrite (proj1 (Rmult_ne eps)); apply Req_le; trivial. + ring. Qed. (*********) @@ -327,231 +343,234 @@ Definition adhDa (D:R -> Prop) (a:R) : Prop := (*********) Lemma single_limit : - forall (f:R -> R) (D:R -> Prop) (l l' x0:R), - adhDa D x0 -> limit1_in f D l x0 -> limit1_in f D l' x0 -> l = l'. -unfold limit1_in in |- *; unfold limit_in in |- *; intros. -cut (forall eps:R, eps > 0 -> dist R_met l l' < 2 * eps). -clear H0 H1; unfold dist in |- *; unfold R_met in |- *; unfold R_dist in |- *; - unfold Rabs in |- *; case (Rcase_abs (l - l')); intros. -cut (forall eps:R, eps > 0 -> - (l - l') < eps). -intro; generalize (prop_eps (- (l - l')) H1); intro; - generalize (Ropp_gt_lt_0_contravar (l - l') r); intro; - unfold Rgt in H3; generalize (Rgt_not_le (- (l - l')) 0 H3); - intro; elimtype False; auto. -intros; cut (eps * / 2 > 0). -intro; generalize (H0 (eps * / 2) H2); rewrite (Rmult_comm eps (/ 2)); - rewrite <- (Rmult_assoc 2 (/ 2) eps); rewrite (Rinv_r 2). -elim (Rmult_ne eps); intros a b; rewrite b; clear a b; trivial. -apply (Rlt_dichotomy_converse 2 0); right; generalize Rlt_0_1; intro; - unfold Rgt in |- *; generalize (Rplus_lt_compat_l 1 0 1 H3); - intro; elim (Rplus_ne 1); intros a b; rewrite a in H4; - clear a b; apply (Rlt_trans 0 1 2 H3 H4). -unfold Rgt in |- *; unfold Rgt in H1; rewrite (Rmult_comm eps (/ 2)); - rewrite <- (Rmult_0_r (/ 2)); apply (Rmult_lt_compat_l (/ 2) 0 eps); - auto. -apply (Rinv_0_lt_compat 2); cut (1 < 2). -intro; apply (Rlt_trans 0 1 2 Rlt_0_1 H2). -generalize (Rplus_lt_compat_l 1 0 1 Rlt_0_1); elim (Rplus_ne 1); intros a b; - rewrite a; clear a b; trivial. + forall (f:R -> R) (D:R -> Prop) (l l' x0:R), + adhDa D x0 -> limit1_in f D l x0 -> limit1_in f D l' x0 -> l = l'. +Proof. + unfold limit1_in in |- *; unfold limit_in in |- *; intros. + cut (forall eps:R, eps > 0 -> dist R_met l l' < 2 * eps). + clear H0 H1; unfold dist in |- *; unfold R_met in |- *; unfold R_dist in |- *; + unfold Rabs in |- *; case (Rcase_abs (l - l')); intros. + cut (forall eps:R, eps > 0 -> - (l - l') < eps). + intro; generalize (prop_eps (- (l - l')) H1); intro; + generalize (Ropp_gt_lt_0_contravar (l - l') r); intro; + unfold Rgt in H3; generalize (Rgt_not_le (- (l - l')) 0 H3); + intro; elimtype False; auto. + intros; cut (eps * / 2 > 0). + intro; generalize (H0 (eps * / 2) H2); rewrite (Rmult_comm eps (/ 2)); + rewrite <- (Rmult_assoc 2 (/ 2) eps); rewrite (Rinv_r 2). + elim (Rmult_ne eps); intros a b; rewrite b; clear a b; trivial. + apply (Rlt_dichotomy_converse 2 0); right; generalize Rlt_0_1; intro; + unfold Rgt in |- *; generalize (Rplus_lt_compat_l 1 0 1 H3); + intro; elim (Rplus_ne 1); intros a b; rewrite a in H4; + clear a b; apply (Rlt_trans 0 1 2 H3 H4). + unfold Rgt in |- *; unfold Rgt in H1; rewrite (Rmult_comm eps (/ 2)); + rewrite <- (Rmult_0_r (/ 2)); apply (Rmult_lt_compat_l (/ 2) 0 eps); + auto. + apply (Rinv_0_lt_compat 2); cut (1 < 2). + intro; apply (Rlt_trans 0 1 2 Rlt_0_1 H2). + generalize (Rplus_lt_compat_l 1 0 1 Rlt_0_1); elim (Rplus_ne 1); intros a b; + rewrite a; clear a b; trivial. (**) -cut (forall eps:R, eps > 0 -> l - l' < eps). -intro; generalize (prop_eps (l - l') H1); intro; elim (Rle_le_eq (l - l') 0); - intros a b; clear b; apply (Rminus_diag_uniq l l'); - apply a; split. -assumption. -apply (Rge_le (l - l') 0 r). -intros; cut (eps * / 2 > 0). -intro; generalize (H0 (eps * / 2) H2); rewrite (Rmult_comm eps (/ 2)); - rewrite <- (Rmult_assoc 2 (/ 2) eps); rewrite (Rinv_r 2). -elim (Rmult_ne eps); intros a b; rewrite b; clear a b; trivial. -apply (Rlt_dichotomy_converse 2 0); right; generalize Rlt_0_1; intro; - unfold Rgt in |- *; generalize (Rplus_lt_compat_l 1 0 1 H3); - intro; elim (Rplus_ne 1); intros a b; rewrite a in H4; - clear a b; apply (Rlt_trans 0 1 2 H3 H4). -unfold Rgt in |- *; unfold Rgt in H1; rewrite (Rmult_comm eps (/ 2)); - rewrite <- (Rmult_0_r (/ 2)); apply (Rmult_lt_compat_l (/ 2) 0 eps); - auto. -apply (Rinv_0_lt_compat 2); cut (1 < 2). -intro; apply (Rlt_trans 0 1 2 Rlt_0_1 H2). -generalize (Rplus_lt_compat_l 1 0 1 Rlt_0_1); elim (Rplus_ne 1); intros a b; - rewrite a; clear a b; trivial. + cut (forall eps:R, eps > 0 -> l - l' < eps). + intro; generalize (prop_eps (l - l') H1); intro; elim (Rle_le_eq (l - l') 0); + intros a b; clear b; apply (Rminus_diag_uniq l l'); + apply a; split. + assumption. + apply (Rge_le (l - l') 0 r). + intros; cut (eps * / 2 > 0). + intro; generalize (H0 (eps * / 2) H2); rewrite (Rmult_comm eps (/ 2)); + rewrite <- (Rmult_assoc 2 (/ 2) eps); rewrite (Rinv_r 2). + elim (Rmult_ne eps); intros a b; rewrite b; clear a b; trivial. + apply (Rlt_dichotomy_converse 2 0); right; generalize Rlt_0_1; intro; + unfold Rgt in |- *; generalize (Rplus_lt_compat_l 1 0 1 H3); + intro; elim (Rplus_ne 1); intros a b; rewrite a in H4; + clear a b; apply (Rlt_trans 0 1 2 H3 H4). + unfold Rgt in |- *; unfold Rgt in H1; rewrite (Rmult_comm eps (/ 2)); + rewrite <- (Rmult_0_r (/ 2)); apply (Rmult_lt_compat_l (/ 2) 0 eps); + auto. + apply (Rinv_0_lt_compat 2); cut (1 < 2). + intro; apply (Rlt_trans 0 1 2 Rlt_0_1 H2). + generalize (Rplus_lt_compat_l 1 0 1 Rlt_0_1); elim (Rplus_ne 1); intros a b; + rewrite a; clear a b; trivial. (**) -intros; unfold adhDa in H; elim (H0 eps H2); intros; elim (H1 eps H2); intros; - clear H0 H1; elim H3; elim H4; clear H3 H4; intros; - simpl in |- *; simpl in H1, H4; generalize (Rmin_Rgt x x1 0); - intro; elim H5; intros; clear H5; elim (H (Rmin x x1) (H7 (conj H3 H0))); - intros; elim H5; intros; clear H5 H H6 H7; - generalize (Rmin_Rgt x x1 (R_dist x2 x0)); intro; - elim H; intros; clear H H6; unfold Rgt in H5; elim (H5 H9); - intros; clear H5 H9; generalize (H1 x2 (conj H8 H6)); - generalize (H4 x2 (conj H8 H)); clear H8 H H6 H1 H4 H0 H3; - intros; - generalize - (Rplus_lt_compat (R_dist (f x2) l) eps (R_dist (f x2) l') eps H H0); - unfold R_dist in |- *; intros; rewrite (Rabs_minus_sym (f x2) l) in H1; - rewrite (Rmult_comm 2 eps); rewrite (Rmult_plus_distr_l eps 1 1); - elim (Rmult_ne eps); intros a b; rewrite a; clear a b; - generalize (R_dist_tri l l' (f x2)); unfold R_dist in |- *; - intros; - apply - (Rle_lt_trans (Rabs (l - l')) (Rabs (l - f x2) + Rabs (f x2 - l')) - (eps + eps) H3 H1). + intros; unfold adhDa in H; elim (H0 eps H2); intros; elim (H1 eps H2); intros; + clear H0 H1; elim H3; elim H4; clear H3 H4; intros; + simpl in |- *; simpl in H1, H4; generalize (Rmin_Rgt x x1 0); + intro; elim H5; intros; clear H5; elim (H (Rmin x x1) (H7 (conj H3 H0))); + intros; elim H5; intros; clear H5 H H6 H7; + generalize (Rmin_Rgt x x1 (R_dist x2 x0)); intro; + elim H; intros; clear H H6; unfold Rgt in H5; elim (H5 H9); + intros; clear H5 H9; generalize (H1 x2 (conj H8 H6)); + generalize (H4 x2 (conj H8 H)); clear H8 H H6 H1 H4 H0 H3; + intros; + generalize + (Rplus_lt_compat (R_dist (f x2) l) eps (R_dist (f x2) l') eps H H0); + unfold R_dist in |- *; intros; rewrite (Rabs_minus_sym (f x2) l) in H1; + rewrite (Rmult_comm 2 eps); rewrite (Rmult_plus_distr_l eps 1 1); + elim (Rmult_ne eps); intros a b; rewrite a; clear a b; + generalize (R_dist_tri l l' (f x2)); unfold R_dist in |- *; + intros; + apply + (Rle_lt_trans (Rabs (l - l')) (Rabs (l - f x2) + Rabs (f x2 - l')) + (eps + eps) H3 H1). Qed. (*********) Lemma limit_comp : - forall (f g:R -> R) (Df Dg:R -> Prop) (l l' x0:R), - limit1_in f Df l x0 -> - limit1_in g Dg l' l -> limit1_in (fun x:R => g (f x)) (Dgf Df Dg f) l' x0. -unfold limit1_in, limit_in, Dgf in |- *; simpl in |- *. -intros f g Df Dg l l' x0 Hf Hg eps eps_pos. -elim (Hg eps eps_pos). -intros alpg lg. -elim (Hf alpg). -2: tauto. -intros alpf lf. -exists alpf. -intuition. + forall (f g:R -> R) (Df Dg:R -> Prop) (l l' x0:R), + limit1_in f Df l x0 -> + limit1_in g Dg l' l -> limit1_in (fun x:R => g (f x)) (Dgf Df Dg f) l' x0. +Proof. + unfold limit1_in, limit_in, Dgf in |- *; simpl in |- *. + intros f g Df Dg l l' x0 Hf Hg eps eps_pos. + elim (Hg eps eps_pos). + intros alpg lg. + elim (Hf alpg). + 2: tauto. + intros alpf lf. + exists alpf. + intuition. Qed. (*********) Lemma limit_inv : - forall (f:R -> R) (D:R -> Prop) (l x0:R), - limit1_in f D l x0 -> l <> 0 -> limit1_in (fun x:R => / f x) D (/ l) x0. -unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; - unfold R_dist in |- *; intros; elim (H (Rabs l / 2)). -intros delta1 H2; elim (H (eps * (Rsqr l / 2))). -intros delta2 H3; elim H2; elim H3; intros; exists (Rmin delta1 delta2); - split. -unfold Rmin in |- *; case (Rle_dec delta1 delta2); intro; assumption. -intro; generalize (H5 x); clear H5; intro H5; generalize (H7 x); clear H7; - intro H7; intro H10; elim H10; intros; cut (D x /\ Rabs (x - x0) < delta1). -cut (D x /\ Rabs (x - x0) < delta2). -intros; generalize (H5 H11); clear H5; intro H5; generalize (H7 H12); - clear H7; intro H7; generalize (Rabs_triang_inv l (f x)); - intro; rewrite Rabs_minus_sym in H7; - generalize - (Rle_lt_trans (Rabs l - Rabs (f x)) (Rabs (l - f x)) (Rabs l / 2) H13 H7); - intro; - generalize - (Rplus_lt_compat_l (Rabs (f x) - Rabs l / 2) (Rabs l - Rabs (f x)) - (Rabs l / 2) H14); - replace (Rabs (f x) - Rabs l / 2 + (Rabs l - Rabs (f x))) with (Rabs l / 2). -unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l; - rewrite Rplus_0_r; intro; cut (f x <> 0). -intro; replace (/ f x + - / l) with ((l - f x) * / (l * f x)). -rewrite Rabs_mult; rewrite Rabs_Rinv. -cut (/ Rabs (l * f x) < 2 / Rsqr l). -intro; rewrite Rabs_minus_sym in H5; cut (0 <= / Rabs (l * f x)). -intro; - generalize - (Rmult_le_0_lt_compat (Rabs (l - f x)) (eps * (Rsqr l / 2)) - (/ Rabs (l * f x)) (2 / Rsqr l) (Rabs_pos (l - f x)) H18 H5 H17); - replace (eps * (Rsqr l / 2) * (2 / Rsqr l)) with eps. -intro; assumption. -unfold Rdiv in |- *; unfold Rsqr in |- *; rewrite Rinv_mult_distr. -repeat rewrite Rmult_assoc. -rewrite (Rmult_comm l). -repeat rewrite Rmult_assoc. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_r. -rewrite (Rmult_comm l). -repeat rewrite Rmult_assoc. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_r. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_r; reflexivity. -discrR. -exact H0. -exact H0. -exact H0. -exact H0. -left; apply Rinv_0_lt_compat; apply Rabs_pos_lt; apply prod_neq_R0; - assumption. -rewrite Rmult_comm; rewrite Rabs_mult; rewrite Rinv_mult_distr. -rewrite (Rsqr_abs l); unfold Rsqr in |- *; unfold Rdiv in |- *; - rewrite Rinv_mult_distr. -repeat rewrite <- Rmult_assoc; apply Rmult_lt_compat_r. -apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. -apply Rmult_lt_reg_l with (Rabs (f x) * Rabs l * / 2). -repeat apply Rmult_lt_0_compat. -apply Rabs_pos_lt; assumption. -apply Rabs_pos_lt; assumption. -apply Rinv_0_lt_compat; cut (0%nat <> 2%nat); - [ intro H17; generalize (lt_INR_0 2 (neq_O_lt 2 H17)); unfold INR in |- *; - intro H18; assumption - | discriminate ]. -replace (Rabs (f x) * Rabs l * / 2 * / Rabs (f x)) with (Rabs l / 2). -replace (Rabs (f x) * Rabs l * / 2 * (2 * / Rabs l)) with (Rabs (f x)). -assumption. -repeat rewrite Rmult_assoc. -rewrite (Rmult_comm (Rabs l)). -repeat rewrite Rmult_assoc. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_r. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_r; reflexivity. -discrR. -apply Rabs_no_R0. -assumption. -unfold Rdiv in |- *. -repeat rewrite Rmult_assoc. -rewrite (Rmult_comm (Rabs (f x))). -repeat rewrite Rmult_assoc. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_r. -reflexivity. -apply Rabs_no_R0; assumption. -apply Rabs_no_R0; assumption. -apply Rabs_no_R0; assumption. -apply Rabs_no_R0; assumption. -apply Rabs_no_R0; assumption. -apply prod_neq_R0; assumption. -rewrite (Rinv_mult_distr _ _ H0 H16). -unfold Rminus in |- *; rewrite Rmult_plus_distr_r. -rewrite <- Rmult_assoc. -rewrite <- Rinv_r_sym. -rewrite Rmult_1_l. -rewrite Ropp_mult_distr_l_reverse. -rewrite (Rmult_comm (f x)). -rewrite Rmult_assoc. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_r. -reflexivity. -assumption. -assumption. -red in |- *; intro; rewrite H16 in H15; rewrite Rabs_R0 in H15; - cut (0 < Rabs l / 2). -intro; elim (Rlt_irrefl 0 (Rlt_trans 0 (Rabs l / 2) 0 H17 H15)). -unfold Rdiv in |- *; apply Rmult_lt_0_compat. -apply Rabs_pos_lt; assumption. -apply Rinv_0_lt_compat; cut (0%nat <> 2%nat); - [ intro H17; generalize (lt_INR_0 2 (neq_O_lt 2 H17)); unfold INR in |- *; - intro; assumption - | discriminate ]. -pattern (Rabs l) at 3 in |- *; rewrite double_var. -ring. -split; - [ assumption - | apply Rlt_le_trans with (Rmin delta1 delta2); - [ assumption | apply Rmin_r ] ]. -split; - [ assumption - | apply Rlt_le_trans with (Rmin delta1 delta2); - [ assumption | apply Rmin_l ] ]. -change (0 < eps * (Rsqr l / 2)) in |- *; unfold Rdiv in |- *; - repeat rewrite Rmult_assoc; repeat apply Rmult_lt_0_compat. -assumption. -apply Rsqr_pos_lt; assumption. -apply Rinv_0_lt_compat; cut (0%nat <> 2%nat); - [ intro H3; generalize (lt_INR_0 2 (neq_O_lt 2 H3)); unfold INR in |- *; - intro; assumption - | discriminate ]. -change (0 < Rabs l / 2) in |- *; unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ apply Rabs_pos_lt; assumption - | apply Rinv_0_lt_compat; cut (0%nat <> 2%nat); + forall (f:R -> R) (D:R -> Prop) (l x0:R), + limit1_in f D l x0 -> l <> 0 -> limit1_in (fun x:R => / f x) D (/ l) x0. +Proof. + unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; + unfold R_dist in |- *; intros; elim (H (Rabs l / 2)). + intros delta1 H2; elim (H (eps * (Rsqr l / 2))). + intros delta2 H3; elim H2; elim H3; intros; exists (Rmin delta1 delta2); + split. + unfold Rmin in |- *; case (Rle_dec delta1 delta2); intro; assumption. + intro; generalize (H5 x); clear H5; intro H5; generalize (H7 x); clear H7; + intro H7; intro H10; elim H10; intros; cut (D x /\ Rabs (x - x0) < delta1). + cut (D x /\ Rabs (x - x0) < delta2). + intros; generalize (H5 H11); clear H5; intro H5; generalize (H7 H12); + clear H7; intro H7; generalize (Rabs_triang_inv l (f x)); + intro; rewrite Rabs_minus_sym in H7; + generalize + (Rle_lt_trans (Rabs l - Rabs (f x)) (Rabs (l - f x)) (Rabs l / 2) H13 H7); + intro; + generalize + (Rplus_lt_compat_l (Rabs (f x) - Rabs l / 2) (Rabs l - Rabs (f x)) + (Rabs l / 2) H14); + replace (Rabs (f x) - Rabs l / 2 + (Rabs l - Rabs (f x))) with (Rabs l / 2). + unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l; + rewrite Rplus_0_r; intro; cut (f x <> 0). + intro; replace (/ f x + - / l) with ((l - f x) * / (l * f x)). + rewrite Rabs_mult; rewrite Rabs_Rinv. + cut (/ Rabs (l * f x) < 2 / Rsqr l). + intro; rewrite Rabs_minus_sym in H5; cut (0 <= / Rabs (l * f x)). + intro; + generalize + (Rmult_le_0_lt_compat (Rabs (l - f x)) (eps * (Rsqr l / 2)) + (/ Rabs (l * f x)) (2 / Rsqr l) (Rabs_pos (l - f x)) H18 H5 H17); + replace (eps * (Rsqr l / 2) * (2 / Rsqr l)) with eps. + intro; assumption. + unfold Rdiv in |- *; unfold Rsqr in |- *; rewrite Rinv_mult_distr. + repeat rewrite Rmult_assoc. + rewrite (Rmult_comm l). + repeat rewrite Rmult_assoc. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_r. + rewrite (Rmult_comm l). + repeat rewrite Rmult_assoc. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_r. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_r; reflexivity. + discrR. + exact H0. + exact H0. + exact H0. + exact H0. + left; apply Rinv_0_lt_compat; apply Rabs_pos_lt; apply prod_neq_R0; + assumption. + rewrite Rmult_comm; rewrite Rabs_mult; rewrite Rinv_mult_distr. + rewrite (Rsqr_abs l); unfold Rsqr in |- *; unfold Rdiv in |- *; + rewrite Rinv_mult_distr. + repeat rewrite <- Rmult_assoc; apply Rmult_lt_compat_r. + apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. + apply Rmult_lt_reg_l with (Rabs (f x) * Rabs l * / 2). + repeat apply Rmult_lt_0_compat. + apply Rabs_pos_lt; assumption. + apply Rabs_pos_lt; assumption. + apply Rinv_0_lt_compat; cut (0%nat <> 2%nat); + [ intro H17; generalize (lt_INR_0 2 (neq_O_lt 2 H17)); unfold INR in |- *; + intro H18; assumption + | discriminate ]. + replace (Rabs (f x) * Rabs l * / 2 * / Rabs (f x)) with (Rabs l / 2). + replace (Rabs (f x) * Rabs l * / 2 * (2 * / Rabs l)) with (Rabs (f x)). + assumption. + repeat rewrite Rmult_assoc. + rewrite (Rmult_comm (Rabs l)). + repeat rewrite Rmult_assoc. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_r. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_r; reflexivity. + discrR. + apply Rabs_no_R0. + assumption. + unfold Rdiv in |- *. + repeat rewrite Rmult_assoc. + rewrite (Rmult_comm (Rabs (f x))). + repeat rewrite Rmult_assoc. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_r. + reflexivity. + apply Rabs_no_R0; assumption. + apply Rabs_no_R0; assumption. + apply Rabs_no_R0; assumption. + apply Rabs_no_R0; assumption. + apply Rabs_no_R0; assumption. + apply prod_neq_R0; assumption. + rewrite (Rinv_mult_distr _ _ H0 H16). + unfold Rminus in |- *; rewrite Rmult_plus_distr_r. + rewrite <- Rmult_assoc. + rewrite <- Rinv_r_sym. + rewrite Rmult_1_l. + rewrite Ropp_mult_distr_l_reverse. + rewrite (Rmult_comm (f x)). + rewrite Rmult_assoc. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_r. + reflexivity. + assumption. + assumption. + red in |- *; intro; rewrite H16 in H15; rewrite Rabs_R0 in H15; + cut (0 < Rabs l / 2). + intro; elim (Rlt_irrefl 0 (Rlt_trans 0 (Rabs l / 2) 0 H17 H15)). + unfold Rdiv in |- *; apply Rmult_lt_0_compat. + apply Rabs_pos_lt; assumption. + apply Rinv_0_lt_compat; cut (0%nat <> 2%nat); + [ intro H17; generalize (lt_INR_0 2 (neq_O_lt 2 H17)); unfold INR in |- *; + intro; assumption + | discriminate ]. + pattern (Rabs l) at 3 in |- *; rewrite double_var. + ring. + split; + [ assumption + | apply Rlt_le_trans with (Rmin delta1 delta2); + [ assumption | apply Rmin_r ] ]. + split; + [ assumption + | apply Rlt_le_trans with (Rmin delta1 delta2); + [ assumption | apply Rmin_l ] ]. + change (0 < eps * (Rsqr l / 2)) in |- *; unfold Rdiv in |- *; + repeat rewrite Rmult_assoc; repeat apply Rmult_lt_0_compat. + assumption. + apply Rsqr_pos_lt; assumption. + apply Rinv_0_lt_compat; cut (0%nat <> 2%nat); [ intro H3; generalize (lt_INR_0 2 (neq_O_lt 2 H3)); unfold INR in |- *; - intro; assumption - | discriminate ] ]. + intro; assumption + | discriminate ]. + change (0 < Rabs l / 2) in |- *; unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply Rabs_pos_lt; assumption + | apply Rinv_0_lt_compat; cut (0%nat <> 2%nat); + [ intro H3; generalize (lt_INR_0 2 (neq_O_lt 2 H3)); unfold INR in |- *; + intro; assumption + | discriminate ] ]. Qed. diff --git a/theories/Reals/Rpower.v b/theories/Reals/Rpower.v index aa9e9887..cb6c59d5 100644 --- a/theories/Reals/Rpower.v +++ b/theories/Reals/Rpower.v @@ -5,8 +5,8 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) - -(*i $Id: Rpower.v 6295 2004-11-12 16:40:39Z gregoire $ i*) + +(*i $Id: Rpower.v 9245 2006-10-17 12:53:34Z notin $ i*) (*i Due to L.Thery i*) (************************************************************) @@ -25,637 +25,674 @@ Require Import MVT. Require Import Ranalysis4. Open Local Scope R_scope. Lemma P_Rmin : forall (P:R -> Prop) (x y:R), P x -> P y -> P (Rmin x y). -intros P x y H1 H2; unfold Rmin in |- *; case (Rle_dec x y); intro; - assumption. +Proof. + intros P x y H1 H2; unfold Rmin in |- *; case (Rle_dec x y); intro; + assumption. Qed. Lemma exp_le_3 : exp 1 <= 3. -assert (exp_1 : exp 1 <> 0). -assert (H0 := exp_pos 1); red in |- *; intro; rewrite H in H0; - elim (Rlt_irrefl _ H0). -apply Rmult_le_reg_l with (/ exp 1). -apply Rinv_0_lt_compat; apply exp_pos. -rewrite <- Rinv_l_sym. -apply Rmult_le_reg_l with (/ 3). -apply Rinv_0_lt_compat; prove_sup0. -rewrite Rmult_1_r; rewrite <- (Rmult_comm 3); rewrite <- Rmult_assoc; - rewrite <- Rinv_l_sym. -rewrite Rmult_1_l; replace (/ exp 1) with (exp (-1)). -unfold exp in |- *; case (exist_exp (-1)); intros; simpl in |- *; - unfold exp_in in e; - assert (H := alternated_series_ineq (fun i:nat => / INR (fact i)) x 1). -cut - (sum_f_R0 (tg_alt (fun i:nat => / INR (fact i))) (S (2 * 1)) <= x <= - sum_f_R0 (tg_alt (fun i:nat => / INR (fact i))) (2 * 1)). -intro; elim H0; clear H0; intros H0 _; simpl in H0; unfold tg_alt in H0; - simpl in H0. -replace (/ 3) with - (1 * / 1 + -1 * 1 * / 1 + -1 * (-1 * 1) * / 2 + - -1 * (-1 * (-1 * 1)) * / (2 + 1 + 1 + 1 + 1)). -apply H0. -repeat rewrite Rinv_1; repeat rewrite Rmult_1_r; - rewrite Ropp_mult_distr_l_reverse; rewrite Rmult_1_l; - rewrite Ropp_involutive; rewrite Rplus_opp_r; rewrite Rmult_1_r; - rewrite Rplus_0_l; rewrite Rmult_1_l; apply Rmult_eq_reg_l with 6. -rewrite Rmult_plus_distr_l; replace (2 + 1 + 1 + 1 + 1) with 6. -rewrite <- (Rmult_comm (/ 6)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. -rewrite Rmult_1_l; replace 6 with 6. -do 2 rewrite Rmult_assoc; rewrite <- Rinv_r_sym. -rewrite Rmult_1_r; rewrite (Rmult_comm 3); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym. -ring. -discrR. -discrR. -ring. -discrR. -ring. -discrR. -apply H. -unfold Un_decreasing in |- *; intros; - apply Rmult_le_reg_l with (INR (fact n)). -apply INR_fact_lt_0. -apply Rmult_le_reg_l with (INR (fact (S n))). -apply INR_fact_lt_0. -rewrite <- Rinv_r_sym. -rewrite Rmult_1_r; rewrite Rmult_comm; rewrite Rmult_assoc; - rewrite <- Rinv_l_sym. -rewrite Rmult_1_r; apply le_INR; apply fact_le; apply le_n_Sn. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -assert (H0 := cv_speed_pow_fact 1); unfold Un_cv in |- *; unfold Un_cv in H0; - intros; elim (H0 _ H1); intros; exists x0; intros; - unfold R_dist in H2; unfold R_dist in |- *; - replace (/ INR (fact n)) with (1 ^ n / INR (fact n)). -apply (H2 _ H3). -unfold Rdiv in |- *; rewrite pow1; rewrite Rmult_1_l; reflexivity. -unfold infinit_sum in e; unfold Un_cv, tg_alt in |- *; intros; elim (e _ H0); - intros; exists x0; intros; - replace (sum_f_R0 (fun i:nat => (-1) ^ i * / INR (fact i)) n) with - (sum_f_R0 (fun i:nat => / INR (fact i) * (-1) ^ i) n). -apply (H1 _ H2). -apply sum_eq; intros; apply Rmult_comm. -apply Rmult_eq_reg_l with (exp 1). -rewrite <- exp_plus; rewrite Rplus_opp_r; rewrite exp_0; - rewrite <- Rinv_r_sym. -reflexivity. -assumption. -assumption. -discrR. -assumption. +Proof. + assert (exp_1 : exp 1 <> 0). + assert (H0 := exp_pos 1); red in |- *; intro; rewrite H in H0; + elim (Rlt_irrefl _ H0). + apply Rmult_le_reg_l with (/ exp 1). + apply Rinv_0_lt_compat; apply exp_pos. + rewrite <- Rinv_l_sym. + apply Rmult_le_reg_l with (/ 3). + apply Rinv_0_lt_compat; prove_sup0. + rewrite Rmult_1_r; rewrite <- (Rmult_comm 3); rewrite <- Rmult_assoc; + rewrite <- Rinv_l_sym. + rewrite Rmult_1_l; replace (/ exp 1) with (exp (-1)). + unfold exp in |- *; case (exist_exp (-1)); intros; simpl in |- *; + unfold exp_in in e; + assert (H := alternated_series_ineq (fun i:nat => / INR (fact i)) x 1). + cut + (sum_f_R0 (tg_alt (fun i:nat => / INR (fact i))) (S (2 * 1)) <= x <= + sum_f_R0 (tg_alt (fun i:nat => / INR (fact i))) (2 * 1)). + intro; elim H0; clear H0; intros H0 _; simpl in H0; unfold tg_alt in H0; + simpl in H0. + replace (/ 3) with + (1 * / 1 + -1 * 1 * / 1 + -1 * (-1 * 1) * / 2 + + -1 * (-1 * (-1 * 1)) * / (2 + 1 + 1 + 1 + 1)). + apply H0. + repeat rewrite Rinv_1; repeat rewrite Rmult_1_r; + rewrite Ropp_mult_distr_l_reverse; rewrite Rmult_1_l; + rewrite Ropp_involutive; rewrite Rplus_opp_r; rewrite Rmult_1_r; + rewrite Rplus_0_l; rewrite Rmult_1_l; apply Rmult_eq_reg_l with 6. + rewrite Rmult_plus_distr_l; replace (2 + 1 + 1 + 1 + 1) with 6. + rewrite <- (Rmult_comm (/ 6)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. + rewrite Rmult_1_l; replace 6 with 6. + do 2 rewrite Rmult_assoc; rewrite <- Rinv_r_sym. + rewrite Rmult_1_r; rewrite (Rmult_comm 3); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. + ring. + discrR. + discrR. + ring. + discrR. + ring. + discrR. + apply H. + unfold Un_decreasing in |- *; intros; + apply Rmult_le_reg_l with (INR (fact n)). + apply INR_fact_lt_0. + apply Rmult_le_reg_l with (INR (fact (S n))). + apply INR_fact_lt_0. + rewrite <- Rinv_r_sym. + rewrite Rmult_1_r; rewrite Rmult_comm; rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. + rewrite Rmult_1_r; apply le_INR; apply fact_le; apply le_n_Sn. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + assert (H0 := cv_speed_pow_fact 1); unfold Un_cv in |- *; unfold Un_cv in H0; + intros; elim (H0 _ H1); intros; exists x0; intros; + unfold R_dist in H2; unfold R_dist in |- *; + replace (/ INR (fact n)) with (1 ^ n / INR (fact n)). + apply (H2 _ H3). + unfold Rdiv in |- *; rewrite pow1; rewrite Rmult_1_l; reflexivity. + unfold infinit_sum in e; unfold Un_cv, tg_alt in |- *; intros; elim (e _ H0); + intros; exists x0; intros; + replace (sum_f_R0 (fun i:nat => (-1) ^ i * / INR (fact i)) n) with + (sum_f_R0 (fun i:nat => / INR (fact i) * (-1) ^ i) n). + apply (H1 _ H2). + apply sum_eq; intros; apply Rmult_comm. + apply Rmult_eq_reg_l with (exp 1). + rewrite <- exp_plus; rewrite Rplus_opp_r; rewrite exp_0; + rewrite <- Rinv_r_sym. + reflexivity. + assumption. + assumption. + discrR. + assumption. Qed. (******************************************************************) -(* Properties of Exp *) +(** * Properties of Exp *) (******************************************************************) Theorem exp_increasing : forall x y:R, x < y -> exp x < exp y. -intros x y H. -assert (H0 : derivable exp). -apply derivable_exp. -assert (H1 := positive_derivative _ H0). -unfold strict_increasing in H1. -apply H1. -intro. -replace (derive_pt exp x0 (H0 x0)) with (exp x0). -apply exp_pos. -symmetry in |- *; apply derive_pt_eq_0. -apply (derivable_pt_lim_exp x0). -apply H. -Qed. - +Proof. + intros x y H. + assert (H0 : derivable exp). + apply derivable_exp. + assert (H1 := positive_derivative _ H0). + unfold strict_increasing in H1. + apply H1. + intro. + replace (derive_pt exp x0 (H0 x0)) with (exp x0). + apply exp_pos. + symmetry in |- *; apply derive_pt_eq_0. + apply (derivable_pt_lim_exp x0). + apply H. +Qed. + Theorem exp_lt_inv : forall x y:R, exp x < exp y -> x < y. -intros x y H; case (Rtotal_order x y); [ intros H1 | intros [H1| H1] ]. -assumption. -rewrite H1 in H; elim (Rlt_irrefl _ H). -assert (H2 := exp_increasing _ _ H1). -elim (Rlt_irrefl _ (Rlt_trans _ _ _ H H2)). +Proof. + intros x y H; case (Rtotal_order x y); [ intros H1 | intros [H1| H1] ]. + assumption. + rewrite H1 in H; elim (Rlt_irrefl _ H). + assert (H2 := exp_increasing _ _ H1). + elim (Rlt_irrefl _ (Rlt_trans _ _ _ H H2)). Qed. - + Lemma exp_ineq1 : forall x:R, 0 < x -> 1 + x < exp x. -intros; apply Rplus_lt_reg_r with (- exp 0); rewrite <- (Rplus_comm (exp x)); - assert (H0 := MVT_cor1 exp 0 x derivable_exp H); elim H0; - intros; elim H1; intros; unfold Rminus in H2; rewrite H2; - rewrite Ropp_0; rewrite Rplus_0_r; - replace (derive_pt exp x0 (derivable_exp x0)) with (exp x0). -rewrite exp_0; rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; - pattern x at 1 in |- *; rewrite <- Rmult_1_r; rewrite (Rmult_comm (exp x0)); - apply Rmult_lt_compat_l. -apply H. -rewrite <- exp_0; apply exp_increasing; elim H3; intros; assumption. -symmetry in |- *; apply derive_pt_eq_0; apply derivable_pt_lim_exp. +Proof. + intros; apply Rplus_lt_reg_r with (- exp 0); rewrite <- (Rplus_comm (exp x)); + assert (H0 := MVT_cor1 exp 0 x derivable_exp H); elim H0; + intros; elim H1; intros; unfold Rminus in H2; rewrite H2; + rewrite Ropp_0; rewrite Rplus_0_r; + replace (derive_pt exp x0 (derivable_exp x0)) with (exp x0). + rewrite exp_0; rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; + pattern x at 1 in |- *; rewrite <- Rmult_1_r; rewrite (Rmult_comm (exp x0)); + apply Rmult_lt_compat_l. + apply H. + rewrite <- exp_0; apply exp_increasing; elim H3; intros; assumption. + symmetry in |- *; apply derive_pt_eq_0; apply derivable_pt_lim_exp. Qed. Lemma ln_exists1 : forall y:R, 0 < y -> 1 <= y -> sigT (fun z:R => y = exp z). -intros; set (f := fun x:R => exp x - y); cut (f 0 <= 0). -intro; cut (continuity f). -intro; cut (0 <= f y). -intro; cut (f 0 * f y <= 0). -intro; assert (X := IVT_cor f 0 y H2 (Rlt_le _ _ H) H4); elim X; intros t H5; - apply existT with t; elim H5; intros; unfold f in H7; - apply Rminus_diag_uniq_sym; exact H7. -pattern 0 at 2 in |- *; rewrite <- (Rmult_0_r (f y)); - rewrite (Rmult_comm (f 0)); apply Rmult_le_compat_l; - assumption. -unfold f in |- *; apply Rplus_le_reg_l with y; left; - apply Rlt_trans with (1 + y). -rewrite <- (Rplus_comm y); apply Rplus_lt_compat_l; apply Rlt_0_1. -replace (y + (exp y - y)) with (exp y); [ apply (exp_ineq1 y H) | ring ]. -unfold f in |- *; change (continuity (exp - fct_cte y)) in |- *; - apply continuity_minus; - [ apply derivable_continuous; apply derivable_exp - | apply derivable_continuous; apply derivable_const ]. -unfold f in |- *; rewrite exp_0; apply Rplus_le_reg_l with y; - rewrite Rplus_0_r; replace (y + (1 - y)) with 1; [ apply H0 | ring ]. +Proof. + intros; set (f := fun x:R => exp x - y); cut (f 0 <= 0). + intro; cut (continuity f). + intro; cut (0 <= f y). + intro; cut (f 0 * f y <= 0). + intro; assert (X := IVT_cor f 0 y H2 (Rlt_le _ _ H) H4); elim X; intros t H5; + apply existT with t; elim H5; intros; unfold f in H7; + apply Rminus_diag_uniq_sym; exact H7. + pattern 0 at 2 in |- *; rewrite <- (Rmult_0_r (f y)); + rewrite (Rmult_comm (f 0)); apply Rmult_le_compat_l; + assumption. + unfold f in |- *; apply Rplus_le_reg_l with y; left; + apply Rlt_trans with (1 + y). + rewrite <- (Rplus_comm y); apply Rplus_lt_compat_l; apply Rlt_0_1. + replace (y + (exp y - y)) with (exp y); [ apply (exp_ineq1 y H) | ring ]. + unfold f in |- *; change (continuity (exp - fct_cte y)) in |- *; + apply continuity_minus; + [ apply derivable_continuous; apply derivable_exp + | apply derivable_continuous; apply derivable_const ]. + unfold f in |- *; rewrite exp_0; apply Rplus_le_reg_l with y; + rewrite Rplus_0_r; replace (y + (1 - y)) with 1; [ apply H0 | ring ]. Qed. (**********) Lemma ln_exists : forall y:R, 0 < y -> sigT (fun z:R => y = exp z). -intros; case (Rle_dec 1 y); intro. -apply (ln_exists1 _ H r). -assert (H0 : 1 <= / y). -apply Rmult_le_reg_l with y. -apply H. -rewrite <- Rinv_r_sym. -rewrite Rmult_1_r; left; apply (Rnot_le_lt _ _ n). -red in |- *; intro; rewrite H0 in H; elim (Rlt_irrefl _ H). -assert (H1 : 0 < / y). -apply Rinv_0_lt_compat; apply H. -assert (H2 := ln_exists1 _ H1 H0); elim H2; intros; apply existT with (- x); - apply Rmult_eq_reg_l with (exp x / y). -unfold Rdiv in |- *; rewrite Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_r; rewrite <- (Rmult_comm (/ y)); rewrite Rmult_assoc; - rewrite <- exp_plus; rewrite Rplus_opp_r; rewrite exp_0; - rewrite Rmult_1_r; symmetry in |- *; apply p. -red in |- *; intro; rewrite H3 in H; elim (Rlt_irrefl _ H). -unfold Rdiv in |- *; apply prod_neq_R0. -assert (H3 := exp_pos x); red in |- *; intro; rewrite H4 in H3; - elim (Rlt_irrefl _ H3). -apply Rinv_neq_0_compat; red in |- *; intro; rewrite H3 in H; - elim (Rlt_irrefl _ H). +Proof. + intros; case (Rle_dec 1 y); intro. + apply (ln_exists1 _ H r). + assert (H0 : 1 <= / y). + apply Rmult_le_reg_l with y. + apply H. + rewrite <- Rinv_r_sym. + rewrite Rmult_1_r; left; apply (Rnot_le_lt _ _ n). + red in |- *; intro; rewrite H0 in H; elim (Rlt_irrefl _ H). + assert (H1 : 0 < / y). + apply Rinv_0_lt_compat; apply H. + assert (H2 := ln_exists1 _ H1 H0); elim H2; intros; apply existT with (- x); + apply Rmult_eq_reg_l with (exp x / y). + unfold Rdiv in |- *; rewrite Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_r; rewrite <- (Rmult_comm (/ y)); rewrite Rmult_assoc; + rewrite <- exp_plus; rewrite Rplus_opp_r; rewrite exp_0; + rewrite Rmult_1_r; symmetry in |- *; apply p. + red in |- *; intro; rewrite H3 in H; elim (Rlt_irrefl _ H). + unfold Rdiv in |- *; apply prod_neq_R0. + assert (H3 := exp_pos x); red in |- *; intro; rewrite H4 in H3; + elim (Rlt_irrefl _ H3). + apply Rinv_neq_0_compat; red in |- *; intro; rewrite H3 in H; + elim (Rlt_irrefl _ H). Qed. (* Definition of log R+* -> R *) Definition Rln (y:posreal) : R := match ln_exists (pos y) (cond_pos y) with - | existT a b => a + | existT a b => a end. (* Extension on R *) Definition ln (x:R) : R := match Rlt_dec 0 x with - | left a => Rln (mkposreal x a) - | right a => 0 + | left a => Rln (mkposreal x a) + | right a => 0 end. Lemma exp_ln : forall x:R, 0 < x -> exp (ln x) = x. -intros; unfold ln in |- *; case (Rlt_dec 0 x); intro. -unfold Rln in |- *; - case (ln_exists (mkposreal x r) (cond_pos (mkposreal x r))); - intros. -simpl in e; symmetry in |- *; apply e. -elim n; apply H. +Proof. + intros; unfold ln in |- *; case (Rlt_dec 0 x); intro. + unfold Rln in |- *; + case (ln_exists (mkposreal x r) (cond_pos (mkposreal x r))); + intros. + simpl in e; symmetry in |- *; apply e. + elim n; apply H. Qed. Theorem exp_inv : forall x y:R, exp x = exp y -> x = y. -intros x y H; case (Rtotal_order x y); [ intros H1 | intros [H1| H1] ]; auto; - assert (H2 := exp_increasing _ _ H1); rewrite H in H2; - elim (Rlt_irrefl _ H2). +Proof. + intros x y H; case (Rtotal_order x y); [ intros H1 | intros [H1| H1] ]; auto; + assert (H2 := exp_increasing _ _ H1); rewrite H in H2; + elim (Rlt_irrefl _ H2). Qed. - + Theorem exp_Ropp : forall x:R, exp (- x) = / exp x. -intros x; assert (H : exp x <> 0). -assert (H := exp_pos x); red in |- *; intro; rewrite H0 in H; - elim (Rlt_irrefl _ H). -apply Rmult_eq_reg_l with (r := exp x). -rewrite <- exp_plus; rewrite Rplus_opp_r; rewrite exp_0. -apply Rinv_r_sym. -apply H. -apply H. -Qed. - +Proof. + intros x; assert (H : exp x <> 0). + assert (H := exp_pos x); red in |- *; intro; rewrite H0 in H; + elim (Rlt_irrefl _ H). + apply Rmult_eq_reg_l with (r := exp x). + rewrite <- exp_plus; rewrite Rplus_opp_r; rewrite exp_0. + apply Rinv_r_sym. + apply H. + apply H. +Qed. + (******************************************************************) -(* Properties of Ln *) +(** * Properties of Ln *) (******************************************************************) Theorem ln_increasing : forall x y:R, 0 < x -> x < y -> ln x < ln y. -intros x y H H0; apply exp_lt_inv. -repeat rewrite exp_ln. -apply H0. -apply Rlt_trans with x; assumption. -apply H. +Proof. + intros x y H H0; apply exp_lt_inv. + repeat rewrite exp_ln. + apply H0. + apply Rlt_trans with x; assumption. + apply H. Qed. Theorem ln_exp : forall x:R, ln (exp x) = x. -intros x; apply exp_inv. -apply exp_ln. -apply exp_pos. +Proof. + intros x; apply exp_inv. + apply exp_ln. + apply exp_pos. Qed. - + Theorem ln_1 : ln 1 = 0. -rewrite <- exp_0; rewrite ln_exp; reflexivity. +Proof. + rewrite <- exp_0; rewrite ln_exp; reflexivity. Qed. - + Theorem ln_lt_inv : forall x y:R, 0 < x -> 0 < y -> ln x < ln y -> x < y. -intros x y H H0 H1; rewrite <- (exp_ln x); try rewrite <- (exp_ln y). -apply exp_increasing; apply H1. -assumption. -assumption. +Proof. + intros x y H H0 H1; rewrite <- (exp_ln x); try rewrite <- (exp_ln y). + apply exp_increasing; apply H1. + assumption. + assumption. Qed. - + Theorem ln_inv : forall x y:R, 0 < x -> 0 < y -> ln x = ln y -> x = y. -intros x y H H0 H'0; case (Rtotal_order x y); [ intros H1 | intros [H1| H1] ]; - auto. -assert (H2 := ln_increasing _ _ H H1); rewrite H'0 in H2; - elim (Rlt_irrefl _ H2). -assert (H2 := ln_increasing _ _ H0 H1); rewrite H'0 in H2; - elim (Rlt_irrefl _ H2). -Qed. - +Proof. + intros x y H H0 H'0; case (Rtotal_order x y); [ intros H1 | intros [H1| H1] ]; + auto. + assert (H2 := ln_increasing _ _ H H1); rewrite H'0 in H2; + elim (Rlt_irrefl _ H2). + assert (H2 := ln_increasing _ _ H0 H1); rewrite H'0 in H2; + elim (Rlt_irrefl _ H2). +Qed. + Theorem ln_mult : forall x y:R, 0 < x -> 0 < y -> ln (x * y) = ln x + ln y. -intros x y H H0; apply exp_inv. -rewrite exp_plus. -repeat rewrite exp_ln. -reflexivity. -assumption. -assumption. -apply Rmult_lt_0_compat; assumption. +Proof. + intros x y H H0; apply exp_inv. + rewrite exp_plus. + repeat rewrite exp_ln. + reflexivity. + assumption. + assumption. + apply Rmult_lt_0_compat; assumption. Qed. Theorem ln_Rinv : forall x:R, 0 < x -> ln (/ x) = - ln x. -intros x H; apply exp_inv; repeat rewrite exp_ln || rewrite exp_Ropp. -reflexivity. -assumption. -apply Rinv_0_lt_compat; assumption. +Proof. + intros x H; apply exp_inv; repeat rewrite exp_ln || rewrite exp_Ropp. + reflexivity. + assumption. + apply Rinv_0_lt_compat; assumption. Qed. Theorem ln_continue : - forall y:R, 0 < y -> continue_in ln (fun x:R => 0 < x) y. -intros y H. -unfold continue_in, limit1_in, limit_in in |- *; intros eps Heps. -cut (1 < exp eps); [ intros H1 | idtac ]. -cut (exp (- eps) < 1); [ intros H2 | idtac ]. -exists (Rmin (y * (exp eps - 1)) (y * (1 - exp (- eps)))); split. -red in |- *; apply P_Rmin. -apply Rmult_lt_0_compat. -assumption. -apply Rplus_lt_reg_r with 1. -rewrite Rplus_0_r; replace (1 + (exp eps - 1)) with (exp eps); - [ apply H1 | ring ]. -apply Rmult_lt_0_compat. -assumption. -apply Rplus_lt_reg_r with (exp (- eps)). -rewrite Rplus_0_r; replace (exp (- eps) + (1 - exp (- eps))) with 1; - [ apply H2 | ring ]. -unfold dist, R_met, R_dist in |- *; simpl in |- *. -intros x [[H3 H4] H5]. -cut (y * (x * / y) = x). -intro Hxyy. -replace (ln x - ln y) with (ln (x * / y)). -case (Rtotal_order x y); [ intros Hxy | intros [Hxy| Hxy] ]. -rewrite Rabs_left. -apply Ropp_lt_cancel; rewrite Ropp_involutive. -apply exp_lt_inv. -rewrite exp_ln. -apply Rmult_lt_reg_l with (r := y). -apply H. -rewrite Hxyy. -apply Ropp_lt_cancel. -apply Rplus_lt_reg_r with (r := y). -replace (y + - (y * exp (- eps))) with (y * (1 - exp (- eps))); - [ idtac | ring ]. -replace (y + - x) with (Rabs (x - y)); [ idtac | ring ]. -apply Rlt_le_trans with (1 := H5); apply Rmin_r. -rewrite Rabs_left; [ ring | idtac ]. -apply (Rlt_minus _ _ Hxy). -apply Rmult_lt_0_compat; [ apply H3 | apply (Rinv_0_lt_compat _ H) ]. -rewrite <- ln_1. -apply ln_increasing. -apply Rmult_lt_0_compat; [ apply H3 | apply (Rinv_0_lt_compat _ H) ]. -apply Rmult_lt_reg_l with (r := y). -apply H. -rewrite Hxyy; rewrite Rmult_1_r; apply Hxy. -rewrite Hxy; rewrite Rinv_r. -rewrite ln_1; rewrite Rabs_R0; apply Heps. -red in |- *; intro; rewrite H0 in H; elim (Rlt_irrefl _ H). -rewrite Rabs_right. -apply exp_lt_inv. -rewrite exp_ln. -apply Rmult_lt_reg_l with (r := y). -apply H. -rewrite Hxyy. -apply Rplus_lt_reg_r with (r := - y). -replace (- y + y * exp eps) with (y * (exp eps - 1)); [ idtac | ring ]. -replace (- y + x) with (Rabs (x - y)); [ idtac | ring ]. -apply Rlt_le_trans with (1 := H5); apply Rmin_l. -rewrite Rabs_right; [ ring | idtac ]. -left; apply (Rgt_minus _ _ Hxy). -apply Rmult_lt_0_compat; [ apply H3 | apply (Rinv_0_lt_compat _ H) ]. -rewrite <- ln_1. -apply Rgt_ge; red in |- *; apply ln_increasing. -apply Rlt_0_1. -apply Rmult_lt_reg_l with (r := y). -apply H. -rewrite Hxyy; rewrite Rmult_1_r; apply Hxy. -rewrite ln_mult. -rewrite ln_Rinv. -ring. -assumption. -assumption. -apply Rinv_0_lt_compat; assumption. -rewrite (Rmult_comm x); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. -ring. -red in |- *; intro; rewrite H0 in H; elim (Rlt_irrefl _ H). -apply Rmult_lt_reg_l with (exp eps). -apply exp_pos. -rewrite <- exp_plus; rewrite Rmult_1_r; rewrite Rplus_opp_r; rewrite exp_0; - apply H1. -rewrite <- exp_0. -apply exp_increasing; apply Heps. + forall y:R, 0 < y -> continue_in ln (fun x:R => 0 < x) y. +Proof. + intros y H. + unfold continue_in, limit1_in, limit_in in |- *; intros eps Heps. + cut (1 < exp eps); [ intros H1 | idtac ]. + cut (exp (- eps) < 1); [ intros H2 | idtac ]. + exists (Rmin (y * (exp eps - 1)) (y * (1 - exp (- eps)))); split. + red in |- *; apply P_Rmin. + apply Rmult_lt_0_compat. + assumption. + apply Rplus_lt_reg_r with 1. + rewrite Rplus_0_r; replace (1 + (exp eps - 1)) with (exp eps); + [ apply H1 | ring ]. + apply Rmult_lt_0_compat. + assumption. + apply Rplus_lt_reg_r with (exp (- eps)). + rewrite Rplus_0_r; replace (exp (- eps) + (1 - exp (- eps))) with 1; + [ apply H2 | ring ]. + unfold dist, R_met, R_dist in |- *; simpl in |- *. + intros x [[H3 H4] H5]. + cut (y * (x * / y) = x). + intro Hxyy. + replace (ln x - ln y) with (ln (x * / y)). + case (Rtotal_order x y); [ intros Hxy | intros [Hxy| Hxy] ]. + rewrite Rabs_left. + apply Ropp_lt_cancel; rewrite Ropp_involutive. + apply exp_lt_inv. + rewrite exp_ln. + apply Rmult_lt_reg_l with (r := y). + apply H. + rewrite Hxyy. + apply Ropp_lt_cancel. + apply Rplus_lt_reg_r with (r := y). + replace (y + - (y * exp (- eps))) with (y * (1 - exp (- eps))); + [ idtac | ring ]. + replace (y + - x) with (Rabs (x - y)). + apply Rlt_le_trans with (1 := H5); apply Rmin_r. + rewrite Rabs_left; [ ring | idtac ]. + apply (Rlt_minus _ _ Hxy). + apply Rmult_lt_0_compat; [ apply H3 | apply (Rinv_0_lt_compat _ H) ]. + rewrite <- ln_1. + apply ln_increasing. + apply Rmult_lt_0_compat; [ apply H3 | apply (Rinv_0_lt_compat _ H) ]. + apply Rmult_lt_reg_l with (r := y). + apply H. + rewrite Hxyy; rewrite Rmult_1_r; apply Hxy. + rewrite Hxy; rewrite Rinv_r. + rewrite ln_1; rewrite Rabs_R0; apply Heps. + red in |- *; intro; rewrite H0 in H; elim (Rlt_irrefl _ H). + rewrite Rabs_right. + apply exp_lt_inv. + rewrite exp_ln. + apply Rmult_lt_reg_l with (r := y). + apply H. + rewrite Hxyy. + apply Rplus_lt_reg_r with (r := - y). + replace (- y + y * exp eps) with (y * (exp eps - 1)); [ idtac | ring ]. + replace (- y + x) with (Rabs (x - y)). + apply Rlt_le_trans with (1 := H5); apply Rmin_l. + rewrite Rabs_right; [ ring | idtac ]. + left; apply (Rgt_minus _ _ Hxy). + apply Rmult_lt_0_compat; [ apply H3 | apply (Rinv_0_lt_compat _ H) ]. + rewrite <- ln_1. + apply Rgt_ge; red in |- *; apply ln_increasing. + apply Rlt_0_1. + apply Rmult_lt_reg_l with (r := y). + apply H. + rewrite Hxyy; rewrite Rmult_1_r; apply Hxy. + rewrite ln_mult. + rewrite ln_Rinv. + ring. + assumption. + assumption. + apply Rinv_0_lt_compat; assumption. + rewrite (Rmult_comm x); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. + ring. + red in |- *; intro; rewrite H0 in H; elim (Rlt_irrefl _ H). + apply Rmult_lt_reg_l with (exp eps). + apply exp_pos. + rewrite <- exp_plus; rewrite Rmult_1_r; rewrite Rplus_opp_r; rewrite exp_0; + apply H1. + rewrite <- exp_0. + apply exp_increasing; apply Heps. Qed. (******************************************************************) -(* Definition of Rpower *) +(** * Definition of Rpower *) (******************************************************************) - + Definition Rpower (x y:R) := exp (y * ln x). Infix Local "^R" := Rpower (at level 30, right associativity) : R_scope. (******************************************************************) -(* Properties of Rpower *) +(** * Properties of Rpower *) (******************************************************************) - + Theorem Rpower_plus : forall x y z:R, z ^R (x + y) = z ^R x * z ^R y. -intros x y z; unfold Rpower in |- *. -rewrite Rmult_plus_distr_r; rewrite exp_plus; auto. +Proof. + intros x y z; unfold Rpower in |- *. + rewrite Rmult_plus_distr_r; rewrite exp_plus; auto. Qed. - + Theorem Rpower_mult : forall x y z:R, (x ^R y) ^R z = x ^R (y * z). -intros x y z; unfold Rpower in |- *. -rewrite ln_exp. -replace (z * (y * ln x)) with (y * z * ln x). -reflexivity. -ring. +Proof. + intros x y z; unfold Rpower in |- *. + rewrite ln_exp. + replace (z * (y * ln x)) with (y * z * ln x). + reflexivity. + ring. Qed. - + Theorem Rpower_O : forall x:R, 0 < x -> x ^R 0 = 1. -intros x H; unfold Rpower in |- *. -rewrite Rmult_0_l; apply exp_0. +Proof. + intros x H; unfold Rpower in |- *. + rewrite Rmult_0_l; apply exp_0. Qed. - + Theorem Rpower_1 : forall x:R, 0 < x -> x ^R 1 = x. -intros x H; unfold Rpower in |- *. -rewrite Rmult_1_l; apply exp_ln; apply H. +Proof. + intros x H; unfold Rpower in |- *. + rewrite Rmult_1_l; apply exp_ln; apply H. Qed. - + Theorem Rpower_pow : forall (n:nat) (x:R), 0 < x -> x ^R INR n = x ^ n. -intros n; elim n; simpl in |- *; auto; fold INR in |- *. -intros x H; apply Rpower_O; auto. -intros n1; case n1. -intros H x H0; simpl in |- *; rewrite Rmult_1_r; apply Rpower_1; auto. -intros n0 H x H0; rewrite Rpower_plus; rewrite H; try rewrite Rpower_1; - try apply Rmult_comm || assumption. -Qed. - +Proof. + intros n; elim n; simpl in |- *; auto; fold INR in |- *. + intros x H; apply Rpower_O; auto. + intros n1; case n1. + intros H x H0; simpl in |- *; rewrite Rmult_1_r; apply Rpower_1; auto. + intros n0 H x H0; rewrite Rpower_plus; rewrite H; try rewrite Rpower_1; + try apply Rmult_comm || assumption. +Qed. + Theorem Rpower_lt : - forall x y z:R, 1 < x -> 0 <= y -> y < z -> x ^R y < x ^R z. -intros x y z H H0 H1. -unfold Rpower in |- *. -apply exp_increasing. -apply Rmult_lt_compat_r. -rewrite <- ln_1; apply ln_increasing. -apply Rlt_0_1. -apply H. -apply H1. -Qed. - + forall x y z:R, 1 < x -> 0 <= y -> y < z -> x ^R y < x ^R z. +Proof. + intros x y z H H0 H1. + unfold Rpower in |- *. + apply exp_increasing. + apply Rmult_lt_compat_r. + rewrite <- ln_1; apply ln_increasing. + apply Rlt_0_1. + apply H. + apply H1. +Qed. + Theorem Rpower_sqrt : forall x:R, 0 < x -> x ^R (/ 2) = sqrt x. -intros x H. -apply ln_inv. -unfold Rpower in |- *; apply exp_pos. -apply sqrt_lt_R0; apply H. -apply Rmult_eq_reg_l with (INR 2). -apply exp_inv. -fold Rpower in |- *. -cut ((x ^R (/ 2)) ^R INR 2 = sqrt x ^R INR 2). -unfold Rpower in |- *; auto. -rewrite Rpower_mult. -rewrite Rinv_l. -replace 1 with (INR 1); auto. -repeat rewrite Rpower_pow; simpl in |- *. -pattern x at 1 in |- *; rewrite <- (sqrt_sqrt x (Rlt_le _ _ H)). -ring. -apply sqrt_lt_R0; apply H. -apply H. -apply not_O_INR; discriminate. -apply not_O_INR; discriminate. -Qed. - +Proof. + intros x H. + apply ln_inv. + unfold Rpower in |- *; apply exp_pos. + apply sqrt_lt_R0; apply H. + apply Rmult_eq_reg_l with (INR 2). + apply exp_inv. + fold Rpower in |- *. + cut ((x ^R (/ 2)) ^R INR 2 = sqrt x ^R INR 2). + unfold Rpower in |- *; auto. + rewrite Rpower_mult. + rewrite Rinv_l. + replace 1 with (INR 1); auto. + repeat rewrite Rpower_pow; simpl in |- *. + pattern x at 1 in |- *; rewrite <- (sqrt_sqrt x (Rlt_le _ _ H)). + ring. + apply sqrt_lt_R0; apply H. + apply H. + apply not_O_INR; discriminate. + apply not_O_INR; discriminate. +Qed. + Theorem Rpower_Ropp : forall x y:R, x ^R (- y) = / x ^R y. -unfold Rpower in |- *. -intros x y; rewrite Ropp_mult_distr_l_reverse. -apply exp_Ropp. +Proof. + unfold Rpower in |- *. + intros x y; rewrite Ropp_mult_distr_l_reverse. + apply exp_Ropp. Qed. - + Theorem Rle_Rpower : - forall e n m:R, 1 < e -> 0 <= n -> n <= m -> e ^R n <= e ^R m. -intros e n m H H0 H1; case H1. -intros H2; left; apply Rpower_lt; assumption. -intros H2; rewrite H2; right; reflexivity. + forall e n m:R, 1 < e -> 0 <= n -> n <= m -> e ^R n <= e ^R m. +Proof. + intros e n m H H0 H1; case H1. + intros H2; left; apply Rpower_lt; assumption. + intros H2; rewrite H2; right; reflexivity. Qed. - + Theorem ln_lt_2 : / 2 < ln 2. -apply Rmult_lt_reg_l with (r := 2). -prove_sup0. -rewrite Rinv_r. -apply exp_lt_inv. -apply Rle_lt_trans with (1 := exp_le_3). -change (3 < 2 ^R 2) in |- *. -repeat rewrite Rpower_plus; repeat rewrite Rpower_1. -repeat rewrite Rmult_plus_distr_r; repeat rewrite Rmult_plus_distr_l; - repeat rewrite Rmult_1_l. -pattern 3 at 1 in |- *; rewrite <- Rplus_0_r; replace (2 + 2) with (3 + 1); - [ apply Rplus_lt_compat_l; apply Rlt_0_1 | ring ]. -prove_sup0. -discrR. -Qed. - -(**************************************) -(* Differentiability of Ln and Rpower *) -(**************************************) +Proof. + apply Rmult_lt_reg_l with (r := 2). + prove_sup0. + rewrite Rinv_r. + apply exp_lt_inv. + apply Rle_lt_trans with (1 := exp_le_3). + change (3 < 2 ^R 2) in |- *. + repeat rewrite Rpower_plus; repeat rewrite Rpower_1. + repeat rewrite Rmult_plus_distr_r; repeat rewrite Rmult_plus_distr_l; + repeat rewrite Rmult_1_l. + pattern 3 at 1 in |- *; rewrite <- Rplus_0_r; replace (2 + 2) with (3 + 1); + [ apply Rplus_lt_compat_l; apply Rlt_0_1 | ring ]. + prove_sup0. + discrR. +Qed. + +(*****************************************) +(** * Differentiability of Ln and Rpower *) +(*****************************************) Theorem limit1_ext : - forall (f g:R -> R) (D:R -> Prop) (l x:R), - (forall x:R, D x -> f x = g x) -> limit1_in f D l x -> limit1_in g D l x. -intros f g D l x H; unfold limit1_in, limit_in in |- *. -intros H0 eps H1; case (H0 eps); auto. -intros x0 [H2 H3]; exists x0; split; auto. -intros x1 [H4 H5]; rewrite <- H; auto. + forall (f g:R -> R) (D:R -> Prop) (l x:R), + (forall x:R, D x -> f x = g x) -> limit1_in f D l x -> limit1_in g D l x. +Proof. + intros f g D l x H; unfold limit1_in, limit_in in |- *. + intros H0 eps H1; case (H0 eps); auto. + intros x0 [H2 H3]; exists x0; split; auto. + intros x1 [H4 H5]; rewrite <- H; auto. Qed. Theorem limit1_imp : - forall (f:R -> R) (D D1:R -> Prop) (l x:R), - (forall x:R, D1 x -> D x) -> limit1_in f D l x -> limit1_in f D1 l x. -intros f D D1 l x H; unfold limit1_in, limit_in in |- *. -intros H0 eps H1; case (H0 eps H1); auto. -intros alpha [H2 H3]; exists alpha; split; auto. -intros d [H4 H5]; apply H3; split; auto. + forall (f:R -> R) (D D1:R -> Prop) (l x:R), + (forall x:R, D1 x -> D x) -> limit1_in f D l x -> limit1_in f D1 l x. +Proof. + intros f D D1 l x H; unfold limit1_in, limit_in in |- *. + intros H0 eps H1; case (H0 eps H1); auto. + intros alpha [H2 H3]; exists alpha; split; auto. + intros d [H4 H5]; apply H3; split; auto. Qed. Theorem Rinv_Rdiv : forall x y:R, x <> 0 -> y <> 0 -> / (x / y) = y / x. -intros x y H1 H2; unfold Rdiv in |- *; rewrite Rinv_mult_distr. -rewrite Rinv_involutive. -apply Rmult_comm. -assumption. -assumption. -apply Rinv_neq_0_compat; assumption. +Proof. + intros x y H1 H2; unfold Rdiv in |- *; rewrite Rinv_mult_distr. + rewrite Rinv_involutive. + apply Rmult_comm. + assumption. + assumption. + apply Rinv_neq_0_compat; assumption. Qed. Theorem Dln : forall y:R, 0 < y -> D_in ln Rinv (fun x:R => 0 < x) y. -intros y Hy; unfold D_in in |- *. -apply limit1_ext with - (f := fun x:R => / ((exp (ln x) - exp (ln y)) / (ln x - ln y))). -intros x [HD1 HD2]; repeat rewrite exp_ln. -unfold Rdiv in |- *; rewrite Rinv_mult_distr. -rewrite Rinv_involutive. -apply Rmult_comm. -apply Rminus_eq_contra. -red in |- *; intros H2; case HD2. -symmetry in |- *; apply (ln_inv _ _ HD1 Hy H2). -apply Rminus_eq_contra; apply (sym_not_eq HD2). -apply Rinv_neq_0_compat; apply Rminus_eq_contra; red in |- *; intros H2; - case HD2; apply ln_inv; auto. -assumption. -assumption. -apply limit_inv with - (f := fun x:R => (exp (ln x) - exp (ln y)) / (ln x - ln y)). -apply limit1_imp with - (f := fun x:R => (fun x:R => (exp x - exp (ln y)) / (x - ln y)) (ln x)) - (D := Dgf (D_x (fun x:R => 0 < x) y) (D_x (fun x:R => True) (ln y)) ln). -intros x [H1 H2]; split. -split; auto. -split; auto. -red in |- *; intros H3; case H2; apply ln_inv; auto. -apply limit_comp with - (l := ln y) (g := fun x:R => (exp x - exp (ln y)) / (x - ln y)) (f := ln). -apply ln_continue; auto. -assert (H0 := derivable_pt_lim_exp (ln y)); unfold derivable_pt_lim in H0; - unfold limit1_in in |- *; unfold limit_in in |- *; - simpl in |- *; unfold R_dist in |- *; intros; elim (H0 _ H); - intros; exists (pos x); split. -apply (cond_pos x). -intros; pattern y at 3 in |- *; rewrite <- exp_ln. -pattern x0 at 1 in |- *; replace x0 with (ln y + (x0 - ln y)); - [ idtac | ring ]. -apply H1. -elim H2; intros H3 _; unfold D_x in H3; elim H3; clear H3; intros _ H3; - apply Rminus_eq_contra; apply (sym_not_eq (A:=R)); - apply H3. -elim H2; clear H2; intros _ H2; apply H2. -assumption. -red in |- *; intro; rewrite H in Hy; elim (Rlt_irrefl _ Hy). +Proof. + intros y Hy; unfold D_in in |- *. + apply limit1_ext with + (f := fun x:R => / ((exp (ln x) - exp (ln y)) / (ln x - ln y))). + intros x [HD1 HD2]; repeat rewrite exp_ln. + unfold Rdiv in |- *; rewrite Rinv_mult_distr. + rewrite Rinv_involutive. + apply Rmult_comm. + apply Rminus_eq_contra. + red in |- *; intros H2; case HD2. + symmetry in |- *; apply (ln_inv _ _ HD1 Hy H2). + apply Rminus_eq_contra; apply (sym_not_eq HD2). + apply Rinv_neq_0_compat; apply Rminus_eq_contra; red in |- *; intros H2; + case HD2; apply ln_inv; auto. + assumption. + assumption. + apply limit_inv with + (f := fun x:R => (exp (ln x) - exp (ln y)) / (ln x - ln y)). + apply limit1_imp with + (f := fun x:R => (fun x:R => (exp x - exp (ln y)) / (x - ln y)) (ln x)) + (D := Dgf (D_x (fun x:R => 0 < x) y) (D_x (fun x:R => True) (ln y)) ln). + intros x [H1 H2]; split. + split; auto. + split; auto. + red in |- *; intros H3; case H2; apply ln_inv; auto. + apply limit_comp with + (l := ln y) (g := fun x:R => (exp x - exp (ln y)) / (x - ln y)) (f := ln). + apply ln_continue; auto. + assert (H0 := derivable_pt_lim_exp (ln y)); unfold derivable_pt_lim in H0; + unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros; elim (H0 _ H); + intros; exists (pos x); split. + apply (cond_pos x). + intros; pattern y at 3 in |- *; rewrite <- exp_ln. + pattern x0 at 1 in |- *; replace x0 with (ln y + (x0 - ln y)); + [ idtac | ring ]. + apply H1. + elim H2; intros H3 _; unfold D_x in H3; elim H3; clear H3; intros _ H3; + apply Rminus_eq_contra; apply (sym_not_eq (A:=R)); + apply H3. + elim H2; clear H2; intros _ H2; apply H2. + assumption. + red in |- *; intro; rewrite H in Hy; elim (Rlt_irrefl _ Hy). Qed. Lemma derivable_pt_lim_ln : forall x:R, 0 < x -> derivable_pt_lim ln x (/ x). -intros; assert (H0 := Dln x H); unfold D_in in H0; unfold limit1_in in H0; - unfold limit_in in H0; simpl in H0; unfold R_dist in H0; - unfold derivable_pt_lim in |- *; intros; elim (H0 _ H1); - intros; elim H2; clear H2; intros; set (alp := Rmin x0 (x / 2)); - assert (H4 : 0 < alp). -unfold alp in |- *; unfold Rmin in |- *; case (Rle_dec x0 (x / 2)); intro. -apply H2. -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. -exists (mkposreal _ H4); intros; pattern h at 2 in |- *; - replace h with (x + h - x); [ idtac | ring ]. -apply H3; split. -unfold D_x in |- *; split. -case (Rcase_abs h); intro. -assert (H7 : Rabs h < x / 2). -apply Rlt_le_trans with alp. -apply H6. -unfold alp in |- *; apply Rmin_r. -apply Rlt_trans with (x / 2). -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. -rewrite Rabs_left in H7. -apply Rplus_lt_reg_r with (- h - x / 2). -replace (- h - x / 2 + x / 2) with (- h); [ idtac | ring ]. -pattern x at 2 in |- *; rewrite double_var. -replace (- h - x / 2 + (x / 2 + x / 2 + h)) with (x / 2); [ apply H7 | ring ]. -apply r. -apply Rplus_lt_le_0_compat; [ assumption | apply Rge_le; apply r ]. -apply (sym_not_eq (A:=R)); apply Rminus_not_eq; replace (x + h - x) with h; - [ apply H5 | ring ]. -replace (x + h - x) with h; - [ apply Rlt_le_trans with alp; +Proof. + intros; assert (H0 := Dln x H); unfold D_in in H0; unfold limit1_in in H0; + unfold limit_in in H0; simpl in H0; unfold R_dist in H0; + unfold derivable_pt_lim in |- *; intros; elim (H0 _ H1); + intros; elim H2; clear H2; intros; set (alp := Rmin x0 (x / 2)); + assert (H4 : 0 < alp). + unfold alp in |- *; unfold Rmin in |- *; case (Rle_dec x0 (x / 2)); intro. + apply H2. + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. + exists (mkposreal _ H4); intros; pattern h at 2 in |- *; + replace h with (x + h - x); [ idtac | ring ]. + apply H3; split. + unfold D_x in |- *; split. + case (Rcase_abs h); intro. + assert (H7 : Rabs h < x / 2). + apply Rlt_le_trans with alp. + apply H6. + unfold alp in |- *; apply Rmin_r. + apply Rlt_trans with (x / 2). + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. + rewrite Rabs_left in H7. + apply Rplus_lt_reg_r with (- h - x / 2). + replace (- h - x / 2 + x / 2) with (- h); [ idtac | ring ]. + pattern x at 2 in |- *; rewrite double_var. + replace (- h - x / 2 + (x / 2 + x / 2 + h)) with (x / 2); [ apply H7 | ring ]. + apply r. + apply Rplus_lt_le_0_compat; [ assumption | apply Rge_le; apply r ]. + apply (sym_not_eq (A:=R)); apply Rminus_not_eq; replace (x + h - x) with h; + [ apply H5 | ring ]. + replace (x + h - x) with h; + [ apply Rlt_le_trans with alp; [ apply H6 | unfold alp in |- *; apply Rmin_l ] - | ring ]. + | ring ]. Qed. Theorem D_in_imp : - forall (f g:R -> R) (D D1:R -> Prop) (x:R), - (forall x:R, D1 x -> D x) -> D_in f g D x -> D_in f g D1 x. -intros f g D D1 x H; unfold D_in in |- *. -intros H0; apply limit1_imp with (D := D_x D x); auto. -intros x1 [H1 H2]; split; auto. + forall (f g:R -> R) (D D1:R -> Prop) (x:R), + (forall x:R, D1 x -> D x) -> D_in f g D x -> D_in f g D1 x. +Proof. + intros f g D D1 x H; unfold D_in in |- *. + intros H0; apply limit1_imp with (D := D_x D x); auto. + intros x1 [H1 H2]; split; auto. Qed. Theorem D_in_ext : - forall (f g h:R -> R) (D:R -> Prop) (x:R), - f x = g x -> D_in h f D x -> D_in h g D x. -intros f g h D x H; unfold D_in in |- *. -rewrite H; auto. + forall (f g h:R -> R) (D:R -> Prop) (x:R), + f x = g x -> D_in h f D x -> D_in h g D x. +Proof. + intros f g h D x H; unfold D_in in |- *. + rewrite H; auto. Qed. Theorem Dpower : - forall y z:R, - 0 < y -> - D_in (fun x:R => x ^R z) (fun x:R => z * x ^R (z - 1)) ( - fun x:R => 0 < x) y. -intros y z H; - apply D_in_imp with (D := Dgf (fun x:R => 0 < x) (fun x:R => True) ln). -intros x H0; repeat split. -assumption. -apply D_in_ext with (f := fun x:R => / x * (z * exp (z * ln x))). -unfold Rminus in |- *; rewrite Rpower_plus; rewrite Rpower_Ropp; - rewrite (Rpower_1 _ H); ring. -apply Dcomp with - (f := ln) - (g := fun x:R => exp (z * x)) - (df := Rinv) - (dg := fun x:R => z * exp (z * x)). -apply (Dln _ H). -apply D_in_imp with - (D := Dgf (fun x:R => True) (fun x:R => True) (fun x:R => z * x)). -intros x H1; repeat split; auto. -apply - (Dcomp (fun _:R => True) (fun _:R => True) (fun x => z) exp - (fun x:R => z * x) exp); simpl in |- *. -apply D_in_ext with (f := fun x:R => z * 1). -apply Rmult_1_r. -apply (Dmult_const (fun x => True) (fun x => x) (fun x => 1)); apply Dx. -assert (H0 := derivable_pt_lim_D_in exp exp (z * ln y)); elim H0; clear H0; - intros _ H0; apply H0; apply derivable_pt_lim_exp. + forall y z:R, + 0 < y -> + D_in (fun x:R => x ^R z) (fun x:R => z * x ^R (z - 1)) ( + fun x:R => 0 < x) y. +Proof. + intros y z H; + apply D_in_imp with (D := Dgf (fun x:R => 0 < x) (fun x:R => True) ln). + intros x H0; repeat split. + assumption. + apply D_in_ext with (f := fun x:R => / x * (z * exp (z * ln x))). + unfold Rminus in |- *; rewrite Rpower_plus; rewrite Rpower_Ropp; + rewrite (Rpower_1 _ H); unfold Rpower; ring. + apply Dcomp with + (f := ln) + (g := fun x:R => exp (z * x)) + (df := Rinv) + (dg := fun x:R => z * exp (z * x)). + apply (Dln _ H). + apply D_in_imp with + (D := Dgf (fun x:R => True) (fun x:R => True) (fun x:R => z * x)). + intros x H1; repeat split; auto. + apply + (Dcomp (fun _:R => True) (fun _:R => True) (fun x => z) exp + (fun x:R => z * x) exp); simpl in |- *. + apply D_in_ext with (f := fun x:R => z * 1). + apply Rmult_1_r. + apply (Dmult_const (fun x => True) (fun x => x) (fun x => 1)); apply Dx. + assert (H0 := derivable_pt_lim_D_in exp exp (z * ln y)); elim H0; clear H0; + intros _ H0; apply H0; apply derivable_pt_lim_exp. Qed. Theorem derivable_pt_lim_power : - forall x y:R, - 0 < x -> derivable_pt_lim (fun x => x ^R y) x (y * x ^R (y - 1)). -intros x y H. -unfold Rminus in |- *; rewrite Rpower_plus. -rewrite Rpower_Ropp. -rewrite Rpower_1; auto. -rewrite <- Rmult_assoc. -unfold Rpower in |- *. -apply derivable_pt_lim_comp with (f1 := ln) (f2 := fun x => exp (y * x)). -apply derivable_pt_lim_ln; assumption. -rewrite (Rmult_comm y). -apply derivable_pt_lim_comp with (f1 := fun x => y * x) (f2 := exp). -pattern y at 2 in |- *; replace y with (0 * ln x + y * 1). -apply derivable_pt_lim_mult with (f1 := fun x:R => y) (f2 := fun x:R => x). -apply derivable_pt_lim_const with (a := y). -apply derivable_pt_lim_id. -ring. -apply derivable_pt_lim_exp. + forall x y:R, + 0 < x -> derivable_pt_lim (fun x => x ^R y) x (y * x ^R (y - 1)). +Proof. + intros x y H. + unfold Rminus in |- *; rewrite Rpower_plus. + rewrite Rpower_Ropp. + rewrite Rpower_1; auto. + rewrite <- Rmult_assoc. + unfold Rpower in |- *. + apply derivable_pt_lim_comp with (f1 := ln) (f2 := fun x => exp (y * x)). + apply derivable_pt_lim_ln; assumption. + rewrite (Rmult_comm y). + apply derivable_pt_lim_comp with (f1 := fun x => y * x) (f2 := exp). + pattern y at 2 in |- *; replace y with (0 * ln x + y * 1). + apply derivable_pt_lim_mult with (f1 := fun x:R => y) (f2 := fun x:R => x). + apply derivable_pt_lim_const with (a := y). + apply derivable_pt_lim_id. + ring. + apply derivable_pt_lim_exp. Qed. diff --git a/theories/Reals/Rprod.v b/theories/Reals/Rprod.v index ec738996..a84d5149 100644 --- a/theories/Reals/Rprod.v +++ b/theories/Reals/Rprod.v @@ -5,8 +5,8 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) - -(*i $Id: Rprod.v 6338 2004-11-22 09:10:51Z gregoire $ i*) + +(*i $Id: Rprod.v 9298 2006-10-27 13:05:29Z notin $ i*) Require Import Compare. Require Import Rbase. @@ -16,176 +16,156 @@ Require Import PartSum. Require Import Binomial. Open Local Scope R_scope. -(* TT Ak; 1<=k<=N *) +(** TT Ak; 1<=k<=N *) Boxed Fixpoint prod_f_SO (An:nat -> R) (N:nat) {struct N} : R := match N with - | O => 1 - | S p => prod_f_SO An p * An (S p) + | O => 1 + | S p => prod_f_SO An p * An (S p) end. (**********) Lemma prod_SO_split : - forall (An:nat -> R) (n k:nat), - (k <= n)%nat -> - prod_f_SO An n = - prod_f_SO An k * prod_f_SO (fun l:nat => An (k + l)%nat) (n - k). -intros; induction n as [| n Hrecn]. -cut (k = 0%nat); - [ intro; rewrite H0; simpl in |- *; ring | inversion H; reflexivity ]. -cut (k = S n \/ (k <= n)%nat). -intro; elim H0; intro. -rewrite H1; simpl in |- *; rewrite <- minus_n_n; simpl in |- *; ring. -replace (S n - k)%nat with (S (n - k)). -simpl in |- *; replace (k + S (n - k))%nat with (S n). -rewrite Hrecn; [ ring | assumption ]. -apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite S_INR; - rewrite minus_INR; [ ring | assumption ]. -apply INR_eq; rewrite S_INR; repeat rewrite minus_INR. -rewrite S_INR; ring. -apply le_trans with n; [ assumption | apply le_n_Sn ]. -assumption. -inversion H; [ left; reflexivity | right; assumption ]. + forall (An:nat -> R) (n k:nat), + (k <= n)%nat -> + prod_f_SO An n = + prod_f_SO An k * prod_f_SO (fun l:nat => An (k + l)%nat) (n - k). +Proof. + intros; induction n as [| n Hrecn]. + cut (k = 0%nat); + [ intro; rewrite H0; simpl in |- *; ring | inversion H; reflexivity ]. + cut (k = S n \/ (k <= n)%nat). + intro; elim H0; intro. + rewrite H1; simpl in |- *; rewrite <- minus_n_n; simpl in |- *; ring. + replace (S n - k)%nat with (S (n - k)). + simpl in |- *; replace (k + S (n - k))%nat with (S n). + rewrite Hrecn; [ ring | assumption ]. + omega. + omega. + omega. Qed. (**********) Lemma prod_SO_pos : - forall (An:nat -> R) (N:nat), - (forall n:nat, (n <= N)%nat -> 0 <= An n) -> 0 <= prod_f_SO An N. -intros; induction N as [| N HrecN]. -simpl in |- *; left; apply Rlt_0_1. -simpl in |- *; apply Rmult_le_pos. -apply HrecN; intros; apply H; apply le_trans with N; - [ assumption | apply le_n_Sn ]. -apply H; apply le_n. + forall (An:nat -> R) (N:nat), + (forall n:nat, (n <= N)%nat -> 0 <= An n) -> 0 <= prod_f_SO An N. +Proof. + intros; induction N as [| N HrecN]. + simpl in |- *; left; apply Rlt_0_1. + simpl in |- *; apply Rmult_le_pos. + apply HrecN; intros; apply H; apply le_trans with N; + [ assumption | apply le_n_Sn ]. + apply H; apply le_n. Qed. (**********) Lemma prod_SO_Rle : - forall (An Bn:nat -> R) (N:nat), - (forall n:nat, (n <= N)%nat -> 0 <= An n <= Bn n) -> - prod_f_SO An N <= prod_f_SO Bn N. -intros; induction N as [| N HrecN]. -right; reflexivity. -simpl in |- *; apply Rle_trans with (prod_f_SO An N * Bn (S N)). -apply Rmult_le_compat_l. -apply prod_SO_pos; intros; elim (H n (le_trans _ _ _ H0 (le_n_Sn N))); intros; - assumption. -elim (H (S N) (le_n (S N))); intros; assumption. -do 2 rewrite <- (Rmult_comm (Bn (S N))); apply Rmult_le_compat_l. -elim (H (S N) (le_n (S N))); intros. -apply Rle_trans with (An (S N)); assumption. -apply HrecN; intros; elim (H n (le_trans _ _ _ H0 (le_n_Sn N))); intros; - split; assumption. + forall (An Bn:nat -> R) (N:nat), + (forall n:nat, (n <= N)%nat -> 0 <= An n <= Bn n) -> + prod_f_SO An N <= prod_f_SO Bn N. +Proof. + intros; induction N as [| N HrecN]. + right; reflexivity. + simpl in |- *; apply Rle_trans with (prod_f_SO An N * Bn (S N)). + apply Rmult_le_compat_l. + apply prod_SO_pos; intros; elim (H n (le_trans _ _ _ H0 (le_n_Sn N))); intros; + assumption. + elim (H (S N) (le_n (S N))); intros; assumption. + do 2 rewrite <- (Rmult_comm (Bn (S N))); apply Rmult_le_compat_l. + elim (H (S N) (le_n (S N))); intros. + apply Rle_trans with (An (S N)); assumption. + apply HrecN; intros; elim (H n (le_trans _ _ _ H0 (le_n_Sn N))); intros; + split; assumption. Qed. -(* Application to factorial *) +(** Application to factorial *) Lemma fact_prodSO : - forall n:nat, INR (fact n) = prod_f_SO (fun k:nat => INR k) n. -intro; induction n as [| n Hrecn]. -reflexivity. -change (INR (S n * fact n) = prod_f_SO (fun k:nat => INR k) (S n)) in |- *. -rewrite mult_INR; rewrite Rmult_comm; rewrite Hrecn; reflexivity. + forall n:nat, INR (fact n) = prod_f_SO (fun k:nat => INR k) n. +Proof. + intro; induction n as [| n Hrecn]. + reflexivity. + change (INR (S n * fact n) = prod_f_SO (fun k:nat => INR k) (S n)) in |- *. + rewrite mult_INR; rewrite Rmult_comm; rewrite Hrecn; reflexivity. Qed. Lemma le_n_2n : forall n:nat, (n <= 2 * n)%nat. -simple induction n. -replace (2 * 0)%nat with 0%nat; [ apply le_n | ring ]. -intros; replace (2 * S n0)%nat with (S (S (2 * n0))). -apply le_n_S; apply le_S; assumption. -replace (S (S (2 * n0))) with (2 * n0 + 2)%nat; [ idtac | ring ]. -replace (S n0) with (n0 + 1)%nat; [ idtac | ring ]. -ring. +Proof. + simple induction n. + replace (2 * 0)%nat with 0%nat; [ apply le_n | ring ]. + intros; replace (2 * S n0)%nat with (S (S (2 * n0))). + apply le_n_S; apply le_S; assumption. + replace (S (S (2 * n0))) with (2 * n0 + 2)%nat; [ idtac | ring ]. + replace (S n0) with (n0 + 1)%nat; [ idtac | ring ]. + ring. Qed. -(* We prove that (N!)²<=(2N-k)!*k! forall k in [|O;2N|] *) +(** We prove that (N!)^2<=(2N-k)!*k! forall k in [|O;2N|] *) Lemma RfactN_fact2N_factk : - forall N k:nat, - (k <= 2 * N)%nat -> - Rsqr (INR (fact N)) <= INR (fact (2 * N - k)) * INR (fact k). -intros; unfold Rsqr in |- *; repeat rewrite fact_prodSO. -cut ((k <= N)%nat \/ (N <= k)%nat). -intro; elim H0; intro. -rewrite (prod_SO_split (fun l:nat => INR l) (2 * N - k) N). -rewrite Rmult_assoc; apply Rmult_le_compat_l. -apply prod_SO_pos; intros; apply pos_INR. -replace (2 * N - k - N)%nat with (N - k)%nat. -rewrite Rmult_comm; rewrite (prod_SO_split (fun l:nat => INR l) N k). -apply Rmult_le_compat_l. -apply prod_SO_pos; intros; apply pos_INR. -apply prod_SO_Rle; intros; split. -apply pos_INR. -apply le_INR; apply plus_le_compat_r; assumption. -assumption. -apply INR_eq; repeat rewrite minus_INR. -rewrite mult_INR; repeat rewrite S_INR; ring. -apply le_trans with N; [ assumption | apply le_n_2n ]. -apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus. -replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ]. -apply plus_le_compat_r; assumption. -assumption. -assumption. -apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus. -replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ]. -apply plus_le_compat_r; assumption. -assumption. -rewrite <- (Rmult_comm (prod_f_SO (fun l:nat => INR l) k)); - rewrite (prod_SO_split (fun l:nat => INR l) k N). -rewrite Rmult_assoc; apply Rmult_le_compat_l. -apply prod_SO_pos; intros; apply pos_INR. -rewrite Rmult_comm; - rewrite (prod_SO_split (fun l:nat => INR l) N (2 * N - k)). -apply Rmult_le_compat_l. -apply prod_SO_pos; intros; apply pos_INR. -replace (N - (2 * N - k))%nat with (k - N)%nat. -apply prod_SO_Rle; intros; split. -apply pos_INR. -apply le_INR; apply plus_le_compat_r. -apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus. -replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ]; - apply plus_le_compat_r; assumption. -assumption. -apply INR_eq; repeat rewrite minus_INR. -rewrite mult_INR; do 2 rewrite S_INR; ring. -assumption. -apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus. -replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ]; - apply plus_le_compat_r; assumption. -assumption. -assumption. -apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus. -replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ]; - apply plus_le_compat_r; assumption. -assumption. -assumption. -elim (le_dec k N); intro; [ left; assumption | right; assumption ]. + forall N k:nat, + (k <= 2 * N)%nat -> + Rsqr (INR (fact N)) <= INR (fact (2 * N - k)) * INR (fact k). +Proof. + intros; unfold Rsqr in |- *; repeat rewrite fact_prodSO. + cut ((k <= N)%nat \/ (N <= k)%nat). + intro; elim H0; intro. + rewrite (prod_SO_split (fun l:nat => INR l) (2 * N - k) N). + rewrite Rmult_assoc; apply Rmult_le_compat_l. + apply prod_SO_pos; intros; apply pos_INR. + replace (2 * N - k - N)%nat with (N - k)%nat. + rewrite Rmult_comm; rewrite (prod_SO_split (fun l:nat => INR l) N k). + apply Rmult_le_compat_l. + apply prod_SO_pos; intros; apply pos_INR. + apply prod_SO_Rle; intros; split. + apply pos_INR. + apply le_INR; apply plus_le_compat_r; assumption. + assumption. + omega. + omega. + rewrite <- (Rmult_comm (prod_f_SO (fun l:nat => INR l) k)); + rewrite (prod_SO_split (fun l:nat => INR l) k N). + rewrite Rmult_assoc; apply Rmult_le_compat_l. + apply prod_SO_pos; intros; apply pos_INR. + rewrite Rmult_comm; + rewrite (prod_SO_split (fun l:nat => INR l) N (2 * N - k)). + apply Rmult_le_compat_l. + apply prod_SO_pos; intros; apply pos_INR. + replace (N - (2 * N - k))%nat with (k - N)%nat. + apply prod_SO_Rle; intros; split. + apply pos_INR. + apply le_INR; apply plus_le_compat_r. + omega. + omega. + omega. + assumption. + omega. Qed. (**********) Lemma INR_fact_lt_0 : forall n:nat, 0 < INR (fact n). -intro; apply lt_INR_0; apply neq_O_lt; red in |- *; intro; - elim (fact_neq_0 n); symmetry in |- *; assumption. +Proof. + intro; apply lt_INR_0; apply neq_O_lt; red in |- *; intro; + elim (fact_neq_0 n); symmetry in |- *; assumption. Qed. -(* We have the following inequality : (C 2N k) <= (C 2N N) forall k in [|O;2N|] *) +(** We have the following inequality : (C 2N k) <= (C 2N N) forall k in [|O;2N|] *) Lemma C_maj : forall N k:nat, (k <= 2 * N)%nat -> C (2 * N) k <= C (2 * N) N. -intros; unfold C in |- *; unfold Rdiv in |- *; apply Rmult_le_compat_l. -apply pos_INR. -replace (2 * N - N)%nat with N. -apply Rmult_le_reg_l with (INR (fact N) * INR (fact N)). -apply Rmult_lt_0_compat; apply INR_fact_lt_0. -rewrite <- Rinv_r_sym. -rewrite Rmult_comm; - apply Rmult_le_reg_l with (INR (fact k) * INR (fact (2 * N - k))). -apply Rmult_lt_0_compat; apply INR_fact_lt_0. -rewrite Rmult_1_r; rewrite <- mult_INR; rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym. -rewrite Rmult_1_l; rewrite mult_INR; rewrite (Rmult_comm (INR (fact k))); - replace (INR (fact N) * INR (fact N)) with (Rsqr (INR (fact N))). -apply RfactN_fact2N_factk. -assumption. -reflexivity. -rewrite mult_INR; apply prod_neq_R0; apply INR_fact_neq_0. -apply prod_neq_R0; apply INR_fact_neq_0. -apply INR_eq; rewrite minus_INR; - [ rewrite mult_INR; do 2 rewrite S_INR; ring | apply le_n_2n ]. +Proof. + intros; unfold C in |- *; unfold Rdiv in |- *; apply Rmult_le_compat_l. + apply pos_INR. + replace (2 * N - N)%nat with N. + apply Rmult_le_reg_l with (INR (fact N) * INR (fact N)). + apply Rmult_lt_0_compat; apply INR_fact_lt_0. + rewrite <- Rinv_r_sym. + rewrite Rmult_comm; + apply Rmult_le_reg_l with (INR (fact k) * INR (fact (2 * N - k))). + apply Rmult_lt_0_compat; apply INR_fact_lt_0. + rewrite Rmult_1_r; rewrite <- mult_INR; rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. + rewrite Rmult_1_l; rewrite mult_INR; rewrite (Rmult_comm (INR (fact k))); + replace (INR (fact N) * INR (fact N)) with (Rsqr (INR (fact N))). + apply RfactN_fact2N_factk. + assumption. + reflexivity. + rewrite mult_INR; apply prod_neq_R0; apply INR_fact_neq_0. + apply prod_neq_R0; apply INR_fact_neq_0. + omega. Qed. diff --git a/theories/Reals/Rseries.v b/theories/Reals/Rseries.v index aa3a0316..38c39bae 100644 --- a/theories/Reals/Rseries.v +++ b/theories/Reals/Rseries.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Rseries.v 6338 2004-11-22 09:10:51Z gregoire $ i*) +(*i $Id: Rseries.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -18,258 +18,266 @@ Implicit Type r : R. (* classical is needed for [Un_cv_crit] *) (*********************************************************) -(* Definition of sequence and properties *) +(** * Definition of sequence and properties *) (* *) (*********************************************************) Section sequence. (*********) -Variable Un : nat -> R. + Variable Un : nat -> R. (*********) -Boxed Fixpoint Rmax_N (N:nat) : R := - match N with - | O => Un 0 - | S n => Rmax (Un (S n)) (Rmax_N n) - end. + Boxed Fixpoint Rmax_N (N:nat) : R := + match N with + | O => Un 0 + | S n => Rmax (Un (S n)) (Rmax_N n) + end. (*********) -Definition EUn r : Prop := exists i : nat, r = Un i. + Definition EUn r : Prop := exists i : nat, r = Un i. (*********) -Definition Un_cv (l:R) : Prop := - forall eps:R, - eps > 0 -> - exists N : nat, (forall n:nat, (n >= N)%nat -> R_dist (Un n) l < eps). + Definition Un_cv (l:R) : Prop := + forall eps:R, + eps > 0 -> + exists N : nat, (forall n:nat, (n >= N)%nat -> R_dist (Un n) l < eps). (*********) -Definition Cauchy_crit : Prop := - forall eps:R, - eps > 0 -> - exists N : nat, - (forall n m:nat, - (n >= N)%nat -> (m >= N)%nat -> R_dist (Un n) (Un m) < eps). + Definition Cauchy_crit : Prop := + forall eps:R, + eps > 0 -> + exists N : nat, + (forall n m:nat, + (n >= N)%nat -> (m >= N)%nat -> R_dist (Un n) (Un m) < eps). (*********) -Definition Un_growing : Prop := forall n:nat, Un n <= Un (S n). + Definition Un_growing : Prop := forall n:nat, Un n <= Un (S n). (*********) -Lemma EUn_noempty : exists r : R, EUn r. -unfold EUn in |- *; split with (Un 0); split with 0%nat; trivial. -Qed. + Lemma EUn_noempty : exists r : R, EUn r. + Proof. + unfold EUn in |- *; split with (Un 0); split with 0%nat; trivial. + Qed. (*********) -Lemma Un_in_EUn : forall n:nat, EUn (Un n). -intro; unfold EUn in |- *; split with n; trivial. -Qed. + Lemma Un_in_EUn : forall n:nat, EUn (Un n). + Proof. + intro; unfold EUn in |- *; split with n; trivial. + Qed. (*********) -Lemma Un_bound_imp : - forall x:R, (forall n:nat, Un n <= x) -> is_upper_bound EUn x. -intros; unfold is_upper_bound in |- *; intros; unfold EUn in H0; elim H0; - clear H0; intros; generalize (H x1); intro; rewrite <- H0 in H1; - trivial. -Qed. + Lemma Un_bound_imp : + forall x:R, (forall n:nat, Un n <= x) -> is_upper_bound EUn x. + Proof. + intros; unfold is_upper_bound in |- *; intros; unfold EUn in H0; elim H0; + clear H0; intros; generalize (H x1); intro; rewrite <- H0 in H1; + trivial. + Qed. (*********) -Lemma growing_prop : - forall n m:nat, Un_growing -> (n >= m)%nat -> Un n >= Un m. -double induction n m; intros. -unfold Rge in |- *; right; trivial. -elimtype False; unfold ge in H1; generalize (le_Sn_O n0); intro; auto. -cut (n0 >= 0)%nat. -generalize H0; intros; unfold Un_growing in H0; - apply - (Rge_trans (Un (S n0)) (Un n0) (Un 0) (Rle_ge (Un n0) (Un (S n0)) (H0 n0)) - (H 0%nat H2 H3)). -elim n0; auto. -elim (lt_eq_lt_dec n1 n0); intro y. -elim y; clear y; intro y. -unfold ge in H2; generalize (le_not_lt n0 n1 (le_S_n n0 n1 H2)); intro; - elimtype False; auto. -rewrite y; unfold Rge in |- *; right; trivial. -unfold ge in H0; generalize (H0 (S n0) H1 (lt_le_S n0 n1 y)); intro; - unfold Un_growing in H1; - apply - (Rge_trans (Un (S n1)) (Un n1) (Un (S n0)) - (Rle_ge (Un n1) (Un (S n1)) (H1 n1)) H3). -Qed. + Lemma growing_prop : + forall n m:nat, Un_growing -> (n >= m)%nat -> Un n >= Un m. + Proof. + double induction n m; intros. + unfold Rge in |- *; right; trivial. + elimtype False; unfold ge in H1; generalize (le_Sn_O n0); intro; auto. + cut (n0 >= 0)%nat. + generalize H0; intros; unfold Un_growing in H0; + apply + (Rge_trans (Un (S n0)) (Un n0) (Un 0) (Rle_ge (Un n0) (Un (S n0)) (H0 n0)) + (H 0%nat H2 H3)). + elim n0; auto. + elim (lt_eq_lt_dec n1 n0); intro y. + elim y; clear y; intro y. + unfold ge in H2; generalize (le_not_lt n0 n1 (le_S_n n0 n1 H2)); intro; + elimtype False; auto. + rewrite y; unfold Rge in |- *; right; trivial. + unfold ge in H0; generalize (H0 (S n0) H1 (lt_le_S n0 n1 y)); intro; + unfold Un_growing in H1; + apply + (Rge_trans (Un (S n1)) (Un n1) (Un (S n0)) + (Rle_ge (Un n1) (Un (S n1)) (H1 n1)) H3). + Qed. -(* classical is needed: [not_all_not_ex] *) +(** classical is needed: [not_all_not_ex] *) (*********) -Lemma Un_cv_crit : Un_growing -> bound EUn -> exists l : R, Un_cv l. -unfold Un_growing, Un_cv in |- *; intros; - generalize (completeness_weak EUn H0 EUn_noempty); - intro; elim H1; clear H1; intros; split with x; intros; - unfold is_lub in H1; unfold bound in H0; unfold is_upper_bound in H0, H1; - elim H0; clear H0; intros; elim H1; clear H1; intros; - generalize (H3 x0 H0); intro; cut (forall n:nat, Un n <= x); - intro. -cut (exists N : nat, x - eps < Un N). -intro; elim H6; clear H6; intros; split with x1. -intros; unfold R_dist in |- *; apply (Rabs_def1 (Un n - x) eps). -unfold Rgt in H2; - apply (Rle_lt_trans (Un n - x) 0 eps (Rle_minus (Un n) x (H5 n)) H2). -fold Un_growing in H; generalize (growing_prop n x1 H H7); intro; - generalize - (Rlt_le_trans (x - eps) (Un x1) (Un n) H6 (Rge_le (Un n) (Un x1) H8)); - intro; generalize (Rplus_lt_compat_l (- x) (x - eps) (Un n) H9); - unfold Rminus in |- *; rewrite <- (Rplus_assoc (- x) x (- eps)); - rewrite (Rplus_comm (- x) (Un n)); fold (Un n - x) in |- *; - rewrite Rplus_opp_l; rewrite (let (H1, H2) := Rplus_ne (- eps) in H2); - trivial. -cut (~ (forall N:nat, x - eps >= Un N)). -intro; apply (not_all_not_ex nat (fun N:nat => x - eps < Un N)); red in |- *; - intro; red in H6; elim H6; clear H6; intro; - apply (Rnot_lt_ge (x - eps) (Un N) (H7 N)). -red in |- *; intro; cut (forall N:nat, Un N <= x - eps). -intro; generalize (Un_bound_imp (x - eps) H7); intro; - unfold is_upper_bound in H8; generalize (H3 (x - eps) H8); - intro; generalize (Rle_minus x (x - eps) H9); unfold Rminus in |- *; - rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r; - rewrite (let (H1, H2) := Rplus_ne (- - eps) in H2); - rewrite Ropp_involutive; intro; unfold Rgt in H2; - generalize (Rgt_not_le eps 0 H2); intro; auto. -intro; elim (H6 N); intro; unfold Rle in |- *. -left; unfold Rgt in H7; assumption. -right; auto. -apply (H1 (Un n) (Un_in_EUn n)). -Qed. + Lemma Un_cv_crit : Un_growing -> bound EUn -> exists l : R, Un_cv l. + Proof. + unfold Un_growing, Un_cv in |- *; intros; + generalize (completeness_weak EUn H0 EUn_noempty); + intro; elim H1; clear H1; intros; split with x; intros; + unfold is_lub in H1; unfold bound in H0; unfold is_upper_bound in H0, H1; + elim H0; clear H0; intros; elim H1; clear H1; intros; + generalize (H3 x0 H0); intro; cut (forall n:nat, Un n <= x); + intro. + cut (exists N : nat, x - eps < Un N). + intro; elim H6; clear H6; intros; split with x1. + intros; unfold R_dist in |- *; apply (Rabs_def1 (Un n - x) eps). + unfold Rgt in H2; + apply (Rle_lt_trans (Un n - x) 0 eps (Rle_minus (Un n) x (H5 n)) H2). + fold Un_growing in H; generalize (growing_prop n x1 H H7); intro; + generalize + (Rlt_le_trans (x - eps) (Un x1) (Un n) H6 (Rge_le (Un n) (Un x1) H8)); + intro; generalize (Rplus_lt_compat_l (- x) (x - eps) (Un n) H9); + unfold Rminus in |- *; rewrite <- (Rplus_assoc (- x) x (- eps)); + rewrite (Rplus_comm (- x) (Un n)); fold (Un n - x) in |- *; + rewrite Rplus_opp_l; rewrite (let (H1, H2) := Rplus_ne (- eps) in H2); + trivial. + cut (~ (forall N:nat, x - eps >= Un N)). + intro; apply (not_all_not_ex nat (fun N:nat => x - eps < Un N)); red in |- *; + intro; red in H6; elim H6; clear H6; intro; + apply (Rnot_lt_ge (x - eps) (Un N) (H7 N)). + red in |- *; intro; cut (forall N:nat, Un N <= x - eps). + intro; generalize (Un_bound_imp (x - eps) H7); intro; + unfold is_upper_bound in H8; generalize (H3 (x - eps) H8); + intro; generalize (Rle_minus x (x - eps) H9); unfold Rminus in |- *; + rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r; + rewrite (let (H1, H2) := Rplus_ne (- - eps) in H2); + rewrite Ropp_involutive; intro; unfold Rgt in H2; + generalize (Rgt_not_le eps 0 H2); intro; auto. + intro; elim (H6 N); intro; unfold Rle in |- *. + left; unfold Rgt in H7; assumption. + right; auto. + apply (H1 (Un n) (Un_in_EUn n)). + Qed. (*********) -Lemma finite_greater : - forall N:nat, exists M : R, (forall n:nat, (n <= N)%nat -> Un n <= M). -intro; induction N as [| N HrecN]. -split with (Un 0); intros; rewrite (le_n_O_eq n H); - apply (Req_le (Un n) (Un n) (refl_equal (Un n))). -elim HrecN; clear HrecN; intros; split with (Rmax (Un (S N)) x); intros; - elim (Rmax_Rle (Un (S N)) x (Un n)); intros; clear H1; - inversion H0. -rewrite <- H1; rewrite <- H1 in H2; - apply - (H2 (or_introl (Un n <= x) (Req_le (Un n) (Un n) (refl_equal (Un n))))). -apply (H2 (or_intror (Un n <= Un (S N)) (H n H3))). -Qed. + Lemma finite_greater : + forall N:nat, exists M : R, (forall n:nat, (n <= N)%nat -> Un n <= M). + Proof. + intro; induction N as [| N HrecN]. + split with (Un 0); intros; rewrite (le_n_O_eq n H); + apply (Req_le (Un n) (Un n) (refl_equal (Un n))). + elim HrecN; clear HrecN; intros; split with (Rmax (Un (S N)) x); intros; + elim (Rmax_Rle (Un (S N)) x (Un n)); intros; clear H1; + inversion H0. + rewrite <- H1; rewrite <- H1 in H2; + apply + (H2 (or_introl (Un n <= x) (Req_le (Un n) (Un n) (refl_equal (Un n))))). + apply (H2 (or_intror (Un n <= Un (S N)) (H n H3))). + Qed. (*********) -Lemma cauchy_bound : Cauchy_crit -> bound EUn. -unfold Cauchy_crit, bound in |- *; intros; unfold is_upper_bound in |- *; - unfold Rgt in H; elim (H 1 Rlt_0_1); clear H; intros; - generalize (H x); intro; generalize (le_dec x); intro; - elim (finite_greater x); intros; split with (Rmax x0 (Un x + 1)); - clear H; intros; unfold EUn in H; elim H; clear H; - intros; elim (H1 x2); clear H1; intro y. -unfold ge in H0; generalize (H0 x2 (le_n x) y); clear H0; intro; - rewrite <- H in H0; unfold R_dist in H0; elim (Rabs_def2 (Un x - x1) 1 H0); - clear H0; intros; elim (Rmax_Rle x0 (Un x + 1) x1); - intros; apply H4; clear H3 H4; right; clear H H0 y; - apply (Rlt_le x1 (Un x + 1)); generalize (Rlt_minus (-1) (Un x - x1) H1); - clear H1; intro; apply (Rminus_lt x1 (Un x + 1)); - cut (-1 - (Un x - x1) = x1 - (Un x + 1)); - [ intro; rewrite H0 in H; assumption | ring ]. -generalize (H2 x2 y); clear H2 H0; intro; rewrite <- H in H0; - elim (Rmax_Rle x0 (Un x + 1) x1); intros; clear H1; - apply H2; left; assumption. -Qed. + Lemma cauchy_bound : Cauchy_crit -> bound EUn. + Proof. + unfold Cauchy_crit, bound in |- *; intros; unfold is_upper_bound in |- *; + unfold Rgt in H; elim (H 1 Rlt_0_1); clear H; intros; + generalize (H x); intro; generalize (le_dec x); intro; + elim (finite_greater x); intros; split with (Rmax x0 (Un x + 1)); + clear H; intros; unfold EUn in H; elim H; clear H; + intros; elim (H1 x2); clear H1; intro y. + unfold ge in H0; generalize (H0 x2 (le_n x) y); clear H0; intro; + rewrite <- H in H0; unfold R_dist in H0; elim (Rabs_def2 (Un x - x1) 1 H0); + clear H0; intros; elim (Rmax_Rle x0 (Un x + 1) x1); + intros; apply H4; clear H3 H4; right; clear H H0 y; + apply (Rlt_le x1 (Un x + 1)); generalize (Rlt_minus (-1) (Un x - x1) H1); + clear H1; intro; apply (Rminus_lt x1 (Un x + 1)); + cut (-1 - (Un x - x1) = x1 - (Un x + 1)); + [ intro; rewrite H0 in H; assumption | ring ]. + generalize (H2 x2 y); clear H2 H0; intro; rewrite <- H in H0; + elim (Rmax_Rle x0 (Un x + 1) x1); intros; clear H1; + apply H2; left; assumption. + Qed. End sequence. (*****************************************************************) -(* Definition of Power Series and properties *) +(** * Definition of Power Series and properties *) (* *) (*****************************************************************) Section Isequence. (*********) -Variable An : nat -> R. + Variable An : nat -> R. (*********) -Definition Pser (x l:R) : Prop := infinit_sum (fun n:nat => An n * x ^ n) l. + Definition Pser (x l:R) : Prop := infinit_sum (fun n:nat => An n * x ^ n) l. End Isequence. Lemma GP_infinite : - forall x:R, Rabs x < 1 -> Pser (fun n:nat => 1) x (/ (1 - x)). -intros; unfold Pser in |- *; unfold infinit_sum in |- *; intros; - elim (Req_dec x 0). -intros; exists 0%nat; intros; rewrite H1; rewrite Rminus_0_r; rewrite Rinv_1; - cut (sum_f_R0 (fun n0:nat => 1 * 0 ^ n0) n = 1). -intros; rewrite H3; rewrite R_dist_eq; auto. -elim n; simpl in |- *. -ring. -intros; rewrite H3; ring. -intro; cut (0 < eps * (Rabs (1 - x) * Rabs (/ x))). -intro; elim (pow_lt_1_zero x H (eps * (Rabs (1 - x) * Rabs (/ x))) H2); - intro N; intros; exists N; intros; - cut - (sum_f_R0 (fun n0:nat => 1 * x ^ n0) n = sum_f_R0 (fun n0:nat => x ^ n0) n). -intros; rewrite H5; - apply - (Rmult_lt_reg_l (Rabs (1 - x)) - (R_dist (sum_f_R0 (fun n0:nat => x ^ n0) n) (/ (1 - x))) eps). -apply Rabs_pos_lt. -apply Rminus_eq_contra. -apply Rlt_dichotomy_converse. -right; unfold Rgt in |- *. -apply (Rle_lt_trans x (Rabs x) 1). -apply RRle_abs. -assumption. -unfold R_dist in |- *; rewrite <- Rabs_mult. -rewrite Rmult_minus_distr_l. -cut - ((1 - x) * sum_f_R0 (fun n0:nat => x ^ n0) n = - - (sum_f_R0 (fun n0:nat => x ^ n0) n * (x - 1))). -intro; rewrite H6. -rewrite GP_finite. -rewrite Rinv_r. -cut (- (x ^ (n + 1) - 1) - 1 = - x ^ (n + 1)). -intro; rewrite H7. -rewrite Rabs_Ropp; cut ((n + 1)%nat = S n); auto. -intro H8; rewrite H8; simpl in |- *; rewrite Rabs_mult; - apply - (Rlt_le_trans (Rabs x * Rabs (x ^ n)) - (Rabs x * (eps * (Rabs (1 - x) * Rabs (/ x)))) ( - Rabs (1 - x) * eps)). -apply Rmult_lt_compat_l. -apply Rabs_pos_lt. -assumption. -auto. -cut - (Rabs x * (eps * (Rabs (1 - x) * Rabs (/ x))) = - Rabs x * Rabs (/ x) * (eps * Rabs (1 - x))). -clear H8; intros; rewrite H8; rewrite <- Rabs_mult; rewrite Rinv_r. -rewrite Rabs_R1; cut (1 * (eps * Rabs (1 - x)) = Rabs (1 - x) * eps). -intros; rewrite H9; unfold Rle in |- *; right; reflexivity. -ring. -assumption. -ring. -ring. -ring. -apply Rminus_eq_contra. -apply Rlt_dichotomy_converse. -right; unfold Rgt in |- *. -apply (Rle_lt_trans x (Rabs x) 1). -apply RRle_abs. -assumption. -ring; ring. -elim n; simpl in |- *. -ring. -intros; rewrite H5. -ring. -apply Rmult_lt_0_compat. -auto. -apply Rmult_lt_0_compat. -apply Rabs_pos_lt. -apply Rminus_eq_contra. -apply Rlt_dichotomy_converse. -right; unfold Rgt in |- *. -apply (Rle_lt_trans x (Rabs x) 1). -apply RRle_abs. -assumption. -apply Rabs_pos_lt. -apply Rinv_neq_0_compat. -assumption. + forall x:R, Rabs x < 1 -> Pser (fun n:nat => 1) x (/ (1 - x)). +Proof. + intros; unfold Pser in |- *; unfold infinit_sum in |- *; intros; + elim (Req_dec x 0). + intros; exists 0%nat; intros; rewrite H1; rewrite Rminus_0_r; rewrite Rinv_1; + cut (sum_f_R0 (fun n0:nat => 1 * 0 ^ n0) n = 1). + intros; rewrite H3; rewrite R_dist_eq; auto. + elim n; simpl in |- *. + ring. + intros; rewrite H3; ring. + intro; cut (0 < eps * (Rabs (1 - x) * Rabs (/ x))). + intro; elim (pow_lt_1_zero x H (eps * (Rabs (1 - x) * Rabs (/ x))) H2); + intro N; intros; exists N; intros; + cut + (sum_f_R0 (fun n0:nat => 1 * x ^ n0) n = sum_f_R0 (fun n0:nat => x ^ n0) n). + intros; rewrite H5; + apply + (Rmult_lt_reg_l (Rabs (1 - x)) + (R_dist (sum_f_R0 (fun n0:nat => x ^ n0) n) (/ (1 - x))) eps). + apply Rabs_pos_lt. + apply Rminus_eq_contra. + apply Rlt_dichotomy_converse. + right; unfold Rgt in |- *. + apply (Rle_lt_trans x (Rabs x) 1). + apply RRle_abs. + assumption. + unfold R_dist in |- *; rewrite <- Rabs_mult. + rewrite Rmult_minus_distr_l. + cut + ((1 - x) * sum_f_R0 (fun n0:nat => x ^ n0) n = + - (sum_f_R0 (fun n0:nat => x ^ n0) n * (x - 1))). + intro; rewrite H6. + rewrite GP_finite. + rewrite Rinv_r. + cut (- (x ^ (n + 1) - 1) - 1 = - x ^ (n + 1)). + intro; rewrite H7. + rewrite Rabs_Ropp; cut ((n + 1)%nat = S n); auto. + intro H8; rewrite H8; simpl in |- *; rewrite Rabs_mult; + apply + (Rlt_le_trans (Rabs x * Rabs (x ^ n)) + (Rabs x * (eps * (Rabs (1 - x) * Rabs (/ x)))) ( + Rabs (1 - x) * eps)). + apply Rmult_lt_compat_l. + apply Rabs_pos_lt. + assumption. + auto. + cut + (Rabs x * (eps * (Rabs (1 - x) * Rabs (/ x))) = + Rabs x * Rabs (/ x) * (eps * Rabs (1 - x))). + clear H8; intros; rewrite H8; rewrite <- Rabs_mult; rewrite Rinv_r. + rewrite Rabs_R1; cut (1 * (eps * Rabs (1 - x)) = Rabs (1 - x) * eps). + intros; rewrite H9; unfold Rle in |- *; right; reflexivity. + ring. + assumption. + ring. + ring. + ring. + apply Rminus_eq_contra. + apply Rlt_dichotomy_converse. + right; unfold Rgt in |- *. + apply (Rle_lt_trans x (Rabs x) 1). + apply RRle_abs. + assumption. + ring; ring. + elim n; simpl in |- *. + ring. + intros; rewrite H5. + ring. + apply Rmult_lt_0_compat. + auto. + apply Rmult_lt_0_compat. + apply Rabs_pos_lt. + apply Rminus_eq_contra. + apply Rlt_dichotomy_converse. + right; unfold Rgt in |- *. + apply (Rle_lt_trans x (Rabs x) 1). + apply RRle_abs. + assumption. + apply Rabs_pos_lt. + apply Rinv_neq_0_compat. + assumption. Qed. diff --git a/theories/Reals/Rsigma.v b/theories/Reals/Rsigma.v index 1e69a8f5..690c420f 100644 --- a/theories/Reals/Rsigma.v +++ b/theories/Reals/Rsigma.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Rsigma.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Rsigma.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -18,123 +18,117 @@ Set Implicit Arguments. Section Sigma. -Variable f : nat -> R. + Variable f : nat -> R. -Definition sigma (low high:nat) : R := - sum_f_R0 (fun k:nat => f (low + k)) (high - low). + Definition sigma (low high:nat) : R := + sum_f_R0 (fun k:nat => f (low + k)) (high - low). -Theorem sigma_split : - forall low high k:nat, - (low <= k)%nat -> - (k < high)%nat -> sigma low high = sigma low k + sigma (S k) high. -intros; induction k as [| k Hreck]. -cut (low = 0%nat). -intro; rewrite H1; unfold sigma in |- *; rewrite <- minus_n_n; - rewrite <- minus_n_O; simpl in |- *; replace (high - 1)%nat with (pred high). -apply (decomp_sum (fun k:nat => f k)). -assumption. -apply pred_of_minus. -inversion H; reflexivity. -cut ((low <= k)%nat \/ low = S k). -intro; elim H1; intro. -replace (sigma low (S k)) with (sigma low k + f (S k)). -rewrite Rplus_assoc; - replace (f (S k) + sigma (S (S k)) high) with (sigma (S k) high). -apply Hreck. -assumption. -apply lt_trans with (S k); [ apply lt_n_Sn | assumption ]. -unfold sigma in |- *; replace (high - S (S k))%nat with (pred (high - S k)). -pattern (S k) at 3 in |- *; replace (S k) with (S k + 0)%nat; - [ idtac | ring ]. -replace (sum_f_R0 (fun k0:nat => f (S (S k) + k0)) (pred (high - S k))) with - (sum_f_R0 (fun k0:nat => f (S k + S k0)) (pred (high - S k))). -apply (decomp_sum (fun i:nat => f (S k + i))). -apply lt_minus_O_lt; assumption. -apply sum_eq; intros; replace (S k + S i)%nat with (S (S k) + i)%nat. -reflexivity. -apply INR_eq; do 2 rewrite plus_INR; do 3 rewrite S_INR; ring. -replace (high - S (S k))%nat with (high - S k - 1)%nat. -apply pred_of_minus. -apply INR_eq; repeat rewrite minus_INR. -do 4 rewrite S_INR; ring. -apply lt_le_S; assumption. -apply lt_le_weak; assumption. -apply lt_le_S; apply lt_minus_O_lt; assumption. -unfold sigma in |- *; replace (S k - low)%nat with (S (k - low)). -pattern (S k) at 1 in |- *; replace (S k) with (low + S (k - low))%nat. -symmetry in |- *; apply (tech5 (fun i:nat => f (low + i))). -apply INR_eq; rewrite plus_INR; do 2 rewrite S_INR; rewrite minus_INR. -ring. -assumption. -apply minus_Sn_m; assumption. -rewrite <- H2; unfold sigma in |- *; rewrite <- minus_n_n; simpl in |- *; - replace (high - S low)%nat with (pred (high - low)). -replace (sum_f_R0 (fun k0:nat => f (S (low + k0))) (pred (high - low))) with - (sum_f_R0 (fun k0:nat => f (low + S k0)) (pred (high - low))). -apply (decomp_sum (fun k0:nat => f (low + k0))). -apply lt_minus_O_lt. -apply le_lt_trans with (S k); [ rewrite H2; apply le_n | assumption ]. -apply sum_eq; intros; replace (S (low + i)) with (low + S i)%nat. -reflexivity. -apply INR_eq; rewrite plus_INR; do 2 rewrite S_INR; rewrite plus_INR; ring. -replace (high - S low)%nat with (high - low - 1)%nat. -apply pred_of_minus. -apply INR_eq; repeat rewrite minus_INR. -do 2 rewrite S_INR; ring. -apply lt_le_S; rewrite H2; assumption. -rewrite H2; apply lt_le_weak; assumption. -apply lt_le_S; apply lt_minus_O_lt; rewrite H2; assumption. -inversion H; [ right; reflexivity | left; assumption ]. -Qed. + Theorem sigma_split : + forall low high k:nat, + (low <= k)%nat -> + (k < high)%nat -> sigma low high = sigma low k + sigma (S k) high. + Proof. + intros; induction k as [| k Hreck]. + cut (low = 0%nat). + intro; rewrite H1; unfold sigma in |- *; rewrite <- minus_n_n; + rewrite <- minus_n_O; simpl in |- *; replace (high - 1)%nat with (pred high). + apply (decomp_sum (fun k:nat => f k)). + assumption. + apply pred_of_minus. + inversion H; reflexivity. + cut ((low <= k)%nat \/ low = S k). + intro; elim H1; intro. + replace (sigma low (S k)) with (sigma low k + f (S k)). + rewrite Rplus_assoc; + replace (f (S k) + sigma (S (S k)) high) with (sigma (S k) high). + apply Hreck. + assumption. + apply lt_trans with (S k); [ apply lt_n_Sn | assumption ]. + unfold sigma in |- *; replace (high - S (S k))%nat with (pred (high - S k)). + pattern (S k) at 3 in |- *; replace (S k) with (S k + 0)%nat; + [ idtac | ring ]. + replace (sum_f_R0 (fun k0:nat => f (S (S k) + k0)) (pred (high - S k))) with + (sum_f_R0 (fun k0:nat => f (S k + S k0)) (pred (high - S k))). + apply (decomp_sum (fun i:nat => f (S k + i))). + apply lt_minus_O_lt; assumption. + apply sum_eq; intros; replace (S k + S i)%nat with (S (S k) + i)%nat. + reflexivity. + ring_nat. + replace (high - S (S k))%nat with (high - S k - 1)%nat. + apply pred_of_minus. + omega. + unfold sigma in |- *; replace (S k - low)%nat with (S (k - low)). + pattern (S k) at 1 in |- *; replace (S k) with (low + S (k - low))%nat. + symmetry in |- *; apply (tech5 (fun i:nat => f (low + i))). + omega. + omega. + rewrite <- H2; unfold sigma in |- *; rewrite <- minus_n_n; simpl in |- *; + replace (high - S low)%nat with (pred (high - low)). + replace (sum_f_R0 (fun k0:nat => f (S (low + k0))) (pred (high - low))) with + (sum_f_R0 (fun k0:nat => f (low + S k0)) (pred (high - low))). + apply (decomp_sum (fun k0:nat => f (low + k0))). + apply lt_minus_O_lt. + apply le_lt_trans with (S k); [ rewrite H2; apply le_n | assumption ]. + apply sum_eq; intros; replace (S (low + i)) with (low + S i)%nat. + reflexivity. + ring_nat. + omega. + inversion H; [ right; reflexivity | left; assumption ]. + Qed. -Theorem sigma_diff : - forall low high k:nat, - (low <= k)%nat -> - (k < high)%nat -> sigma low high - sigma low k = sigma (S k) high. -intros low high k H1 H2; symmetry in |- *; rewrite (sigma_split H1 H2); ring. -Qed. + Theorem sigma_diff : + forall low high k:nat, + (low <= k)%nat -> + (k < high)%nat -> sigma low high - sigma low k = sigma (S k) high. + Proof. + intros low high k H1 H2; symmetry in |- *; rewrite (sigma_split H1 H2); ring. + Qed. -Theorem sigma_diff_neg : - forall low high k:nat, - (low <= k)%nat -> - (k < high)%nat -> sigma low k - sigma low high = - sigma (S k) high. -intros low high k H1 H2; rewrite (sigma_split H1 H2); ring. -Qed. + Theorem sigma_diff_neg : + forall low high k:nat, + (low <= k)%nat -> + (k < high)%nat -> sigma low k - sigma low high = - sigma (S k) high. + Proof. + intros low high k H1 H2; rewrite (sigma_split H1 H2); ring. + Qed. -Theorem sigma_first : - forall low high:nat, - (low < high)%nat -> sigma low high = f low + sigma (S low) high. -intros low high H1; generalize (lt_le_S low high H1); intro H2; - generalize (lt_le_weak low high H1); intro H3; - replace (f low) with (sigma low low). -apply sigma_split. -apply le_n. -assumption. -unfold sigma in |- *; rewrite <- minus_n_n. -simpl in |- *. -replace (low + 0)%nat with low; [ reflexivity | ring ]. -Qed. + Theorem sigma_first : + forall low high:nat, + (low < high)%nat -> sigma low high = f low + sigma (S low) high. + Proof. + intros low high H1; generalize (lt_le_S low high H1); intro H2; + generalize (lt_le_weak low high H1); intro H3; + replace (f low) with (sigma low low). + apply sigma_split. + apply le_n. + assumption. + unfold sigma in |- *; rewrite <- minus_n_n. + simpl in |- *. + replace (low + 0)%nat with low; [ reflexivity | ring ]. + Qed. -Theorem sigma_last : - forall low high:nat, - (low < high)%nat -> sigma low high = f high + sigma low (pred high). -intros low high H1; generalize (lt_le_S low high H1); intro H2; - generalize (lt_le_weak low high H1); intro H3; - replace (f high) with (sigma high high). -rewrite Rplus_comm; cut (high = S (pred high)). -intro; pattern high at 3 in |- *; rewrite H. -apply sigma_split. -apply le_S_n; rewrite <- H; apply lt_le_S; assumption. -apply lt_pred_n_n; apply le_lt_trans with low; [ apply le_O_n | assumption ]. -apply S_pred with 0%nat; apply le_lt_trans with low; - [ apply le_O_n | assumption ]. -unfold sigma in |- *; rewrite <- minus_n_n; simpl in |- *; - replace (high + 0)%nat with high; [ reflexivity | ring ]. -Qed. + Theorem sigma_last : + forall low high:nat, + (low < high)%nat -> sigma low high = f high + sigma low (pred high). + Proof. + intros low high H1; generalize (lt_le_S low high H1); intro H2; + generalize (lt_le_weak low high H1); intro H3; + replace (f high) with (sigma high high). + rewrite Rplus_comm; cut (high = S (pred high)). + intro; pattern high at 3 in |- *; rewrite H. + apply sigma_split. + apply le_S_n; rewrite <- H; apply lt_le_S; assumption. + apply lt_pred_n_n; apply le_lt_trans with low; [ apply le_O_n | assumption ]. + apply S_pred with 0%nat; apply le_lt_trans with low; + [ apply le_O_n | assumption ]. + unfold sigma in |- *; rewrite <- minus_n_n; simpl in |- *; + replace (high + 0)%nat with high; [ reflexivity | ring ]. + Qed. -Theorem sigma_eq_arg : forall low:nat, sigma low low = f low. -intro; unfold sigma in |- *; rewrite <- minus_n_n. -simpl in |- *; replace (low + 0)%nat with low; [ reflexivity | ring ]. -Qed. + Theorem sigma_eq_arg : forall low:nat, sigma low low = f low. + Proof. + intro; unfold sigma in |- *; rewrite <- minus_n_n. + simpl in |- *; replace (low + 0)%nat with low; [ reflexivity | ring ]. + Qed. -End Sigma.
\ No newline at end of file +End Sigma. diff --git a/theories/Reals/Rsqrt_def.v b/theories/Reals/Rsqrt_def.v index de3422e8..92284e7d 100644 --- a/theories/Reals/Rsqrt_def.v +++ b/theories/Reals/Rsqrt_def.v @@ -5,8 +5,8 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) - -(*i $Id: Rsqrt_def.v 8670 2006-03-28 22:16:14Z herbelin $ i*) + +(*i $Id: Rsqrt_def.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Sumbool. Require Import Rbase. @@ -17,746 +17,769 @@ Open Local Scope R_scope. Boxed Fixpoint Dichotomy_lb (x y:R) (P:R -> bool) (N:nat) {struct N} : R := match N with - | O => x - | S n => + | O => x + | S n => let down := Dichotomy_lb x y P n in - let up := Dichotomy_ub x y P n in - let z := (down + up) / 2 in if P z then down else z + let up := Dichotomy_ub x y P n in + let z := (down + up) / 2 in if P z then down else z end - - with Dichotomy_ub (x y:R) (P:R -> bool) (N:nat) {struct N} : R := - match N with - | O => y - | S n => - let down := Dichotomy_lb x y P n in - let up := Dichotomy_ub x y P n in - let z := (down + up) / 2 in if P z then z else up - end. + + with Dichotomy_ub (x y:R) (P:R -> bool) (N:nat) {struct N} : R := + match N with + | O => y + | S n => + let down := Dichotomy_lb x y P n in + let up := Dichotomy_ub x y P n in + let z := (down + up) / 2 in if P z then z else up + end. Definition dicho_lb (x y:R) (P:R -> bool) (N:nat) : R := Dichotomy_lb x y P N. Definition dicho_up (x y:R) (P:R -> bool) (N:nat) : R := Dichotomy_ub x y P N. (**********) Lemma dicho_comp : - forall (x y:R) (P:R -> bool) (n:nat), - x <= y -> dicho_lb x y P n <= dicho_up x y P n. -intros. -induction n as [| n Hrecn]. -simpl in |- *; assumption. -simpl in |- *. -case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). -unfold Rdiv in |- *; apply Rmult_le_reg_l with 2. -prove_sup0. -pattern 2 at 1 in |- *; rewrite Rmult_comm. -rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]. -rewrite Rmult_1_r. -rewrite double. -apply Rplus_le_compat_l. -assumption. -unfold Rdiv in |- *; apply Rmult_le_reg_l with 2. -prove_sup0. -pattern 2 at 3 in |- *; rewrite Rmult_comm. -rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]. -rewrite Rmult_1_r. -rewrite double. -rewrite <- (Rplus_comm (Dichotomy_ub x y P n)). -apply Rplus_le_compat_l. -assumption. + forall (x y:R) (P:R -> bool) (n:nat), + x <= y -> dicho_lb x y P n <= dicho_up x y P n. +Proof. + intros. + induction n as [| n Hrecn]. + simpl in |- *; assumption. + simpl in |- *. + case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). + unfold Rdiv in |- *; apply Rmult_le_reg_l with 2. + prove_sup0. + pattern 2 at 1 in |- *; rewrite Rmult_comm. + rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]. + rewrite Rmult_1_r. + rewrite double. + apply Rplus_le_compat_l. + assumption. + unfold Rdiv in |- *; apply Rmult_le_reg_l with 2. + prove_sup0. + pattern 2 at 3 in |- *; rewrite Rmult_comm. + rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]. + rewrite Rmult_1_r. + rewrite double. + rewrite <- (Rplus_comm (Dichotomy_ub x y P n)). + apply Rplus_le_compat_l. + assumption. Qed. Lemma dicho_lb_growing : - forall (x y:R) (P:R -> bool), x <= y -> Un_growing (dicho_lb x y P). -intros. -unfold Un_growing in |- *. -intro. -simpl in |- *. -case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). -right; reflexivity. -unfold Rdiv in |- *; apply Rmult_le_reg_l with 2. -prove_sup0. -pattern 2 at 1 in |- *; rewrite Rmult_comm. -rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]. -rewrite Rmult_1_r. -rewrite double. -apply Rplus_le_compat_l. -replace (Dichotomy_ub x y P n) with (dicho_up x y P n); - [ apply dicho_comp; assumption | reflexivity ]. + forall (x y:R) (P:R -> bool), x <= y -> Un_growing (dicho_lb x y P). +Proof. + intros. + unfold Un_growing in |- *. + intro. + simpl in |- *. + case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). + right; reflexivity. + unfold Rdiv in |- *; apply Rmult_le_reg_l with 2. + prove_sup0. + pattern 2 at 1 in |- *; rewrite Rmult_comm. + rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]. + rewrite Rmult_1_r. + rewrite double. + apply Rplus_le_compat_l. + replace (Dichotomy_ub x y P n) with (dicho_up x y P n); + [ apply dicho_comp; assumption | reflexivity ]. Qed. Lemma dicho_up_decreasing : - forall (x y:R) (P:R -> bool), x <= y -> Un_decreasing (dicho_up x y P). -intros. -unfold Un_decreasing in |- *. -intro. -simpl in |- *. -case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). -unfold Rdiv in |- *; apply Rmult_le_reg_l with 2. -prove_sup0. -pattern 2 at 3 in |- *; rewrite Rmult_comm. -rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]. -rewrite Rmult_1_r. -rewrite double. -replace (Dichotomy_ub x y P n) with (dicho_up x y P n); - [ idtac | reflexivity ]. -replace (Dichotomy_lb x y P n) with (dicho_lb x y P n); - [ idtac | reflexivity ]. -rewrite <- (Rplus_comm (dicho_up x y P n)). -apply Rplus_le_compat_l. -apply dicho_comp; assumption. -right; reflexivity. + forall (x y:R) (P:R -> bool), x <= y -> Un_decreasing (dicho_up x y P). +Proof. + intros. + unfold Un_decreasing in |- *. + intro. + simpl in |- *. + case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). + unfold Rdiv in |- *; apply Rmult_le_reg_l with 2. + prove_sup0. + pattern 2 at 3 in |- *; rewrite Rmult_comm. + rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]. + rewrite Rmult_1_r. + rewrite double. + replace (Dichotomy_ub x y P n) with (dicho_up x y P n); + [ idtac | reflexivity ]. + replace (Dichotomy_lb x y P n) with (dicho_lb x y P n); + [ idtac | reflexivity ]. + rewrite <- (Rplus_comm (dicho_up x y P n)). + apply Rplus_le_compat_l. + apply dicho_comp; assumption. + right; reflexivity. Qed. Lemma dicho_lb_maj_y : - forall (x y:R) (P:R -> bool), x <= y -> forall n:nat, dicho_lb x y P n <= y. -intros. -induction n as [| n Hrecn]. -simpl in |- *; assumption. -simpl in |- *. -case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). -assumption. -unfold Rdiv in |- *; apply Rmult_le_reg_l with 2. -prove_sup0. -pattern 2 at 3 in |- *; rewrite Rmult_comm. -rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ rewrite Rmult_1_r | discrR ]. -rewrite double; apply Rplus_le_compat. -assumption. -pattern y at 2 in |- *; replace y with (Dichotomy_ub x y P 0); - [ idtac | reflexivity ]. -apply decreasing_prop. -assert (H0 := dicho_up_decreasing x y P H). -assumption. -apply le_O_n. + forall (x y:R) (P:R -> bool), x <= y -> forall n:nat, dicho_lb x y P n <= y. +Proof. + intros. + induction n as [| n Hrecn]. + simpl in |- *; assumption. + simpl in |- *. + case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). + assumption. + unfold Rdiv in |- *; apply Rmult_le_reg_l with 2. + prove_sup0. + pattern 2 at 3 in |- *; rewrite Rmult_comm. + rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ rewrite Rmult_1_r | discrR ]. + rewrite double; apply Rplus_le_compat. + assumption. + pattern y at 2 in |- *; replace y with (Dichotomy_ub x y P 0); + [ idtac | reflexivity ]. + apply decreasing_prop. + assert (H0 := dicho_up_decreasing x y P H). + assumption. + apply le_O_n. Qed. Lemma dicho_lb_maj : - forall (x y:R) (P:R -> bool), x <= y -> has_ub (dicho_lb x y P). -intros. -cut (forall n:nat, dicho_lb x y P n <= y). -intro. -unfold has_ub in |- *. -unfold bound in |- *. -exists y. -unfold is_upper_bound in |- *. -intros. -elim H1; intros. -rewrite H2; apply H0. -apply dicho_lb_maj_y; assumption. + forall (x y:R) (P:R -> bool), x <= y -> has_ub (dicho_lb x y P). +Proof. + intros. + cut (forall n:nat, dicho_lb x y P n <= y). + intro. + unfold has_ub in |- *. + unfold bound in |- *. + exists y. + unfold is_upper_bound in |- *. + intros. + elim H1; intros. + rewrite H2; apply H0. + apply dicho_lb_maj_y; assumption. Qed. Lemma dicho_up_min_x : - forall (x y:R) (P:R -> bool), x <= y -> forall n:nat, x <= dicho_up x y P n. -intros. -induction n as [| n Hrecn]. -simpl in |- *; assumption. -simpl in |- *. -case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). -unfold Rdiv in |- *; apply Rmult_le_reg_l with 2. -prove_sup0. -pattern 2 at 1 in |- *; rewrite Rmult_comm. -rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ rewrite Rmult_1_r | discrR ]. -rewrite double; apply Rplus_le_compat. -pattern x at 1 in |- *; replace x with (Dichotomy_lb x y P 0); - [ idtac | reflexivity ]. -apply tech9. -assert (H0 := dicho_lb_growing x y P H). -assumption. -apply le_O_n. -assumption. -assumption. + forall (x y:R) (P:R -> bool), x <= y -> forall n:nat, x <= dicho_up x y P n. +Proof. + intros. + induction n as [| n Hrecn]. + simpl in |- *; assumption. + simpl in |- *. + case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). + unfold Rdiv in |- *; apply Rmult_le_reg_l with 2. + prove_sup0. + pattern 2 at 1 in |- *; rewrite Rmult_comm. + rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ rewrite Rmult_1_r | discrR ]. + rewrite double; apply Rplus_le_compat. + pattern x at 1 in |- *; replace x with (Dichotomy_lb x y P 0); + [ idtac | reflexivity ]. + apply tech9. + assert (H0 := dicho_lb_growing x y P H). + assumption. + apply le_O_n. + assumption. + assumption. Qed. Lemma dicho_up_min : - forall (x y:R) (P:R -> bool), x <= y -> has_lb (dicho_up x y P). -intros. -cut (forall n:nat, x <= dicho_up x y P n). -intro. -unfold has_lb in |- *. -unfold bound in |- *. -exists (- x). -unfold is_upper_bound in |- *. -intros. -elim H1; intros. -rewrite H2. -unfold opp_seq in |- *. -apply Ropp_le_contravar. -apply H0. -apply dicho_up_min_x; assumption. + forall (x y:R) (P:R -> bool), x <= y -> has_lb (dicho_up x y P). +Proof. + intros. + cut (forall n:nat, x <= dicho_up x y P n). + intro. + unfold has_lb in |- *. + unfold bound in |- *. + exists (- x). + unfold is_upper_bound in |- *. + intros. + elim H1; intros. + rewrite H2. + unfold opp_seq in |- *. + apply Ropp_le_contravar. + apply H0. + apply dicho_up_min_x; assumption. Qed. Lemma dicho_lb_cv : - forall (x y:R) (P:R -> bool), - x <= y -> sigT (fun l:R => Un_cv (dicho_lb x y P) l). -intros. -apply growing_cv. -apply dicho_lb_growing; assumption. -apply dicho_lb_maj; assumption. + forall (x y:R) (P:R -> bool), + x <= y -> sigT (fun l:R => Un_cv (dicho_lb x y P) l). +Proof. + intros. + apply growing_cv. + apply dicho_lb_growing; assumption. + apply dicho_lb_maj; assumption. Qed. Lemma dicho_up_cv : - forall (x y:R) (P:R -> bool), - x <= y -> sigT (fun l:R => Un_cv (dicho_up x y P) l). -intros. -apply decreasing_cv. -apply dicho_up_decreasing; assumption. -apply dicho_up_min; assumption. + forall (x y:R) (P:R -> bool), + x <= y -> sigT (fun l:R => Un_cv (dicho_up x y P) l). +Proof. + intros. + apply decreasing_cv. + apply dicho_up_decreasing; assumption. + apply dicho_up_min; assumption. Qed. Lemma dicho_lb_dicho_up : - forall (x y:R) (P:R -> bool) (n:nat), - x <= y -> dicho_up x y P n - dicho_lb x y P n = (y - x) / 2 ^ n. -intros. -induction n as [| n Hrecn]. -simpl in |- *. -unfold Rdiv in |- *; rewrite Rinv_1; ring. -simpl in |- *. -case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). -unfold Rdiv in |- *. -replace - ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) * / 2 - Dichotomy_lb x y P n) - with ((dicho_up x y P n - dicho_lb x y P n) / 2). -unfold Rdiv in |- *; rewrite Hrecn. -unfold Rdiv in |- *. -rewrite Rinv_mult_distr. -ring. -discrR. -apply pow_nonzero; discrR. -pattern (Dichotomy_lb x y P n) at 2 in |- *; - rewrite (double_var (Dichotomy_lb x y P n)); - unfold dicho_up, dicho_lb, Rminus, Rdiv in |- *; ring. -replace - (Dichotomy_ub x y P n - (Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2) - with ((dicho_up x y P n - dicho_lb x y P n) / 2). -unfold Rdiv in |- *; rewrite Hrecn. -unfold Rdiv in |- *. -rewrite Rinv_mult_distr. -ring. -discrR. -apply pow_nonzero; discrR. -pattern (Dichotomy_ub x y P n) at 1 in |- *; - rewrite (double_var (Dichotomy_ub x y P n)); - unfold dicho_up, dicho_lb, Rminus, Rdiv in |- *; ring. + forall (x y:R) (P:R -> bool) (n:nat), + x <= y -> dicho_up x y P n - dicho_lb x y P n = (y - x) / 2 ^ n. +Proof. + intros. + induction n as [| n Hrecn]. + simpl in |- *. + unfold Rdiv in |- *; rewrite Rinv_1; ring. + simpl in |- *. + case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). + unfold Rdiv in |- *. + replace + ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) * / 2 - Dichotomy_lb x y P n) + with ((dicho_up x y P n - dicho_lb x y P n) / 2). + unfold Rdiv in |- *; rewrite Hrecn. + unfold Rdiv in |- *. + rewrite Rinv_mult_distr. + ring. + discrR. + apply pow_nonzero; discrR. + pattern (Dichotomy_lb x y P n) at 2 in |- *; + rewrite (double_var (Dichotomy_lb x y P n)); + unfold dicho_up, dicho_lb, Rminus, Rdiv in |- *; ring. + replace + (Dichotomy_ub x y P n - (Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2) + with ((dicho_up x y P n - dicho_lb x y P n) / 2). + unfold Rdiv in |- *; rewrite Hrecn. + unfold Rdiv in |- *. + rewrite Rinv_mult_distr. + ring. + discrR. + apply pow_nonzero; discrR. + pattern (Dichotomy_ub x y P n) at 1 in |- *; + rewrite (double_var (Dichotomy_ub x y P n)); + unfold dicho_up, dicho_lb, Rminus, Rdiv in |- *; ring. Qed. Definition pow_2_n (n:nat) := 2 ^ n. Lemma pow_2_n_neq_R0 : forall n:nat, pow_2_n n <> 0. -intro. -unfold pow_2_n in |- *. -apply pow_nonzero. -discrR. +Proof. + intro. + unfold pow_2_n in |- *. + apply pow_nonzero. + discrR. Qed. Lemma pow_2_n_growing : Un_growing pow_2_n. -unfold Un_growing in |- *. -intro. -replace (S n) with (n + 1)%nat; - [ unfold pow_2_n in |- *; rewrite pow_add | ring ]. -pattern (2 ^ n) at 1 in |- *; rewrite <- Rmult_1_r. -apply Rmult_le_compat_l. -left; apply pow_lt; prove_sup0. -simpl in |- *. -rewrite Rmult_1_r. -pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; - apply Rlt_0_1. +Proof. + unfold Un_growing in |- *. + intro. + replace (S n) with (n + 1)%nat; + [ unfold pow_2_n in |- *; rewrite pow_add | ring ]. + pattern (2 ^ n) at 1 in |- *; rewrite <- Rmult_1_r. + apply Rmult_le_compat_l. + left; apply pow_lt; prove_sup0. + simpl in |- *. + rewrite Rmult_1_r. + pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; + apply Rlt_0_1. Qed. Lemma pow_2_n_infty : cv_infty pow_2_n. -cut (forall N:nat, INR N <= 2 ^ N). -intros. -unfold cv_infty in |- *. -intro. -case (total_order_T 0 M); intro. -elim s; intro. -set (N := up M). -cut (0 <= N)%Z. -intro. -elim (IZN N H0); intros N0 H1. -exists N0. -intros. -apply Rlt_le_trans with (INR N0). -rewrite INR_IZR_INZ. -rewrite <- H1. -unfold N in |- *. -assert (H3 := archimed M). -elim H3; intros; assumption. -apply Rle_trans with (pow_2_n N0). -unfold pow_2_n in |- *; apply H. -apply Rge_le. -apply growing_prop. -apply pow_2_n_growing. -assumption. -apply le_IZR. -unfold N in |- *. -simpl in |- *. -assert (H0 := archimed M); elim H0; intros. -left; apply Rlt_trans with M; assumption. -exists 0%nat; intros. -rewrite <- b. -unfold pow_2_n in |- *; apply pow_lt; prove_sup0. -exists 0%nat; intros. -apply Rlt_trans with 0. -assumption. -unfold pow_2_n in |- *; apply pow_lt; prove_sup0. -simple induction N. -simpl in |- *. -left; apply Rlt_0_1. -intros. -pattern (S n) at 2 in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ]. -rewrite S_INR; rewrite pow_add. -simpl in |- *. -rewrite Rmult_1_r. -apply Rle_trans with (2 ^ n). -rewrite <- (Rplus_comm 1). -rewrite <- (Rmult_1_r (INR n)). -apply (poly n 1). -apply Rlt_0_1. -pattern (2 ^ n) at 1 in |- *; rewrite <- Rplus_0_r. -rewrite <- (Rmult_comm 2). -rewrite double. -apply Rplus_le_compat_l. -left; apply pow_lt; prove_sup0. +Proof. + cut (forall N:nat, INR N <= 2 ^ N). + intros. + unfold cv_infty in |- *. + intro. + case (total_order_T 0 M); intro. + elim s; intro. + set (N := up M). + cut (0 <= N)%Z. + intro. + elim (IZN N H0); intros N0 H1. + exists N0. + intros. + apply Rlt_le_trans with (INR N0). + rewrite INR_IZR_INZ. + rewrite <- H1. + unfold N in |- *. + assert (H3 := archimed M). + elim H3; intros; assumption. + apply Rle_trans with (pow_2_n N0). + unfold pow_2_n in |- *; apply H. + apply Rge_le. + apply growing_prop. + apply pow_2_n_growing. + assumption. + apply le_IZR. + unfold N in |- *. + simpl in |- *. + assert (H0 := archimed M); elim H0; intros. + left; apply Rlt_trans with M; assumption. + exists 0%nat; intros. + rewrite <- b. + unfold pow_2_n in |- *; apply pow_lt; prove_sup0. + exists 0%nat; intros. + apply Rlt_trans with 0. + assumption. + unfold pow_2_n in |- *; apply pow_lt; prove_sup0. + simple induction N. + simpl in |- *. + left; apply Rlt_0_1. + intros. + pattern (S n) at 2 in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ]. + rewrite S_INR; rewrite pow_add. + simpl in |- *. + rewrite Rmult_1_r. + apply Rle_trans with (2 ^ n). + rewrite <- (Rplus_comm 1). + rewrite <- (Rmult_1_r (INR n)). + apply (poly n 1). + apply Rlt_0_1. + pattern (2 ^ n) at 1 in |- *; rewrite <- Rplus_0_r. + rewrite <- (Rmult_comm 2). + rewrite double. + apply Rplus_le_compat_l. + left; apply pow_lt; prove_sup0. Qed. Lemma cv_dicho : - forall (x y l1 l2:R) (P:R -> bool), - x <= y -> - Un_cv (dicho_lb x y P) l1 -> Un_cv (dicho_up x y P) l2 -> l1 = l2. -intros. -assert (H2 := CV_minus _ _ _ _ H0 H1). -cut (Un_cv (fun i:nat => dicho_lb x y P i - dicho_up x y P i) 0). -intro. -assert (H4 := UL_sequence _ _ _ H2 H3). -symmetry in |- *; apply Rminus_diag_uniq_sym; assumption. -unfold Un_cv in |- *; unfold R_dist in |- *. -intros. -assert (H4 := cv_infty_cv_R0 pow_2_n pow_2_n_neq_R0 pow_2_n_infty). -case (total_order_T x y); intro. -elim s; intro. -unfold Un_cv in H4; unfold R_dist in H4. -cut (0 < y - x). -intro Hyp. -cut (0 < eps / (y - x)). -intro. -elim (H4 (eps / (y - x)) H5); intros N H6. -exists N; intros. -replace (dicho_lb x y P n - dicho_up x y P n - 0) with - (dicho_lb x y P n - dicho_up x y P n); [ idtac | ring ]. -rewrite <- Rabs_Ropp. -rewrite Ropp_minus_distr'. -rewrite dicho_lb_dicho_up. -unfold Rdiv in |- *; rewrite Rabs_mult. -rewrite (Rabs_right (y - x)). -apply Rmult_lt_reg_l with (/ (y - x)). -apply Rinv_0_lt_compat; assumption. -rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_l. -replace (/ 2 ^ n) with (/ 2 ^ n - 0); - [ unfold pow_2_n, Rdiv in H6; rewrite <- (Rmult_comm eps); apply H6; + forall (x y l1 l2:R) (P:R -> bool), + x <= y -> + Un_cv (dicho_lb x y P) l1 -> Un_cv (dicho_up x y P) l2 -> l1 = l2. +Proof. + intros. + assert (H2 := CV_minus _ _ _ _ H0 H1). + cut (Un_cv (fun i:nat => dicho_lb x y P i - dicho_up x y P i) 0). + intro. + assert (H4 := UL_sequence _ _ _ H2 H3). + symmetry in |- *; apply Rminus_diag_uniq_sym; assumption. + unfold Un_cv in |- *; unfold R_dist in |- *. + intros. + assert (H4 := cv_infty_cv_R0 pow_2_n pow_2_n_neq_R0 pow_2_n_infty). + case (total_order_T x y); intro. + elim s; intro. + unfold Un_cv in H4; unfold R_dist in H4. + cut (0 < y - x). + intro Hyp. + cut (0 < eps / (y - x)). + intro. + elim (H4 (eps / (y - x)) H5); intros N H6. + exists N; intros. + replace (dicho_lb x y P n - dicho_up x y P n - 0) with + (dicho_lb x y P n - dicho_up x y P n); [ idtac | ring ]. + rewrite <- Rabs_Ropp. + rewrite Ropp_minus_distr'. + rewrite dicho_lb_dicho_up. + unfold Rdiv in |- *; rewrite Rabs_mult. + rewrite (Rabs_right (y - x)). + apply Rmult_lt_reg_l with (/ (y - x)). + apply Rinv_0_lt_compat; assumption. + rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_l. + replace (/ 2 ^ n) with (/ 2 ^ n - 0); + [ unfold pow_2_n, Rdiv in H6; rewrite <- (Rmult_comm eps); apply H6; assumption - | ring ]. -red in |- *; intro; rewrite H8 in Hyp; elim (Rlt_irrefl _ Hyp). -apply Rle_ge. -apply Rplus_le_reg_l with x; rewrite Rplus_0_r. -replace (x + (y - x)) with y; [ assumption | ring ]. -assumption. -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; assumption ]. -apply Rplus_lt_reg_r with x; rewrite Rplus_0_r. -replace (x + (y - x)) with y; [ assumption | ring ]. -exists 0%nat; intros. -replace (dicho_lb x y P n - dicho_up x y P n - 0) with - (dicho_lb x y P n - dicho_up x y P n); [ idtac | ring ]. -rewrite <- Rabs_Ropp. -rewrite Ropp_minus_distr'. -rewrite dicho_lb_dicho_up. -rewrite b. -unfold Rminus, Rdiv in |- *; rewrite Rplus_opp_r; rewrite Rmult_0_l; - rewrite Rabs_R0; assumption. -assumption. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). + | ring ]. + red in |- *; intro; rewrite H8 in Hyp; elim (Rlt_irrefl _ Hyp). + apply Rle_ge. + apply Rplus_le_reg_l with x; rewrite Rplus_0_r. + replace (x + (y - x)) with y; [ assumption | ring ]. + assumption. + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; assumption ]. + apply Rplus_lt_reg_r with x; rewrite Rplus_0_r. + replace (x + (y - x)) with y; [ assumption | ring ]. + exists 0%nat; intros. + replace (dicho_lb x y P n - dicho_up x y P n - 0) with + (dicho_lb x y P n - dicho_up x y P n); [ idtac | ring ]. + rewrite <- Rabs_Ropp. + rewrite Ropp_minus_distr'. + rewrite dicho_lb_dicho_up. + rewrite b. + unfold Rminus, Rdiv in |- *; rewrite Rplus_opp_r; rewrite Rmult_0_l; + rewrite Rabs_R0; assumption. + assumption. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). Qed. Definition cond_positivity (x:R) : bool := match Rle_dec 0 x with - | left _ => true - | right _ => false + | left _ => true + | right _ => false end. -(* Sequential caracterisation of continuity *) +(** Sequential caracterisation of continuity *) Lemma continuity_seq : - forall (f:R -> R) (Un:nat -> R) (l:R), - continuity_pt f l -> Un_cv Un l -> Un_cv (fun i:nat => f (Un i)) (f l). -unfold continuity_pt, Un_cv in |- *; unfold continue_in in |- *. -unfold limit1_in in |- *. -unfold limit_in in |- *. -unfold dist in |- *. -simpl in |- *. -unfold R_dist in |- *. -intros. -elim (H eps H1); intros alp H2. -elim H2; intros. -elim (H0 alp H3); intros N H5. -exists N; intros. -case (Req_dec (Un n) l); intro. -rewrite H7; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; - assumption. -apply H4. -split. -unfold D_x, no_cond in |- *. -split. -trivial. -apply (sym_not_eq (A:=R)); assumption. -apply H5; assumption. + forall (f:R -> R) (Un:nat -> R) (l:R), + continuity_pt f l -> Un_cv Un l -> Un_cv (fun i:nat => f (Un i)) (f l). +Proof. + unfold continuity_pt, Un_cv in |- *; unfold continue_in in |- *. + unfold limit1_in in |- *. + unfold limit_in in |- *. + unfold dist in |- *. + simpl in |- *. + unfold R_dist in |- *. + intros. + elim (H eps H1); intros alp H2. + elim H2; intros. + elim (H0 alp H3); intros N H5. + exists N; intros. + case (Req_dec (Un n) l); intro. + rewrite H7; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + assumption. + apply H4. + split. + unfold D_x, no_cond in |- *. + split. + trivial. + apply (sym_not_eq (A:=R)); assumption. + apply H5; assumption. Qed. Lemma dicho_lb_car : - forall (x y:R) (P:R -> bool) (n:nat), - P x = false -> P (dicho_lb x y P n) = false. -intros. -induction n as [| n Hrecn]. -simpl in |- *. -assumption. -simpl in |- *. -assert - (X := - sumbool_of_bool (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2))). -elim X; intro. -rewrite a. -unfold dicho_lb in Hrecn; assumption. -rewrite b. -assumption. + forall (x y:R) (P:R -> bool) (n:nat), + P x = false -> P (dicho_lb x y P n) = false. +Proof. + intros. + induction n as [| n Hrecn]. + simpl in |- *. + assumption. + simpl in |- *. + assert + (X := + sumbool_of_bool (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2))). + elim X; intro. + rewrite a. + unfold dicho_lb in Hrecn; assumption. + rewrite b. + assumption. Qed. Lemma dicho_up_car : - forall (x y:R) (P:R -> bool) (n:nat), - P y = true -> P (dicho_up x y P n) = true. -intros. -induction n as [| n Hrecn]. -simpl in |- *. -assumption. -simpl in |- *. -assert - (X := - sumbool_of_bool (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2))). -elim X; intro. -rewrite a. -unfold dicho_lb in Hrecn; assumption. -rewrite b. -assumption. + forall (x y:R) (P:R -> bool) (n:nat), + P y = true -> P (dicho_up x y P n) = true. +Proof. + intros. + induction n as [| n Hrecn]. + simpl in |- *. + assumption. + simpl in |- *. + assert + (X := + sumbool_of_bool (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2))). + elim X; intro. + rewrite a. + unfold dicho_lb in Hrecn; assumption. + rewrite b. + assumption. Qed. -(* Intermediate Value Theorem *) +(** Intermediate Value Theorem *) Lemma IVT : - forall (f:R -> R) (x y:R), - continuity f -> - x < y -> f x < 0 -> 0 < f y -> sigT (fun z:R => x <= z <= y /\ f z = 0). -intros. -cut (x <= y). -intro. -generalize (dicho_lb_cv x y (fun z:R => cond_positivity (f z)) H3). -generalize (dicho_up_cv x y (fun z:R => cond_positivity (f z)) H3). -intros X X0. -elim X; intros. -elim X0; intros. -assert (H4 := cv_dicho _ _ _ _ _ H3 p0 p). -rewrite H4 in p0. -apply existT with x0. -split. -split. -apply Rle_trans with (dicho_lb x y (fun z:R => cond_positivity (f z)) 0). -simpl in |- *. -right; reflexivity. -apply growing_ineq. -apply dicho_lb_growing; assumption. -assumption. -apply Rle_trans with (dicho_up x y (fun z:R => cond_positivity (f z)) 0). -apply decreasing_ineq. -apply dicho_up_decreasing; assumption. -assumption. -right; reflexivity. -2: left; assumption. -set (Vn := fun n:nat => dicho_lb x y (fun z:R => cond_positivity (f z)) n). -set (Wn := fun n:nat => dicho_up x y (fun z:R => cond_positivity (f z)) n). -cut ((forall n:nat, f (Vn n) <= 0) -> f x0 <= 0). -cut ((forall n:nat, 0 <= f (Wn n)) -> 0 <= f x0). -intros. -cut (forall n:nat, f (Vn n) <= 0). -cut (forall n:nat, 0 <= f (Wn n)). -intros. -assert (H9 := H6 H8). -assert (H10 := H5 H7). -apply Rle_antisym; assumption. -intro. -unfold Wn in |- *. -cut (forall z:R, cond_positivity z = true <-> 0 <= z). -intro. -assert (H8 := dicho_up_car x y (fun z:R => cond_positivity (f z)) n). -elim (H7 (f (dicho_up x y (fun z:R => cond_positivity (f z)) n))); intros. -apply H9. -apply H8. -elim (H7 (f y)); intros. -apply H12. -left; assumption. -intro. -unfold cond_positivity in |- *. -case (Rle_dec 0 z); intro. -split. -intro; assumption. -intro; reflexivity. -split. -intro; elim diff_false_true; assumption. -intro. -elim n0; assumption. -unfold Vn in |- *. -cut (forall z:R, cond_positivity z = false <-> z < 0). -intros. -assert (H8 := dicho_lb_car x y (fun z:R => cond_positivity (f z)) n). -left. -elim (H7 (f (dicho_lb x y (fun z:R => cond_positivity (f z)) n))); intros. -apply H9. -apply H8. -elim (H7 (f x)); intros. -apply H12. -assumption. -intro. -unfold cond_positivity in |- *. -case (Rle_dec 0 z); intro. -split. -intro; elim diff_true_false; assumption. -intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H7)). -split. -intro; auto with real. -intro; reflexivity. -cut (Un_cv Wn x0). -intros. -assert (H7 := continuity_seq f Wn x0 (H x0) H5). -case (total_order_T 0 (f x0)); intro. -elim s; intro. -left; assumption. -rewrite <- b; right; reflexivity. -unfold Un_cv in H7; unfold R_dist in H7. -cut (0 < - f x0). -intro. -elim (H7 (- f x0) H8); intros. -cut (x2 >= x2)%nat; [ intro | unfold ge in |- *; apply le_n ]. -assert (H11 := H9 x2 H10). -rewrite Rabs_right in H11. -pattern (- f x0) at 1 in H11; rewrite <- Rplus_0_r in H11. -unfold Rminus in H11; rewrite (Rplus_comm (f (Wn x2))) in H11. -assert (H12 := Rplus_lt_reg_r _ _ _ H11). -assert (H13 := H6 x2). -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H13 H12)). -apply Rle_ge; left; unfold Rminus in |- *; apply Rplus_le_lt_0_compat. -apply H6. -exact H8. -apply Ropp_0_gt_lt_contravar; assumption. -unfold Wn in |- *; assumption. -cut (Un_cv Vn x0). -intros. -assert (H7 := continuity_seq f Vn x0 (H x0) H5). -case (total_order_T 0 (f x0)); intro. -elim s; intro. -unfold Un_cv in H7; unfold R_dist in H7. -elim (H7 (f x0) a); intros. -cut (x2 >= x2)%nat; [ intro | unfold ge in |- *; apply le_n ]. -assert (H10 := H8 x2 H9). -rewrite Rabs_left in H10. -pattern (f x0) at 2 in H10; rewrite <- Rplus_0_r in H10. -rewrite Ropp_minus_distr' in H10. -unfold Rminus in H10. -assert (H11 := Rplus_lt_reg_r _ _ _ H10). -assert (H12 := H6 x2). -cut (0 < f (Vn x2)). -intro. -elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H13 H12)). -rewrite <- (Ropp_involutive (f (Vn x2))). -apply Ropp_0_gt_lt_contravar; assumption. -apply Rplus_lt_reg_r with (f x0 - f (Vn x2)). -rewrite Rplus_0_r; replace (f x0 - f (Vn x2) + (f (Vn x2) - f x0)) with 0; - [ unfold Rminus in |- *; apply Rplus_lt_le_0_compat | ring ]. -assumption. -apply Ropp_0_ge_le_contravar; apply Rle_ge; apply H6. -right; rewrite <- b; reflexivity. -left; assumption. -unfold Vn in |- *; assumption. + forall (f:R -> R) (x y:R), + continuity f -> + x < y -> f x < 0 -> 0 < f y -> sigT (fun z:R => x <= z <= y /\ f z = 0). +Proof. + intros. + cut (x <= y). + intro. + generalize (dicho_lb_cv x y (fun z:R => cond_positivity (f z)) H3). + generalize (dicho_up_cv x y (fun z:R => cond_positivity (f z)) H3). + intros X X0. + elim X; intros. + elim X0; intros. + assert (H4 := cv_dicho _ _ _ _ _ H3 p0 p). + rewrite H4 in p0. + apply existT with x0. + split. + split. + apply Rle_trans with (dicho_lb x y (fun z:R => cond_positivity (f z)) 0). + simpl in |- *. + right; reflexivity. + apply growing_ineq. + apply dicho_lb_growing; assumption. + assumption. + apply Rle_trans with (dicho_up x y (fun z:R => cond_positivity (f z)) 0). + apply decreasing_ineq. + apply dicho_up_decreasing; assumption. + assumption. + right; reflexivity. + 2: left; assumption. + set (Vn := fun n:nat => dicho_lb x y (fun z:R => cond_positivity (f z)) n). + set (Wn := fun n:nat => dicho_up x y (fun z:R => cond_positivity (f z)) n). + cut ((forall n:nat, f (Vn n) <= 0) -> f x0 <= 0). + cut ((forall n:nat, 0 <= f (Wn n)) -> 0 <= f x0). + intros. + cut (forall n:nat, f (Vn n) <= 0). + cut (forall n:nat, 0 <= f (Wn n)). + intros. + assert (H9 := H6 H8). + assert (H10 := H5 H7). + apply Rle_antisym; assumption. + intro. + unfold Wn in |- *. + cut (forall z:R, cond_positivity z = true <-> 0 <= z). + intro. + assert (H8 := dicho_up_car x y (fun z:R => cond_positivity (f z)) n). + elim (H7 (f (dicho_up x y (fun z:R => cond_positivity (f z)) n))); intros. + apply H9. + apply H8. + elim (H7 (f y)); intros. + apply H12. + left; assumption. + intro. + unfold cond_positivity in |- *. + case (Rle_dec 0 z); intro. + split. + intro; assumption. + intro; reflexivity. + split. + intro; elim diff_false_true; assumption. + intro. + elim n0; assumption. + unfold Vn in |- *. + cut (forall z:R, cond_positivity z = false <-> z < 0). + intros. + assert (H8 := dicho_lb_car x y (fun z:R => cond_positivity (f z)) n). + left. + elim (H7 (f (dicho_lb x y (fun z:R => cond_positivity (f z)) n))); intros. + apply H9. + apply H8. + elim (H7 (f x)); intros. + apply H12. + assumption. + intro. + unfold cond_positivity in |- *. + case (Rle_dec 0 z); intro. + split. + intro; elim diff_true_false; assumption. + intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H7)). + split. + intro; auto with real. + intro; reflexivity. + cut (Un_cv Wn x0). + intros. + assert (H7 := continuity_seq f Wn x0 (H x0) H5). + case (total_order_T 0 (f x0)); intro. + elim s; intro. + left; assumption. + rewrite <- b; right; reflexivity. + unfold Un_cv in H7; unfold R_dist in H7. + cut (0 < - f x0). + intro. + elim (H7 (- f x0) H8); intros. + cut (x2 >= x2)%nat; [ intro | unfold ge in |- *; apply le_n ]. + assert (H11 := H9 x2 H10). + rewrite Rabs_right in H11. + pattern (- f x0) at 1 in H11; rewrite <- Rplus_0_r in H11. + unfold Rminus in H11; rewrite (Rplus_comm (f (Wn x2))) in H11. + assert (H12 := Rplus_lt_reg_r _ _ _ H11). + assert (H13 := H6 x2). + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H13 H12)). + apply Rle_ge; left; unfold Rminus in |- *; apply Rplus_le_lt_0_compat. + apply H6. + exact H8. + apply Ropp_0_gt_lt_contravar; assumption. + unfold Wn in |- *; assumption. + cut (Un_cv Vn x0). + intros. + assert (H7 := continuity_seq f Vn x0 (H x0) H5). + case (total_order_T 0 (f x0)); intro. + elim s; intro. + unfold Un_cv in H7; unfold R_dist in H7. + elim (H7 (f x0) a); intros. + cut (x2 >= x2)%nat; [ intro | unfold ge in |- *; apply le_n ]. + assert (H10 := H8 x2 H9). + rewrite Rabs_left in H10. + pattern (f x0) at 2 in H10; rewrite <- Rplus_0_r in H10. + rewrite Ropp_minus_distr' in H10. + unfold Rminus in H10. + assert (H11 := Rplus_lt_reg_r _ _ _ H10). + assert (H12 := H6 x2). + cut (0 < f (Vn x2)). + intro. + elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H13 H12)). + rewrite <- (Ropp_involutive (f (Vn x2))). + apply Ropp_0_gt_lt_contravar; assumption. + apply Rplus_lt_reg_r with (f x0 - f (Vn x2)). + rewrite Rplus_0_r; replace (f x0 - f (Vn x2) + (f (Vn x2) - f x0)) with 0; + [ unfold Rminus in |- *; apply Rplus_lt_le_0_compat | ring ]. + assumption. + apply Ropp_0_ge_le_contravar; apply Rle_ge; apply H6. + right; rewrite <- b; reflexivity. + left; assumption. + unfold Vn in |- *; assumption. Qed. Lemma IVT_cor : - forall (f:R -> R) (x y:R), - continuity f -> - x <= y -> f x * f y <= 0 -> sigT (fun z:R => x <= z <= y /\ f z = 0). -intros. -case (total_order_T 0 (f x)); intro. -case (total_order_T 0 (f y)); intro. -elim s; intro. -elim s0; intro. -cut (0 < f x * f y); - [ intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 H2)) - | apply Rmult_lt_0_compat; assumption ]. -exists y. -split. -split; [ assumption | right; reflexivity ]. -symmetry in |- *; exact b. -exists x. -split. -split; [ right; reflexivity | assumption ]. -symmetry in |- *; exact b. -elim s; intro. -cut (x < y). -intro. -assert (H3 := IVT (- f)%F x y (continuity_opp f H) H2). -cut ((- f)%F x < 0). -cut (0 < (- f)%F y). -intros. -elim (H3 H5 H4); intros. -apply existT with x0. -elim p; intros. -split. -assumption. -unfold opp_fct in H7. -rewrite <- (Ropp_involutive (f x0)). -apply Ropp_eq_0_compat; assumption. -unfold opp_fct in |- *; apply Ropp_0_gt_lt_contravar; assumption. -unfold opp_fct in |- *. -apply Rplus_lt_reg_r with (f x); rewrite Rplus_opp_r; rewrite Rplus_0_r; - assumption. -inversion H0. -assumption. -rewrite H2 in a. -elim (Rlt_irrefl _ (Rlt_trans _ _ _ r a)). -apply existT with x. -split. -split; [ right; reflexivity | assumption ]. -symmetry in |- *; assumption. -case (total_order_T 0 (f y)); intro. -elim s; intro. -cut (x < y). -intro. -apply IVT; assumption. -inversion H0. -assumption. -rewrite H2 in r. -elim (Rlt_irrefl _ (Rlt_trans _ _ _ r a)). -apply existT with y. -split. -split; [ assumption | right; reflexivity ]. -symmetry in |- *; assumption. -cut (0 < f x * f y). -intro. -elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H2 H1)). -rewrite <- Rmult_opp_opp; apply Rmult_lt_0_compat; - apply Ropp_0_gt_lt_contravar; assumption. + forall (f:R -> R) (x y:R), + continuity f -> + x <= y -> f x * f y <= 0 -> sigT (fun z:R => x <= z <= y /\ f z = 0). +Proof. + intros. + case (total_order_T 0 (f x)); intro. + case (total_order_T 0 (f y)); intro. + elim s; intro. + elim s0; intro. + cut (0 < f x * f y); + [ intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 H2)) + | apply Rmult_lt_0_compat; assumption ]. + exists y. + split. + split; [ assumption | right; reflexivity ]. + symmetry in |- *; exact b. + exists x. + split. + split; [ right; reflexivity | assumption ]. + symmetry in |- *; exact b. + elim s; intro. + cut (x < y). + intro. + assert (H3 := IVT (- f)%F x y (continuity_opp f H) H2). + cut ((- f)%F x < 0). + cut (0 < (- f)%F y). + intros. + elim (H3 H5 H4); intros. + apply existT with x0. + elim p; intros. + split. + assumption. + unfold opp_fct in H7. + rewrite <- (Ropp_involutive (f x0)). + apply Ropp_eq_0_compat; assumption. + unfold opp_fct in |- *; apply Ropp_0_gt_lt_contravar; assumption. + unfold opp_fct in |- *. + apply Rplus_lt_reg_r with (f x); rewrite Rplus_opp_r; rewrite Rplus_0_r; + assumption. + inversion H0. + assumption. + rewrite H2 in a. + elim (Rlt_irrefl _ (Rlt_trans _ _ _ r a)). + apply existT with x. + split. + split; [ right; reflexivity | assumption ]. + symmetry in |- *; assumption. + case (total_order_T 0 (f y)); intro. + elim s; intro. + cut (x < y). + intro. + apply IVT; assumption. + inversion H0. + assumption. + rewrite H2 in r. + elim (Rlt_irrefl _ (Rlt_trans _ _ _ r a)). + apply existT with y. + split. + split; [ assumption | right; reflexivity ]. + symmetry in |- *; assumption. + cut (0 < f x * f y). + intro. + elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H2 H1)). + rewrite <- Rmult_opp_opp; apply Rmult_lt_0_compat; + apply Ropp_0_gt_lt_contravar; assumption. Qed. -(* We can now define the square root function as the reciprocal transformation of the square root function *) +(** We can now define the square root function as the reciprocal + transformation of the square root function *) Lemma Rsqrt_exists : - forall y:R, 0 <= y -> sigT (fun z:R => 0 <= z /\ y = Rsqr z). -intros. -set (f := fun x:R => Rsqr x - y). -cut (f 0 <= 0). -intro. -cut (continuity f). -intro. -case (total_order_T y 1); intro. -elim s; intro. -cut (0 <= f 1). -intro. -cut (f 0 * f 1 <= 0). -intro. -assert (X := IVT_cor f 0 1 H1 (Rlt_le _ _ Rlt_0_1) H3). -elim X; intros t H4. -apply existT with t. -elim H4; intros. -split. -elim H5; intros; assumption. -unfold f in H6. -apply Rminus_diag_uniq_sym; exact H6. -rewrite Rmult_comm; pattern 0 at 2 in |- *; rewrite <- (Rmult_0_r (f 1)). -apply Rmult_le_compat_l; assumption. -unfold f in |- *. -rewrite Rsqr_1. -apply Rplus_le_reg_l with y. -rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *; - rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; - left; assumption. -apply existT with 1. -split. -left; apply Rlt_0_1. -rewrite b; symmetry in |- *; apply Rsqr_1. -cut (0 <= f y). -intro. -cut (f 0 * f y <= 0). -intro. -assert (X := IVT_cor f 0 y H1 H H3). -elim X; intros t H4. -apply existT with t. -elim H4; intros. -split. -elim H5; intros; assumption. -unfold f in H6. -apply Rminus_diag_uniq_sym; exact H6. -rewrite Rmult_comm; pattern 0 at 2 in |- *; rewrite <- (Rmult_0_r (f y)). -apply Rmult_le_compat_l; assumption. -unfold f in |- *. -apply Rplus_le_reg_l with y. -rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *; - rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r. -pattern y at 1 in |- *; rewrite <- Rmult_1_r. -unfold Rsqr in |- *; apply Rmult_le_compat_l. -assumption. -left; exact r. -replace f with (Rsqr - fct_cte y)%F. -apply continuity_minus. -apply derivable_continuous; apply derivable_Rsqr. -apply derivable_continuous; apply derivable_const. -reflexivity. -unfold f in |- *; rewrite Rsqr_0. -unfold Rminus in |- *; rewrite Rplus_0_l. -apply Rge_le. -apply Ropp_0_le_ge_contravar; assumption. + forall y:R, 0 <= y -> sigT (fun z:R => 0 <= z /\ y = Rsqr z). +Proof. + intros. + set (f := fun x:R => Rsqr x - y). + cut (f 0 <= 0). + intro. + cut (continuity f). + intro. + case (total_order_T y 1); intro. + elim s; intro. + cut (0 <= f 1). + intro. + cut (f 0 * f 1 <= 0). + intro. + assert (X := IVT_cor f 0 1 H1 (Rlt_le _ _ Rlt_0_1) H3). + elim X; intros t H4. + apply existT with t. + elim H4; intros. + split. + elim H5; intros; assumption. + unfold f in H6. + apply Rminus_diag_uniq_sym; exact H6. + rewrite Rmult_comm; pattern 0 at 2 in |- *; rewrite <- (Rmult_0_r (f 1)). + apply Rmult_le_compat_l; assumption. + unfold f in |- *. + rewrite Rsqr_1. + apply Rplus_le_reg_l with y. + rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *; + rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; + left; assumption. + apply existT with 1. + split. + left; apply Rlt_0_1. + rewrite b; symmetry in |- *; apply Rsqr_1. + cut (0 <= f y). + intro. + cut (f 0 * f y <= 0). + intro. + assert (X := IVT_cor f 0 y H1 H H3). + elim X; intros t H4. + apply existT with t. + elim H4; intros. + split. + elim H5; intros; assumption. + unfold f in H6. + apply Rminus_diag_uniq_sym; exact H6. + rewrite Rmult_comm; pattern 0 at 2 in |- *; rewrite <- (Rmult_0_r (f y)). + apply Rmult_le_compat_l; assumption. + unfold f in |- *. + apply Rplus_le_reg_l with y. + rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *; + rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r. + pattern y at 1 in |- *; rewrite <- Rmult_1_r. + unfold Rsqr in |- *; apply Rmult_le_compat_l. + assumption. + left; exact r. + replace f with (Rsqr - fct_cte y)%F. + apply continuity_minus. + apply derivable_continuous; apply derivable_Rsqr. + apply derivable_continuous; apply derivable_const. + reflexivity. + unfold f in |- *; rewrite Rsqr_0. + unfold Rminus in |- *; rewrite Rplus_0_l. + apply Rge_le. + apply Ropp_0_le_ge_contravar; assumption. Qed. (* Definition of the square root: R+->R *) Definition Rsqrt (y:nonnegreal) : R := match Rsqrt_exists (nonneg y) (cond_nonneg y) with - | existT a b => a + | existT a b => a end. (**********) Lemma Rsqrt_positivity : forall x:nonnegreal, 0 <= Rsqrt x. -intro. -assert (X := Rsqrt_exists (nonneg x) (cond_nonneg x)). -elim X; intros. -cut (x0 = Rsqrt x). -intros. -elim p; intros. -rewrite H in H0; assumption. -unfold Rsqrt in |- *. -case (Rsqrt_exists x (cond_nonneg x)). -intros. -elim p; elim a; intros. -apply Rsqr_inj. -assumption. -assumption. -rewrite <- H0; rewrite <- H2; reflexivity. +Proof. + intro. + assert (X := Rsqrt_exists (nonneg x) (cond_nonneg x)). + elim X; intros. + cut (x0 = Rsqrt x). + intros. + elim p; intros. + rewrite H in H0; assumption. + unfold Rsqrt in |- *. + case (Rsqrt_exists x (cond_nonneg x)). + intros. + elim p; elim a; intros. + apply Rsqr_inj. + assumption. + assumption. + rewrite <- H0; rewrite <- H2; reflexivity. Qed. (**********) Lemma Rsqrt_Rsqrt : forall x:nonnegreal, Rsqrt x * Rsqrt x = x. -intros. -assert (X := Rsqrt_exists (nonneg x) (cond_nonneg x)). -elim X; intros. -cut (x0 = Rsqrt x). -intros. -rewrite <- H. -elim p; intros. -rewrite H1; reflexivity. -unfold Rsqrt in |- *. -case (Rsqrt_exists x (cond_nonneg x)). -intros. -elim p; elim a; intros. -apply Rsqr_inj. -assumption. -assumption. -rewrite <- H0; rewrite <- H2; reflexivity. +Proof. + intros. + assert (X := Rsqrt_exists (nonneg x) (cond_nonneg x)). + elim X; intros. + cut (x0 = Rsqrt x). + intros. + rewrite <- H. + elim p; intros. + rewrite H1; reflexivity. + unfold Rsqrt in |- *. + case (Rsqrt_exists x (cond_nonneg x)). + intros. + elim p; elim a; intros. + apply Rsqr_inj. + assumption. + assumption. + rewrite <- H0; rewrite <- H2; reflexivity. Qed. diff --git a/theories/Reals/Rtopology.v b/theories/Reals/Rtopology.v index 84f3b081..aa47d72f 100644 --- a/theories/Reals/Rtopology.v +++ b/theories/Reals/Rtopology.v @@ -5,8 +5,8 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) - -(*i $Id: Rtopology.v 5920 2004-07-16 20:01:26Z herbelin $ i*) + +(*i $Id: Rtopology.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -15,10 +15,13 @@ Require Import RList. Require Import Classical_Prop. Require Import Classical_Pred_Type. Open Local Scope R_scope. + +(** * General definitions and propositions *) + Definition included (D1 D2:R -> Prop) : Prop := forall x:R, D1 x -> D2 x. Definition disc (x:R) (delta:posreal) (y:R) : Prop := Rabs (y - x) < delta. Definition neighbourhood (V:R -> Prop) (x:R) : Prop := - exists delta : posreal, included (disc x delta) V. + exists delta : posreal, included (disc x delta) V. Definition open_set (D:R -> Prop) : Prop := forall x:R, D x -> neighbourhood D x. Definition complementary (D:R -> Prop) (c:R) : Prop := ~ D c. @@ -28,15 +31,17 @@ Definition union_domain (D1 D2:R -> Prop) (c:R) : Prop := D1 c \/ D2 c. Definition interior (D:R -> Prop) (x:R) : Prop := neighbourhood D x. Lemma interior_P1 : forall D:R -> Prop, included (interior D) D. -intros; unfold included in |- *; unfold interior in |- *; intros; - unfold neighbourhood in H; elim H; intros; unfold included in H0; - apply H0; unfold disc in |- *; unfold Rminus in |- *; - rewrite Rplus_opp_r; rewrite Rabs_R0; apply (cond_pos x0). +Proof. + intros; unfold included in |- *; unfold interior in |- *; intros; + unfold neighbourhood in H; elim H; intros; unfold included in H0; + apply H0; unfold disc in |- *; unfold Rminus in |- *; + rewrite Rplus_opp_r; rewrite Rabs_R0; apply (cond_pos x0). Qed. Lemma interior_P2 : forall D:R -> Prop, open_set D -> included D (interior D). -intros; unfold open_set in H; unfold included in |- *; intros; - assert (H1 := H _ H0); unfold interior in |- *; apply H1. +Proof. + intros; unfold open_set in H; unfold included in |- *; intros; + assert (H1 := H _ H0); unfold interior in |- *; apply H1. Qed. Definition point_adherent (D:R -> Prop) (x:R) : Prop := @@ -45,94 +50,100 @@ Definition point_adherent (D:R -> Prop) (x:R) : Prop := Definition adherence (D:R -> Prop) (x:R) : Prop := point_adherent D x. Lemma adherence_P1 : forall D:R -> Prop, included D (adherence D). -intro; unfold included in |- *; intros; unfold adherence in |- *; - unfold point_adherent in |- *; intros; exists x; - unfold intersection_domain in |- *; split. -unfold neighbourhood in H0; elim H0; intros; unfold included in H1; apply H1; - unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; - rewrite Rabs_R0; apply (cond_pos x0). -apply H. +Proof. + intro; unfold included in |- *; intros; unfold adherence in |- *; + unfold point_adherent in |- *; intros; exists x; + unfold intersection_domain in |- *; split. + unfold neighbourhood in H0; elim H0; intros; unfold included in H1; apply H1; + unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; apply (cond_pos x0). + apply H. Qed. Lemma included_trans : - forall D1 D2 D3:R -> Prop, - included D1 D2 -> included D2 D3 -> included D1 D3. -unfold included in |- *; intros; apply H0; apply H; apply H1. + forall D1 D2 D3:R -> Prop, + included D1 D2 -> included D2 D3 -> included D1 D3. +Proof. + unfold included in |- *; intros; apply H0; apply H; apply H1. Qed. Lemma interior_P3 : forall D:R -> Prop, open_set (interior D). -intro; unfold open_set, interior in |- *; unfold neighbourhood in |- *; - intros; elim H; intros. -exists x0; unfold included in |- *; intros. -set (del := x0 - Rabs (x - x1)). -cut (0 < del). -intro; exists (mkposreal del H2); intros. -cut (included (disc x1 (mkposreal del H2)) (disc x x0)). -intro; assert (H5 := included_trans _ _ _ H4 H0). -apply H5; apply H3. -unfold included in |- *; unfold disc in |- *; intros. -apply Rle_lt_trans with (Rabs (x3 - x1) + Rabs (x1 - x)). -replace (x3 - x) with (x3 - x1 + (x1 - x)); [ apply Rabs_triang | ring ]. -replace (pos x0) with (del + Rabs (x1 - x)). -do 2 rewrite <- (Rplus_comm (Rabs (x1 - x))); apply Rplus_lt_compat_l; - apply H4. -unfold del in |- *; rewrite <- (Rabs_Ropp (x - x1)); rewrite Ropp_minus_distr; - ring. -unfold del in |- *; apply Rplus_lt_reg_r with (Rabs (x - x1)); - rewrite Rplus_0_r; - replace (Rabs (x - x1) + (x0 - Rabs (x - x1))) with (pos x0); - [ idtac | ring ]. -unfold disc in H1; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H1. +Proof. + intro; unfold open_set, interior in |- *; unfold neighbourhood in |- *; + intros; elim H; intros. + exists x0; unfold included in |- *; intros. + set (del := x0 - Rabs (x - x1)). + cut (0 < del). + intro; exists (mkposreal del H2); intros. + cut (included (disc x1 (mkposreal del H2)) (disc x x0)). + intro; assert (H5 := included_trans _ _ _ H4 H0). + apply H5; apply H3. + unfold included in |- *; unfold disc in |- *; intros. + apply Rle_lt_trans with (Rabs (x3 - x1) + Rabs (x1 - x)). + replace (x3 - x) with (x3 - x1 + (x1 - x)); [ apply Rabs_triang | ring ]. + replace (pos x0) with (del + Rabs (x1 - x)). + do 2 rewrite <- (Rplus_comm (Rabs (x1 - x))); apply Rplus_lt_compat_l; + apply H4. + unfold del in |- *; rewrite <- (Rabs_Ropp (x - x1)); rewrite Ropp_minus_distr; + ring. + unfold del in |- *; apply Rplus_lt_reg_r with (Rabs (x - x1)); + rewrite Rplus_0_r; + replace (Rabs (x - x1) + (x0 - Rabs (x - x1))) with (pos x0); + [ idtac | ring ]. + unfold disc in H1; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H1. Qed. Lemma complementary_P1 : - forall D:R -> Prop, - ~ (exists y : R, intersection_domain D (complementary D) y). -intro; red in |- *; intro; elim H; intros; - unfold intersection_domain, complementary in H0; elim H0; - intros; elim H2; assumption. + forall D:R -> Prop, + ~ (exists y : R, intersection_domain D (complementary D) y). +Proof. + intro; red in |- *; intro; elim H; intros; + unfold intersection_domain, complementary in H0; elim H0; + intros; elim H2; assumption. Qed. Lemma adherence_P2 : - forall D:R -> Prop, closed_set D -> included (adherence D) D. -unfold closed_set in |- *; unfold open_set, complementary in |- *; intros; - unfold included, adherence in |- *; intros; assert (H1 := classic (D x)); - elim H1; intro. -assumption. -assert (H3 := H _ H2); assert (H4 := H0 _ H3); elim H4; intros; - unfold intersection_domain in H5; elim H5; intros; - elim H6; assumption. + forall D:R -> Prop, closed_set D -> included (adherence D) D. +Proof. + unfold closed_set in |- *; unfold open_set, complementary in |- *; intros; + unfold included, adherence in |- *; intros; assert (H1 := classic (D x)); + elim H1; intro. + assumption. + assert (H3 := H _ H2); assert (H4 := H0 _ H3); elim H4; intros; + unfold intersection_domain in H5; elim H5; intros; + elim H6; assumption. Qed. Lemma adherence_P3 : forall D:R -> Prop, closed_set (adherence D). -intro; unfold closed_set, adherence in |- *; - unfold open_set, complementary, point_adherent in |- *; - intros; - set - (P := - fun V:R -> Prop => - neighbourhood V x -> exists y : R, intersection_domain V D y); - assert (H0 := not_all_ex_not _ P H); elim H0; intros V0 H1; - unfold P in H1; assert (H2 := imply_to_and _ _ H1); - unfold neighbourhood in |- *; elim H2; intros; unfold neighbourhood in H3; - elim H3; intros; exists x0; unfold included in |- *; - intros; red in |- *; intro. -assert (H8 := H7 V0); - cut (exists delta : posreal, (forall x:R, disc x1 delta x -> V0 x)). -intro; assert (H10 := H8 H9); elim H4; assumption. -cut (0 < x0 - Rabs (x - x1)). -intro; set (del := mkposreal _ H9); exists del; intros; - unfold included in H5; apply H5; unfold disc in |- *; - apply Rle_lt_trans with (Rabs (x2 - x1) + Rabs (x1 - x)). -replace (x2 - x) with (x2 - x1 + (x1 - x)); [ apply Rabs_triang | ring ]. -replace (pos x0) with (del + Rabs (x1 - x)). -do 2 rewrite <- (Rplus_comm (Rabs (x1 - x))); apply Rplus_lt_compat_l; - apply H10. -unfold del in |- *; simpl in |- *; rewrite <- (Rabs_Ropp (x - x1)); - rewrite Ropp_minus_distr; ring. -apply Rplus_lt_reg_r with (Rabs (x - x1)); rewrite Rplus_0_r; - replace (Rabs (x - x1) + (x0 - Rabs (x - x1))) with (pos x0); - [ rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H6 | ring ]. +Proof. + intro; unfold closed_set, adherence in |- *; + unfold open_set, complementary, point_adherent in |- *; + intros; + set + (P := + fun V:R -> Prop => + neighbourhood V x -> exists y : R, intersection_domain V D y); + assert (H0 := not_all_ex_not _ P H); elim H0; intros V0 H1; + unfold P in H1; assert (H2 := imply_to_and _ _ H1); + unfold neighbourhood in |- *; elim H2; intros; unfold neighbourhood in H3; + elim H3; intros; exists x0; unfold included in |- *; + intros; red in |- *; intro. + assert (H8 := H7 V0); + cut (exists delta : posreal, (forall x:R, disc x1 delta x -> V0 x)). + intro; assert (H10 := H8 H9); elim H4; assumption. + cut (0 < x0 - Rabs (x - x1)). + intro; set (del := mkposreal _ H9); exists del; intros; + unfold included in H5; apply H5; unfold disc in |- *; + apply Rle_lt_trans with (Rabs (x2 - x1) + Rabs (x1 - x)). + replace (x2 - x) with (x2 - x1 + (x1 - x)); [ apply Rabs_triang | ring ]. + replace (pos x0) with (del + Rabs (x1 - x)). + do 2 rewrite <- (Rplus_comm (Rabs (x1 - x))); apply Rplus_lt_compat_l; + apply H10. + unfold del in |- *; simpl in |- *; rewrite <- (Rabs_Ropp (x - x1)); + rewrite Ropp_minus_distr; ring. + apply Rplus_lt_reg_r with (Rabs (x - x1)); rewrite Rplus_0_r; + replace (Rabs (x - x1) + (x0 - Rabs (x - x1))) with (pos x0); + [ rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H6 | ring ]. Qed. Definition eq_Dom (D1 D2:R -> Prop) : Prop := @@ -141,231 +152,243 @@ Definition eq_Dom (D1 D2:R -> Prop) : Prop := Infix "=_D" := eq_Dom (at level 70, no associativity). Lemma open_set_P1 : forall D:R -> Prop, open_set D <-> D =_D interior D. -intro; split. -intro; unfold eq_Dom in |- *; split. -apply interior_P2; assumption. -apply interior_P1. -intro; unfold eq_Dom in H; elim H; clear H; intros; unfold open_set in |- *; - intros; unfold included, interior in H; unfold included in H0; - apply (H _ H1). +Proof. + intro; split. + intro; unfold eq_Dom in |- *; split. + apply interior_P2; assumption. + apply interior_P1. + intro; unfold eq_Dom in H; elim H; clear H; intros; unfold open_set in |- *; + intros; unfold included, interior in H; unfold included in H0; + apply (H _ H1). Qed. Lemma closed_set_P1 : forall D:R -> Prop, closed_set D <-> D =_D adherence D. -intro; split. -intro; unfold eq_Dom in |- *; split. -apply adherence_P1. -apply adherence_P2; assumption. -unfold eq_Dom in |- *; unfold included in |- *; intros; - assert (H0 := adherence_P3 D); unfold closed_set in H0; - unfold closed_set in |- *; unfold open_set in |- *; - unfold open_set in H0; intros; assert (H2 : complementary (adherence D) x). -unfold complementary in |- *; unfold complementary in H1; red in |- *; intro; - elim H; clear H; intros _ H; elim H1; apply (H _ H2). -assert (H3 := H0 _ H2); unfold neighbourhood in |- *; - unfold neighbourhood in H3; elim H3; intros; exists x0; - unfold included in |- *; unfold included in H4; intros; - assert (H6 := H4 _ H5); unfold complementary in H6; - unfold complementary in |- *; red in |- *; intro; - elim H; clear H; intros H _; elim H6; apply (H _ H7). +Proof. + intro; split. + intro; unfold eq_Dom in |- *; split. + apply adherence_P1. + apply adherence_P2; assumption. + unfold eq_Dom in |- *; unfold included in |- *; intros; + assert (H0 := adherence_P3 D); unfold closed_set in H0; + unfold closed_set in |- *; unfold open_set in |- *; + unfold open_set in H0; intros; assert (H2 : complementary (adherence D) x). + unfold complementary in |- *; unfold complementary in H1; red in |- *; intro; + elim H; clear H; intros _ H; elim H1; apply (H _ H2). + assert (H3 := H0 _ H2); unfold neighbourhood in |- *; + unfold neighbourhood in H3; elim H3; intros; exists x0; + unfold included in |- *; unfold included in H4; intros; + assert (H6 := H4 _ H5); unfold complementary in H6; + unfold complementary in |- *; red in |- *; intro; + elim H; clear H; intros H _; elim H6; apply (H _ H7). Qed. Lemma neighbourhood_P1 : - forall (D1 D2:R -> Prop) (x:R), - included D1 D2 -> neighbourhood D1 x -> neighbourhood D2 x. -unfold included, neighbourhood in |- *; intros; elim H0; intros; exists x0; - intros; unfold included in |- *; unfold included in H1; - intros; apply (H _ (H1 _ H2)). + forall (D1 D2:R -> Prop) (x:R), + included D1 D2 -> neighbourhood D1 x -> neighbourhood D2 x. +Proof. + unfold included, neighbourhood in |- *; intros; elim H0; intros; exists x0; + intros; unfold included in |- *; unfold included in H1; + intros; apply (H _ (H1 _ H2)). Qed. Lemma open_set_P2 : - forall D1 D2:R -> Prop, - open_set D1 -> open_set D2 -> open_set (union_domain D1 D2). -unfold open_set in |- *; intros; unfold union_domain in H1; elim H1; intro. -apply neighbourhood_P1 with D1. -unfold included, union_domain in |- *; tauto. -apply H; assumption. -apply neighbourhood_P1 with D2. -unfold included, union_domain in |- *; tauto. -apply H0; assumption. + forall D1 D2:R -> Prop, + open_set D1 -> open_set D2 -> open_set (union_domain D1 D2). +Proof. + unfold open_set in |- *; intros; unfold union_domain in H1; elim H1; intro. + apply neighbourhood_P1 with D1. + unfold included, union_domain in |- *; tauto. + apply H; assumption. + apply neighbourhood_P1 with D2. + unfold included, union_domain in |- *; tauto. + apply H0; assumption. Qed. Lemma open_set_P3 : - forall D1 D2:R -> Prop, - open_set D1 -> open_set D2 -> open_set (intersection_domain D1 D2). -unfold open_set in |- *; intros; unfold intersection_domain in H1; elim H1; - intros. -assert (H4 := H _ H2); assert (H5 := H0 _ H3); - unfold intersection_domain in |- *; unfold neighbourhood in H4, H5; - elim H4; clear H; intros del1 H; elim H5; clear H0; - intros del2 H0; cut (0 < Rmin del1 del2). -intro; set (del := mkposreal _ H6). -exists del; unfold included in |- *; intros; unfold included in H, H0; - unfold disc in H, H0, H7. -split. -apply H; apply Rlt_le_trans with (pos del). -apply H7. -unfold del in |- *; simpl in |- *; apply Rmin_l. -apply H0; apply Rlt_le_trans with (pos del). -apply H7. -unfold del in |- *; simpl in |- *; apply Rmin_r. -unfold Rmin in |- *; case (Rle_dec del1 del2); intro. -apply (cond_pos del1). -apply (cond_pos del2). + forall D1 D2:R -> Prop, + open_set D1 -> open_set D2 -> open_set (intersection_domain D1 D2). +Proof. + unfold open_set in |- *; intros; unfold intersection_domain in H1; elim H1; + intros. + assert (H4 := H _ H2); assert (H5 := H0 _ H3); + unfold intersection_domain in |- *; unfold neighbourhood in H4, H5; + elim H4; clear H; intros del1 H; elim H5; clear H0; + intros del2 H0; cut (0 < Rmin del1 del2). + intro; set (del := mkposreal _ H6). + exists del; unfold included in |- *; intros; unfold included in H, H0; + unfold disc in H, H0, H7. + split. + apply H; apply Rlt_le_trans with (pos del). + apply H7. + unfold del in |- *; simpl in |- *; apply Rmin_l. + apply H0; apply Rlt_le_trans with (pos del). + apply H7. + unfold del in |- *; simpl in |- *; apply Rmin_r. + unfold Rmin in |- *; case (Rle_dec del1 del2); intro. + apply (cond_pos del1). + apply (cond_pos del2). Qed. Lemma open_set_P4 : open_set (fun x:R => False). -unfold open_set in |- *; intros; elim H. +Proof. + unfold open_set in |- *; intros; elim H. Qed. Lemma open_set_P5 : open_set (fun x:R => True). -unfold open_set in |- *; intros; unfold neighbourhood in |- *. -exists (mkposreal 1 Rlt_0_1); unfold included in |- *; intros; trivial. +Proof. + unfold open_set in |- *; intros; unfold neighbourhood in |- *. + exists (mkposreal 1 Rlt_0_1); unfold included in |- *; intros; trivial. Qed. Lemma disc_P1 : forall (x:R) (del:posreal), open_set (disc x del). -intros; assert (H := open_set_P1 (disc x del)). -elim H; intros; apply H1. -unfold eq_Dom in |- *; split. -unfold included, interior, disc in |- *; intros; - cut (0 < del - Rabs (x - x0)). -intro; set (del2 := mkposreal _ H3). -exists del2; unfold included in |- *; intros. -apply Rle_lt_trans with (Rabs (x1 - x0) + Rabs (x0 - x)). -replace (x1 - x) with (x1 - x0 + (x0 - x)); [ apply Rabs_triang | ring ]. -replace (pos del) with (del2 + Rabs (x0 - x)). -do 2 rewrite <- (Rplus_comm (Rabs (x0 - x))); apply Rplus_lt_compat_l. -apply H4. -unfold del2 in |- *; simpl in |- *; rewrite <- (Rabs_Ropp (x - x0)); - rewrite Ropp_minus_distr; ring. -apply Rplus_lt_reg_r with (Rabs (x - x0)); rewrite Rplus_0_r; - replace (Rabs (x - x0) + (del - Rabs (x - x0))) with (pos del); - [ rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H2 | ring ]. -apply interior_P1. +Proof. + intros; assert (H := open_set_P1 (disc x del)). + elim H; intros; apply H1. + unfold eq_Dom in |- *; split. + unfold included, interior, disc in |- *; intros; + cut (0 < del - Rabs (x - x0)). + intro; set (del2 := mkposreal _ H3). + exists del2; unfold included in |- *; intros. + apply Rle_lt_trans with (Rabs (x1 - x0) + Rabs (x0 - x)). + replace (x1 - x) with (x1 - x0 + (x0 - x)); [ apply Rabs_triang | ring ]. + replace (pos del) with (del2 + Rabs (x0 - x)). + do 2 rewrite <- (Rplus_comm (Rabs (x0 - x))); apply Rplus_lt_compat_l. + apply H4. + unfold del2 in |- *; simpl in |- *; rewrite <- (Rabs_Ropp (x - x0)); + rewrite Ropp_minus_distr; ring. + apply Rplus_lt_reg_r with (Rabs (x - x0)); rewrite Rplus_0_r; + replace (Rabs (x - x0) + (del - Rabs (x - x0))) with (pos del); + [ rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H2 | ring ]. + apply interior_P1. Qed. Lemma continuity_P1 : - forall (f:R -> R) (x:R), - continuity_pt f x <-> - (forall W:R -> Prop, + forall (f:R -> R) (x:R), + continuity_pt f x <-> + (forall W:R -> Prop, neighbourhood W (f x) -> - exists V : R -> Prop, + exists V : R -> Prop, neighbourhood V x /\ (forall y:R, V y -> W (f y))). -intros; split. -intros; unfold neighbourhood in H0. -elim H0; intros del1 H1. -unfold continuity_pt in H; unfold continue_in in H; unfold limit1_in in H; - unfold limit_in in H; simpl in H; unfold R_dist in H. -assert (H2 := H del1 (cond_pos del1)). -elim H2; intros del2 H3. -elim H3; intros. -exists (disc x (mkposreal del2 H4)). -intros; unfold included in H1; split. -unfold neighbourhood, disc in |- *. -exists (mkposreal del2 H4). -unfold included in |- *; intros; assumption. -intros; apply H1; unfold disc in |- *; case (Req_dec y x); intro. -rewrite H7; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; - apply (cond_pos del1). -apply H5; split. -unfold D_x, no_cond in |- *; split. -trivial. -apply (sym_not_eq (A:=R)); apply H7. -unfold disc in H6; apply H6. -intros; unfold continuity_pt in |- *; unfold continue_in in |- *; - unfold limit1_in in |- *; unfold limit_in in |- *; - intros. -assert (H1 := H (disc (f x) (mkposreal eps H0))). -cut (neighbourhood (disc (f x) (mkposreal eps H0)) (f x)). -intro; assert (H3 := H1 H2). -elim H3; intros D H4; elim H4; intros; unfold neighbourhood in H5; elim H5; - intros del1 H7. -exists (pos del1); split. -apply (cond_pos del1). -intros; elim H8; intros; simpl in H10; unfold R_dist in H10; simpl in |- *; - unfold R_dist in |- *; apply (H6 _ (H7 _ H10)). -unfold neighbourhood, disc in |- *; exists (mkposreal eps H0); - unfold included in |- *; intros; assumption. +Proof. + intros; split. + intros; unfold neighbourhood in H0. + elim H0; intros del1 H1. + unfold continuity_pt in H; unfold continue_in in H; unfold limit1_in in H; + unfold limit_in in H; simpl in H; unfold R_dist in H. + assert (H2 := H del1 (cond_pos del1)). + elim H2; intros del2 H3. + elim H3; intros. + exists (disc x (mkposreal del2 H4)). + intros; unfold included in H1; split. + unfold neighbourhood, disc in |- *. + exists (mkposreal del2 H4). + unfold included in |- *; intros; assumption. + intros; apply H1; unfold disc in |- *; case (Req_dec y x); intro. + rewrite H7; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + apply (cond_pos del1). + apply H5; split. + unfold D_x, no_cond in |- *; split. + trivial. + apply (sym_not_eq (A:=R)); apply H7. + unfold disc in H6; apply H6. + intros; unfold continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + intros. + assert (H1 := H (disc (f x) (mkposreal eps H0))). + cut (neighbourhood (disc (f x) (mkposreal eps H0)) (f x)). + intro; assert (H3 := H1 H2). + elim H3; intros D H4; elim H4; intros; unfold neighbourhood in H5; elim H5; + intros del1 H7. + exists (pos del1); split. + apply (cond_pos del1). + intros; elim H8; intros; simpl in H10; unfold R_dist in H10; simpl in |- *; + unfold R_dist in |- *; apply (H6 _ (H7 _ H10)). + unfold neighbourhood, disc in |- *; exists (mkposreal eps H0); + unfold included in |- *; intros; assumption. Qed. Definition image_rec (f:R -> R) (D:R -> Prop) (x:R) : Prop := D (f x). (**********) Lemma continuity_P2 : - forall (f:R -> R) (D:R -> Prop), - continuity f -> open_set D -> open_set (image_rec f D). -intros; unfold open_set in H0; unfold open_set in |- *; intros; - assert (H2 := continuity_P1 f x); elim H2; intros H3 _; - assert (H4 := H3 (H x)); unfold neighbourhood, image_rec in |- *; - unfold image_rec in H1; assert (H5 := H4 D (H0 (f x) H1)); - elim H5; intros V0 H6; elim H6; intros; unfold neighbourhood in H7; - elim H7; intros del H9; exists del; unfold included in H9; - unfold included in |- *; intros; apply (H8 _ (H9 _ H10)). + forall (f:R -> R) (D:R -> Prop), + continuity f -> open_set D -> open_set (image_rec f D). +Proof. + intros; unfold open_set in H0; unfold open_set in |- *; intros; + assert (H2 := continuity_P1 f x); elim H2; intros H3 _; + assert (H4 := H3 (H x)); unfold neighbourhood, image_rec in |- *; + unfold image_rec in H1; assert (H5 := H4 D (H0 (f x) H1)); + elim H5; intros V0 H6; elim H6; intros; unfold neighbourhood in H7; + elim H7; intros del H9; exists del; unfold included in H9; + unfold included in |- *; intros; apply (H8 _ (H9 _ H10)). Qed. (**********) Lemma continuity_P3 : - forall f:R -> R, - continuity f <-> - (forall D:R -> Prop, open_set D -> open_set (image_rec f D)). -intros; split. -intros; apply continuity_P2; assumption. -intros; unfold continuity in |- *; unfold continuity_pt in |- *; - unfold continue_in in |- *; unfold limit1_in in |- *; - unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; - intros; cut (open_set (disc (f x) (mkposreal _ H0))). -intro; assert (H2 := H _ H1). -unfold open_set, image_rec in H2; cut (disc (f x) (mkposreal _ H0) (f x)). -intro; assert (H4 := H2 _ H3). -unfold neighbourhood in H4; elim H4; intros del H5. -exists (pos del); split. -apply (cond_pos del). -intros; unfold included in H5; apply H5; elim H6; intros; apply H8. -unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; - rewrite Rabs_R0; apply H0. -apply disc_P1. + forall f:R -> R, + continuity f <-> + (forall D:R -> Prop, open_set D -> open_set (image_rec f D)). +Proof. + intros; split. + intros; apply continuity_P2; assumption. + intros; unfold continuity in |- *; unfold continuity_pt in |- *; + unfold continue_in in |- *; unfold limit1_in in |- *; + unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; + intros; cut (open_set (disc (f x) (mkposreal _ H0))). + intro; assert (H2 := H _ H1). + unfold open_set, image_rec in H2; cut (disc (f x) (mkposreal _ H0) (f x)). + intro; assert (H4 := H2 _ H3). + unfold neighbourhood in H4; elim H4; intros del H5. + exists (pos del); split. + apply (cond_pos del). + intros; unfold included in H5; apply H5; elim H6; intros; apply H8. + unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; apply H0. + apply disc_P1. Qed. (**********) Theorem Rsepare : - forall x y:R, - x <> y -> + forall x y:R, + x <> y -> exists V : R -> Prop, - (exists W : R -> Prop, + (exists W : R -> Prop, neighbourhood V x /\ neighbourhood W y /\ ~ (exists y : R, intersection_domain V W y)). -intros x y Hsep; set (D := Rabs (x - y)). -cut (0 < D / 2). -intro; exists (disc x (mkposreal _ H)). -exists (disc y (mkposreal _ H)); split. -unfold neighbourhood in |- *; exists (mkposreal _ H); unfold included in |- *; - tauto. -split. -unfold neighbourhood in |- *; exists (mkposreal _ H); unfold included in |- *; - tauto. -red in |- *; intro; elim H0; intros; unfold intersection_domain in H1; - elim H1; intros. -cut (D < D). -intro; elim (Rlt_irrefl _ H4). -change (Rabs (x - y) < D) in |- *; - apply Rle_lt_trans with (Rabs (x - x0) + Rabs (x0 - y)). -replace (x - y) with (x - x0 + (x0 - y)); [ apply Rabs_triang | ring ]. -rewrite (double_var D); apply Rplus_lt_compat. -rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H2. -apply H3. -unfold Rdiv in |- *; apply Rmult_lt_0_compat. -unfold D in |- *; apply Rabs_pos_lt; apply (Rminus_eq_contra _ _ Hsep). -apply Rinv_0_lt_compat; prove_sup0. +Proof. + intros x y Hsep; set (D := Rabs (x - y)). + cut (0 < D / 2). + intro; exists (disc x (mkposreal _ H)). + exists (disc y (mkposreal _ H)); split. + unfold neighbourhood in |- *; exists (mkposreal _ H); unfold included in |- *; + tauto. + split. + unfold neighbourhood in |- *; exists (mkposreal _ H); unfold included in |- *; + tauto. + red in |- *; intro; elim H0; intros; unfold intersection_domain in H1; + elim H1; intros. + cut (D < D). + intro; elim (Rlt_irrefl _ H4). + change (Rabs (x - y) < D) in |- *; + apply Rle_lt_trans with (Rabs (x - x0) + Rabs (x0 - y)). + replace (x - y) with (x - x0 + (x0 - y)); [ apply Rabs_triang | ring ]. + rewrite (double_var D); apply Rplus_lt_compat. + rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H2. + apply H3. + unfold Rdiv in |- *; apply Rmult_lt_0_compat. + unfold D in |- *; apply Rabs_pos_lt; apply (Rminus_eq_contra _ _ Hsep). + apply Rinv_0_lt_compat; prove_sup0. Qed. Record family : Type := mkfamily {ind : R -> Prop; - f :> R -> R -> Prop; - cond_fam : forall x:R, (exists y : R, f x y) -> ind x}. + f :> R -> R -> Prop; + cond_fam : forall x:R, (exists y : R, f x y) -> ind x}. Definition family_open_set (f:family) : Prop := forall x:R, open_set (f x). Definition domain_finite (D:R -> Prop) : Prop := - exists l : Rlist, (forall x:R, D x <-> In x l). + exists l : Rlist, (forall x:R, D x <-> In x l). Definition family_finite (f:family) : Prop := domain_finite (ind f). @@ -379,897 +402,913 @@ Definition covering_finite (D:R -> Prop) (f:family) : Prop := covering D f /\ family_finite f. Lemma restriction_family : - forall (f:family) (D:R -> Prop) (x:R), - (exists y : R, (fun z1 z2:R => f z1 z2 /\ D z1) x y) -> - intersection_domain (ind f) D x. -intros; elim H; intros; unfold intersection_domain in |- *; elim H0; intros; - split. -apply (cond_fam f0); exists x0; assumption. -assumption. + forall (f:family) (D:R -> Prop) (x:R), + (exists y : R, (fun z1 z2:R => f z1 z2 /\ D z1) x y) -> + intersection_domain (ind f) D x. +Proof. + intros; elim H; intros; unfold intersection_domain in |- *; elim H0; intros; + split. + apply (cond_fam f0); exists x0; assumption. + assumption. Qed. Definition subfamily (f:family) (D:R -> Prop) : family := mkfamily (intersection_domain (ind f) D) (fun x y:R => f x y /\ D x) - (restriction_family f D). + (restriction_family f D). Definition compact (X:R -> Prop) : Prop := forall f:family, covering_open_set X f -> - exists D : R -> Prop, covering_finite X (subfamily f D). + exists D : R -> Prop, covering_finite X (subfamily f D). (**********) Lemma family_P1 : - forall (f:family) (D:R -> Prop), - family_open_set f -> family_open_set (subfamily f D). -unfold family_open_set in |- *; intros; unfold subfamily in |- *; - simpl in |- *; assert (H0 := classic (D x)). -elim H0; intro. -cut (open_set (f0 x) -> open_set (fun y:R => f0 x y /\ D x)). -intro; apply H2; apply H. -unfold open_set in |- *; unfold neighbourhood in |- *; intros; elim H3; - intros; assert (H6 := H2 _ H4); elim H6; intros; exists x1; - unfold included in |- *; intros; split. -apply (H7 _ H8). -assumption. -cut (open_set (fun y:R => False) -> open_set (fun y:R => f0 x y /\ D x)). -intro; apply H2; apply open_set_P4. -unfold open_set in |- *; unfold neighbourhood in |- *; intros; elim H3; - intros; elim H1; assumption. + forall (f:family) (D:R -> Prop), + family_open_set f -> family_open_set (subfamily f D). +Proof. + unfold family_open_set in |- *; intros; unfold subfamily in |- *; + simpl in |- *; assert (H0 := classic (D x)). + elim H0; intro. + cut (open_set (f0 x) -> open_set (fun y:R => f0 x y /\ D x)). + intro; apply H2; apply H. + unfold open_set in |- *; unfold neighbourhood in |- *; intros; elim H3; + intros; assert (H6 := H2 _ H4); elim H6; intros; exists x1; + unfold included in |- *; intros; split. + apply (H7 _ H8). + assumption. + cut (open_set (fun y:R => False) -> open_set (fun y:R => f0 x y /\ D x)). + intro; apply H2; apply open_set_P4. + unfold open_set in |- *; unfold neighbourhood in |- *; intros; elim H3; + intros; elim H1; assumption. Qed. Definition bounded (D:R -> Prop) : Prop := - exists m : R, (exists M : R, (forall x:R, D x -> m <= x <= M)). + exists m : R, (exists M : R, (forall x:R, D x -> m <= x <= M)). Lemma open_set_P6 : - forall D1 D2:R -> Prop, open_set D1 -> D1 =_D D2 -> open_set D2. -unfold open_set in |- *; unfold neighbourhood in |- *; intros. -unfold eq_Dom in H0; elim H0; intros. -assert (H4 := H _ (H3 _ H1)). -elim H4; intros. -exists x0; apply included_trans with D1; assumption. + forall D1 D2:R -> Prop, open_set D1 -> D1 =_D D2 -> open_set D2. +Proof. + unfold open_set in |- *; unfold neighbourhood in |- *; intros. + unfold eq_Dom in H0; elim H0; intros. + assert (H4 := H _ (H3 _ H1)). + elim H4; intros. + exists x0; apply included_trans with D1; assumption. Qed. (**********) Lemma compact_P1 : forall X:R -> Prop, compact X -> bounded X. -intros; unfold compact in H; set (D := fun x:R => True); - set (g := fun x y:R => Rabs y < x); - cut (forall x:R, (exists y : _, g x y) -> True); - [ intro | intro; trivial ]. -set (f0 := mkfamily D g H0); assert (H1 := H f0); - cut (covering_open_set X f0). -intro; assert (H3 := H1 H2); elim H3; intros D' H4; - unfold covering_finite in H4; elim H4; intros; unfold family_finite in H6; - unfold domain_finite in H6; elim H6; intros l H7; - unfold bounded in |- *; set (r := MaxRlist l). -exists (- r); exists r; intros. -unfold covering in H5; assert (H9 := H5 _ H8); elim H9; intros; - unfold subfamily in H10; simpl in H10; elim H10; intros; - assert (H13 := H7 x0); simpl in H13; cut (intersection_domain D D' x0). -elim H13; clear H13; intros. -assert (H16 := H13 H15); unfold g in H11; split. -cut (x0 <= r). -intro; cut (Rabs x < r). -intro; assert (H19 := Rabs_def2 x r H18); elim H19; intros; left; assumption. -apply Rlt_le_trans with x0; assumption. -apply (MaxRlist_P1 l x0 H16). -cut (x0 <= r). -intro; apply Rle_trans with (Rabs x). -apply RRle_abs. -apply Rle_trans with x0. -left; apply H11. -assumption. -apply (MaxRlist_P1 l x0 H16). -unfold intersection_domain, D in |- *; tauto. -unfold covering_open_set in |- *; split. -unfold covering in |- *; intros; simpl in |- *; exists (Rabs x + 1); - unfold g in |- *; pattern (Rabs x) at 1 in |- *; rewrite <- Rplus_0_r; - apply Rplus_lt_compat_l; apply Rlt_0_1. -unfold family_open_set in |- *; intro; case (Rtotal_order 0 x); intro. -apply open_set_P6 with (disc 0 (mkposreal _ H2)). -apply disc_P1. -unfold eq_Dom in |- *; unfold f0 in |- *; simpl in |- *; - unfold g, disc in |- *; split. -unfold included in |- *; intros; unfold Rminus in H3; rewrite Ropp_0 in H3; - rewrite Rplus_0_r in H3; apply H3. -unfold included in |- *; intros; unfold Rminus in |- *; rewrite Ropp_0; - rewrite Rplus_0_r; apply H3. -apply open_set_P6 with (fun x:R => False). -apply open_set_P4. -unfold eq_Dom in |- *; split. -unfold included in |- *; intros; elim H3. -unfold included, f0 in |- *; simpl in |- *; unfold g in |- *; intros; elim H2; - intro; - [ rewrite <- H4 in H3; assert (H5 := Rabs_pos x0); - elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H3)) - | assert (H6 := Rabs_pos x0); assert (H7 := Rlt_trans _ _ _ H3 H4); - elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 H7)) ]. +Proof. + intros; unfold compact in H; set (D := fun x:R => True); + set (g := fun x y:R => Rabs y < x); + cut (forall x:R, (exists y : _, g x y) -> True); + [ intro | intro; trivial ]. + set (f0 := mkfamily D g H0); assert (H1 := H f0); + cut (covering_open_set X f0). + intro; assert (H3 := H1 H2); elim H3; intros D' H4; + unfold covering_finite in H4; elim H4; intros; unfold family_finite in H6; + unfold domain_finite in H6; elim H6; intros l H7; + unfold bounded in |- *; set (r := MaxRlist l). + exists (- r); exists r; intros. + unfold covering in H5; assert (H9 := H5 _ H8); elim H9; intros; + unfold subfamily in H10; simpl in H10; elim H10; intros; + assert (H13 := H7 x0); simpl in H13; cut (intersection_domain D D' x0). + elim H13; clear H13; intros. + assert (H16 := H13 H15); unfold g in H11; split. + cut (x0 <= r). + intro; cut (Rabs x < r). + intro; assert (H19 := Rabs_def2 x r H18); elim H19; intros; left; assumption. + apply Rlt_le_trans with x0; assumption. + apply (MaxRlist_P1 l x0 H16). + cut (x0 <= r). + intro; apply Rle_trans with (Rabs x). + apply RRle_abs. + apply Rle_trans with x0. + left; apply H11. + assumption. + apply (MaxRlist_P1 l x0 H16). + unfold intersection_domain, D in |- *; tauto. + unfold covering_open_set in |- *; split. + unfold covering in |- *; intros; simpl in |- *; exists (Rabs x + 1); + unfold g in |- *; pattern (Rabs x) at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_lt_compat_l; apply Rlt_0_1. + unfold family_open_set in |- *; intro; case (Rtotal_order 0 x); intro. + apply open_set_P6 with (disc 0 (mkposreal _ H2)). + apply disc_P1. + unfold eq_Dom in |- *; unfold f0 in |- *; simpl in |- *; + unfold g, disc in |- *; split. + unfold included in |- *; intros; unfold Rminus in H3; rewrite Ropp_0 in H3; + rewrite Rplus_0_r in H3; apply H3. + unfold included in |- *; intros; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; apply H3. + apply open_set_P6 with (fun x:R => False). + apply open_set_P4. + unfold eq_Dom in |- *; split. + unfold included in |- *; intros; elim H3. + unfold included, f0 in |- *; simpl in |- *; unfold g in |- *; intros; elim H2; + intro; + [ rewrite <- H4 in H3; assert (H5 := Rabs_pos x0); + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H3)) + | assert (H6 := Rabs_pos x0); assert (H7 := Rlt_trans _ _ _ H3 H4); + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 H7)) ]. Qed. (**********) Lemma compact_P2 : forall X:R -> Prop, compact X -> closed_set X. -intros; assert (H0 := closed_set_P1 X); elim H0; clear H0; intros _ H0; - apply H0; clear H0. -unfold eq_Dom in |- *; split. -apply adherence_P1. -unfold included in |- *; unfold adherence in |- *; - unfold point_adherent in |- *; intros; unfold compact in H; - assert (H1 := classic (X x)); elim H1; clear H1; intro. -assumption. -cut (forall y:R, X y -> 0 < Rabs (y - x) / 2). -intro; set (D := X); - set (g := fun y z:R => Rabs (y - z) < Rabs (y - x) / 2 /\ D y); - cut (forall x:R, (exists y : _, g x y) -> D x). -intro; set (f0 := mkfamily D g H3); assert (H4 := H f0); - cut (covering_open_set X f0). -intro; assert (H6 := H4 H5); elim H6; clear H6; intros D' H6. -unfold covering_finite in H6; decompose [and] H6; - unfold covering, subfamily in H7; simpl in H7; - unfold family_finite, subfamily in H8; simpl in H8; - unfold domain_finite in H8; elim H8; clear H8; intros l H8; - set (alp := MinRlist (AbsList l x)); cut (0 < alp). -intro; assert (H10 := H0 (disc x (mkposreal _ H9))); - cut (neighbourhood (disc x (mkposreal alp H9)) x). -intro; assert (H12 := H10 H11); elim H12; clear H12; intros y H12; - unfold intersection_domain in H12; elim H12; clear H12; - intros; assert (H14 := H7 _ H13); elim H14; clear H14; - intros y0 H14; elim H14; clear H14; intros; unfold g in H14; - elim H14; clear H14; intros; unfold disc in H12; simpl in H12; - cut (alp <= Rabs (y0 - x) / 2). -intro; assert (H18 := Rlt_le_trans _ _ _ H12 H17); - cut (Rabs (y0 - x) < Rabs (y0 - x)). -intro; elim (Rlt_irrefl _ H19). -apply Rle_lt_trans with (Rabs (y0 - y) + Rabs (y - x)). -replace (y0 - x) with (y0 - y + (y - x)); [ apply Rabs_triang | ring ]. -rewrite (double_var (Rabs (y0 - x))); apply Rplus_lt_compat; assumption. -apply (MinRlist_P1 (AbsList l x) (Rabs (y0 - x) / 2)); apply AbsList_P1; - elim (H8 y0); clear H8; intros; apply H8; unfold intersection_domain in |- *; - split; assumption. -assert (H11 := disc_P1 x (mkposreal alp H9)); unfold open_set in H11; - apply H11. -unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; - rewrite Rabs_R0; apply H9. -unfold alp in |- *; apply MinRlist_P2; intros; - assert (H10 := AbsList_P2 _ _ _ H9); elim H10; clear H10; - intros z H10; elim H10; clear H10; intros; rewrite H11; - apply H2; elim (H8 z); clear H8; intros; assert (H13 := H12 H10); - unfold intersection_domain, D in H13; elim H13; clear H13; - intros; assumption. -unfold covering_open_set in |- *; split. -unfold covering in |- *; intros; exists x0; simpl in |- *; unfold g in |- *; - split. -unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; - unfold Rminus in H2; apply (H2 _ H5). -apply H5. -unfold family_open_set in |- *; intro; simpl in |- *; unfold g in |- *; - elim (classic (D x0)); intro. -apply open_set_P6 with (disc x0 (mkposreal _ (H2 _ H5))). -apply disc_P1. -unfold eq_Dom in |- *; split. -unfold included, disc in |- *; simpl in |- *; intros; split. -rewrite <- (Rabs_Ropp (x0 - x1)); rewrite Ropp_minus_distr; apply H6. -apply H5. -unfold included, disc in |- *; simpl in |- *; intros; elim H6; intros; - rewrite <- (Rabs_Ropp (x1 - x0)); rewrite Ropp_minus_distr; - apply H7. -apply open_set_P6 with (fun z:R => False). -apply open_set_P4. -unfold eq_Dom in |- *; split. -unfold included in |- *; intros; elim H6. -unfold included in |- *; intros; elim H6; intros; elim H5; assumption. -intros; elim H3; intros; unfold g in H4; elim H4; clear H4; intros _ H4; - apply H4. -intros; unfold Rdiv in |- *; apply Rmult_lt_0_compat. -apply Rabs_pos_lt; apply Rminus_eq_contra; red in |- *; intro; - rewrite H3 in H2; elim H1; apply H2. -apply Rinv_0_lt_compat; prove_sup0. +Proof. + intros; assert (H0 := closed_set_P1 X); elim H0; clear H0; intros _ H0; + apply H0; clear H0. + unfold eq_Dom in |- *; split. + apply adherence_P1. + unfold included in |- *; unfold adherence in |- *; + unfold point_adherent in |- *; intros; unfold compact in H; + assert (H1 := classic (X x)); elim H1; clear H1; intro. + assumption. + cut (forall y:R, X y -> 0 < Rabs (y - x) / 2). + intro; set (D := X); + set (g := fun y z:R => Rabs (y - z) < Rabs (y - x) / 2 /\ D y); + cut (forall x:R, (exists y : _, g x y) -> D x). + intro; set (f0 := mkfamily D g H3); assert (H4 := H f0); + cut (covering_open_set X f0). + intro; assert (H6 := H4 H5); elim H6; clear H6; intros D' H6. + unfold covering_finite in H6; decompose [and] H6; + unfold covering, subfamily in H7; simpl in H7; + unfold family_finite, subfamily in H8; simpl in H8; + unfold domain_finite in H8; elim H8; clear H8; intros l H8; + set (alp := MinRlist (AbsList l x)); cut (0 < alp). + intro; assert (H10 := H0 (disc x (mkposreal _ H9))); + cut (neighbourhood (disc x (mkposreal alp H9)) x). + intro; assert (H12 := H10 H11); elim H12; clear H12; intros y H12; + unfold intersection_domain in H12; elim H12; clear H12; + intros; assert (H14 := H7 _ H13); elim H14; clear H14; + intros y0 H14; elim H14; clear H14; intros; unfold g in H14; + elim H14; clear H14; intros; unfold disc in H12; simpl in H12; + cut (alp <= Rabs (y0 - x) / 2). + intro; assert (H18 := Rlt_le_trans _ _ _ H12 H17); + cut (Rabs (y0 - x) < Rabs (y0 - x)). + intro; elim (Rlt_irrefl _ H19). + apply Rle_lt_trans with (Rabs (y0 - y) + Rabs (y - x)). + replace (y0 - x) with (y0 - y + (y - x)); [ apply Rabs_triang | ring ]. + rewrite (double_var (Rabs (y0 - x))); apply Rplus_lt_compat; assumption. + apply (MinRlist_P1 (AbsList l x) (Rabs (y0 - x) / 2)); apply AbsList_P1; + elim (H8 y0); clear H8; intros; apply H8; unfold intersection_domain in |- *; + split; assumption. + assert (H11 := disc_P1 x (mkposreal alp H9)); unfold open_set in H11; + apply H11. + unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; apply H9. + unfold alp in |- *; apply MinRlist_P2; intros; + assert (H10 := AbsList_P2 _ _ _ H9); elim H10; clear H10; + intros z H10; elim H10; clear H10; intros; rewrite H11; + apply H2; elim (H8 z); clear H8; intros; assert (H13 := H12 H10); + unfold intersection_domain, D in H13; elim H13; clear H13; + intros; assumption. + unfold covering_open_set in |- *; split. + unfold covering in |- *; intros; exists x0; simpl in |- *; unfold g in |- *; + split. + unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + unfold Rminus in H2; apply (H2 _ H5). + apply H5. + unfold family_open_set in |- *; intro; simpl in |- *; unfold g in |- *; + elim (classic (D x0)); intro. + apply open_set_P6 with (disc x0 (mkposreal _ (H2 _ H5))). + apply disc_P1. + unfold eq_Dom in |- *; split. + unfold included, disc in |- *; simpl in |- *; intros; split. + rewrite <- (Rabs_Ropp (x0 - x1)); rewrite Ropp_minus_distr; apply H6. + apply H5. + unfold included, disc in |- *; simpl in |- *; intros; elim H6; intros; + rewrite <- (Rabs_Ropp (x1 - x0)); rewrite Ropp_minus_distr; + apply H7. + apply open_set_P6 with (fun z:R => False). + apply open_set_P4. + unfold eq_Dom in |- *; split. + unfold included in |- *; intros; elim H6. + unfold included in |- *; intros; elim H6; intros; elim H5; assumption. + intros; elim H3; intros; unfold g in H4; elim H4; clear H4; intros _ H4; + apply H4. + intros; unfold Rdiv in |- *; apply Rmult_lt_0_compat. + apply Rabs_pos_lt; apply Rminus_eq_contra; red in |- *; intro; + rewrite H3 in H2; elim H1; apply H2. + apply Rinv_0_lt_compat; prove_sup0. Qed. (**********) Lemma compact_EMP : compact (fun _:R => False). -unfold compact in |- *; intros; exists (fun x:R => False); - unfold covering_finite in |- *; split. -unfold covering in |- *; intros; elim H0. -unfold family_finite in |- *; unfold domain_finite in |- *; exists nil; intro. -split. -simpl in |- *; unfold intersection_domain in |- *; intros; elim H0. -elim H0; clear H0; intros _ H0; elim H0. -simpl in |- *; intro; elim H0. +Proof. + unfold compact in |- *; intros; exists (fun x:R => False); + unfold covering_finite in |- *; split. + unfold covering in |- *; intros; elim H0. + unfold family_finite in |- *; unfold domain_finite in |- *; exists nil; intro. + split. + simpl in |- *; unfold intersection_domain in |- *; intros; elim H0. + elim H0; clear H0; intros _ H0; elim H0. + simpl in |- *; intro; elim H0. Qed. Lemma compact_eqDom : - forall X1 X2:R -> Prop, compact X1 -> X1 =_D X2 -> compact X2. -unfold compact in |- *; intros; unfold eq_Dom in H0; elim H0; clear H0; - unfold included in |- *; intros; assert (H3 : covering_open_set X1 f0). -unfold covering_open_set in |- *; unfold covering_open_set in H1; elim H1; - clear H1; intros; split. -unfold covering in H1; unfold covering in |- *; intros; - apply (H1 _ (H0 _ H4)). -apply H3. -elim (H _ H3); intros D H4; exists D; unfold covering_finite in |- *; - unfold covering_finite in H4; elim H4; intros; split. -unfold covering in H5; unfold covering in |- *; intros; - apply (H5 _ (H2 _ H7)). -apply H6. + forall X1 X2:R -> Prop, compact X1 -> X1 =_D X2 -> compact X2. +Proof. + unfold compact in |- *; intros; unfold eq_Dom in H0; elim H0; clear H0; + unfold included in |- *; intros; assert (H3 : covering_open_set X1 f0). + unfold covering_open_set in |- *; unfold covering_open_set in H1; elim H1; + clear H1; intros; split. + unfold covering in H1; unfold covering in |- *; intros; + apply (H1 _ (H0 _ H4)). + apply H3. + elim (H _ H3); intros D H4; exists D; unfold covering_finite in |- *; + unfold covering_finite in H4; elim H4; intros; split. + unfold covering in H5; unfold covering in |- *; intros; + apply (H5 _ (H2 _ H7)). + apply H6. Qed. -(* Borel-Lebesgue's lemma *) +(** Borel-Lebesgue's lemma *) Lemma compact_P3 : forall a b:R, compact (fun c:R => a <= c <= b). -intros; case (Rle_dec a b); intro. -unfold compact in |- *; intros; - set - (A := - fun x:R => - a <= x <= b /\ - (exists D : R -> Prop, - covering_finite (fun c:R => a <= c <= x) (subfamily f0 D))); - cut (A a). -intro; cut (bound A). -intro; cut (exists a0 : R, A a0). -intro; assert (H3 := completeness A H1 H2); elim H3; clear H3; intros m H3; - unfold is_lub in H3; cut (a <= m <= b). -intro; unfold covering_open_set in H; elim H; clear H; intros; - unfold covering in H; assert (H6 := H m H4); elim H6; - clear H6; intros y0 H6; unfold family_open_set in H5; - assert (H7 := H5 y0); unfold open_set in H7; assert (H8 := H7 m H6); - unfold neighbourhood in H8; elim H8; clear H8; intros eps H8; - cut (exists x : R, A x /\ m - eps < x <= m). -intro; elim H9; clear H9; intros x H9; elim H9; clear H9; intros; - case (Req_dec m b); intro. -rewrite H11 in H10; rewrite H11 in H8; unfold A in H9; elim H9; clear H9; - intros; elim H12; clear H12; intros Dx H12; - set (Db := fun x:R => Dx x \/ x = y0); exists Db; - unfold covering_finite in |- *; split. -unfold covering in |- *; unfold covering_finite in H12; elim H12; clear H12; - intros; unfold covering in H12; case (Rle_dec x0 x); - intro. -cut (a <= x0 <= x). -intro; assert (H16 := H12 x0 H15); elim H16; clear H16; intros; exists x1; - simpl in H16; simpl in |- *; unfold Db in |- *; elim H16; - clear H16; intros; split; [ apply H16 | left; apply H17 ]. -split. -elim H14; intros; assumption. -assumption. -exists y0; simpl in |- *; split. -apply H8; unfold disc in |- *; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; - rewrite Rabs_right. -apply Rlt_trans with (b - x). -unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_gt_contravar; - auto with real. -elim H10; intros H15 _; apply Rplus_lt_reg_r with (x - eps); - replace (x - eps + (b - x)) with (b - eps); - [ replace (x - eps + eps) with x; [ apply H15 | ring ] | ring ]. -apply Rge_minus; apply Rle_ge; elim H14; intros _ H15; apply H15. -unfold Db in |- *; right; reflexivity. -unfold family_finite in |- *; unfold domain_finite in |- *; - unfold covering_finite in H12; elim H12; clear H12; - intros; unfold family_finite in H13; unfold domain_finite in H13; - elim H13; clear H13; intros l H13; exists (cons y0 l); - intro; split. -intro; simpl in H14; unfold intersection_domain in H14; elim (H13 x0); - clear H13; intros; case (Req_dec x0 y0); intro. -simpl in |- *; left; apply H16. -simpl in |- *; right; apply H13. -simpl in |- *; unfold intersection_domain in |- *; unfold Db in H14; - decompose [and or] H14. -split; assumption. -elim H16; assumption. -intro; simpl in H14; elim H14; intro; simpl in |- *; - unfold intersection_domain in |- *. -split. -apply (cond_fam f0); rewrite H15; exists m; apply H6. -unfold Db in |- *; right; assumption. -simpl in |- *; unfold intersection_domain in |- *; elim (H13 x0). -intros _ H16; assert (H17 := H16 H15); simpl in H17; - unfold intersection_domain in H17; split. -elim H17; intros; assumption. -unfold Db in |- *; left; elim H17; intros; assumption. -set (m' := Rmin (m + eps / 2) b); cut (A m'). -intro; elim H3; intros; unfold is_upper_bound in H13; - assert (H15 := H13 m' H12); cut (m < m'). -intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H15 H16)). -unfold m' in |- *; unfold Rmin in |- *; case (Rle_dec (m + eps / 2) b); intro. -pattern m at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; - unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ]. -elim H4; intros. -elim H17; intro. -assumption. -elim H11; assumption. -unfold A in |- *; split. -split. -apply Rle_trans with m. -elim H4; intros; assumption. -unfold m' in |- *; unfold Rmin in |- *; case (Rle_dec (m + eps / 2) b); intro. -pattern m at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; - unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ]. -elim H4; intros. -elim H13; intro. -assumption. -elim H11; assumption. -unfold m' in |- *; apply Rmin_r. -unfold A in H9; elim H9; clear H9; intros; elim H12; clear H12; intros Dx H12; - set (Db := fun x:R => Dx x \/ x = y0); exists Db; - unfold covering_finite in |- *; split. -unfold covering in |- *; unfold covering_finite in H12; elim H12; clear H12; - intros; unfold covering in H12; case (Rle_dec x0 x); - intro. -cut (a <= x0 <= x). -intro; assert (H16 := H12 x0 H15); elim H16; clear H16; intros; exists x1; - simpl in H16; simpl in |- *; unfold Db in |- *. -elim H16; clear H16; intros; split; [ apply H16 | left; apply H17 ]. -elim H14; intros; split; assumption. -exists y0; simpl in |- *; split. -apply H8; unfold disc in |- *; unfold Rabs in |- *; case (Rcase_abs (x0 - m)); - intro. -rewrite Ropp_minus_distr; apply Rlt_trans with (m - x). -unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_gt_contravar; - auto with real. -apply Rplus_lt_reg_r with (x - eps); - replace (x - eps + (m - x)) with (m - eps). -replace (x - eps + eps) with x. -elim H10; intros; assumption. -ring. -ring. -apply Rle_lt_trans with (m' - m). -unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- m)); - apply Rplus_le_compat_l; elim H14; intros; assumption. -apply Rplus_lt_reg_r with m; replace (m + (m' - m)) with m'. -apply Rle_lt_trans with (m + eps / 2). -unfold m' in |- *; apply Rmin_l. -apply Rplus_lt_compat_l; apply Rmult_lt_reg_l with 2. -prove_sup0. -unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym. -rewrite Rmult_1_l; pattern (pos eps) at 1 in |- *; rewrite <- Rplus_0_r; - rewrite double; apply Rplus_lt_compat_l; apply (cond_pos eps). -discrR. -ring. -unfold Db in |- *; right; reflexivity. -unfold family_finite in |- *; unfold domain_finite in |- *; - unfold covering_finite in H12; elim H12; clear H12; - intros; unfold family_finite in H13; unfold domain_finite in H13; - elim H13; clear H13; intros l H13; exists (cons y0 l); - intro; split. -intro; simpl in H14; unfold intersection_domain in H14; elim (H13 x0); - clear H13; intros; case (Req_dec x0 y0); intro. -simpl in |- *; left; apply H16. -simpl in |- *; right; apply H13; simpl in |- *; - unfold intersection_domain in |- *; unfold Db in H14; - decompose [and or] H14. -split; assumption. -elim H16; assumption. -intro; simpl in H14; elim H14; intro; simpl in |- *; - unfold intersection_domain in |- *. -split. -apply (cond_fam f0); rewrite H15; exists m; apply H6. -unfold Db in |- *; right; assumption. -elim (H13 x0); intros _ H16. -assert (H17 := H16 H15). -simpl in H17. -unfold intersection_domain in H17. -split. -elim H17; intros; assumption. -unfold Db in |- *; left; elim H17; intros; assumption. -elim (classic (exists x : R, A x /\ m - eps < x <= m)); intro. -assumption. -elim H3; intros; cut (is_upper_bound A (m - eps)). -intro; assert (H13 := H11 _ H12); cut (m - eps < m). -intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H13 H14)). -pattern m at 2 in |- *; rewrite <- Rplus_0_r; unfold Rminus in |- *; - apply Rplus_lt_compat_l; apply Ropp_lt_cancel; rewrite Ropp_involutive; - rewrite Ropp_0; apply (cond_pos eps). -set (P := fun n:R => A n /\ m - eps < n <= m); - assert (H12 := not_ex_all_not _ P H9); unfold P in H12; - unfold is_upper_bound in |- *; intros; - assert (H14 := not_and_or _ _ (H12 x)); elim H14; - intro. -elim H15; apply H13. -elim (not_and_or _ _ H15); intro. -case (Rle_dec x (m - eps)); intro. -assumption. -elim H16; auto with real. -unfold is_upper_bound in H10; assert (H17 := H10 x H13); elim H16; apply H17. -elim H3; clear H3; intros. -unfold is_upper_bound in H3. -split. -apply (H3 _ H0). -apply (H4 b); unfold is_upper_bound in |- *; intros; unfold A in H5; elim H5; - clear H5; intros H5 _; elim H5; clear H5; intros _ H5; - apply H5. -exists a; apply H0. -unfold bound in |- *; exists b; unfold is_upper_bound in |- *; intros; - unfold A in H1; elim H1; clear H1; intros H1 _; elim H1; - clear H1; intros _ H1; apply H1. -unfold A in |- *; split. -split; [ right; reflexivity | apply r ]. -unfold covering_open_set in H; elim H; clear H; intros; unfold covering in H; - cut (a <= a <= b). -intro; elim (H _ H1); intros y0 H2; set (D' := fun x:R => x = y0); exists D'; - unfold covering_finite in |- *; split. -unfold covering in |- *; simpl in |- *; intros; cut (x = a). -intro; exists y0; split. -rewrite H4; apply H2. -unfold D' in |- *; reflexivity. -elim H3; intros; apply Rle_antisym; assumption. -unfold family_finite in |- *; unfold domain_finite in |- *; - exists (cons y0 nil); intro; split. -simpl in |- *; unfold intersection_domain in |- *; intro; elim H3; clear H3; - intros; unfold D' in H4; left; apply H4. -simpl in |- *; unfold intersection_domain in |- *; intro; elim H3; intro. -split; [ rewrite H4; apply (cond_fam f0); exists a; apply H2 | apply H4 ]. -elim H4. -split; [ right; reflexivity | apply r ]. -apply compact_eqDom with (fun c:R => False). -apply compact_EMP. -unfold eq_Dom in |- *; split. -unfold included in |- *; intros; elim H. -unfold included in |- *; intros; elim H; clear H; intros; - assert (H1 := Rle_trans _ _ _ H H0); elim n; apply H1. +Proof. + intros; case (Rle_dec a b); intro. + unfold compact in |- *; intros; + set + (A := + fun x:R => + a <= x <= b /\ + (exists D : R -> Prop, + covering_finite (fun c:R => a <= c <= x) (subfamily f0 D))); + cut (A a). + intro; cut (bound A). + intro; cut (exists a0 : R, A a0). + intro; assert (H3 := completeness A H1 H2); elim H3; clear H3; intros m H3; + unfold is_lub in H3; cut (a <= m <= b). + intro; unfold covering_open_set in H; elim H; clear H; intros; + unfold covering in H; assert (H6 := H m H4); elim H6; + clear H6; intros y0 H6; unfold family_open_set in H5; + assert (H7 := H5 y0); unfold open_set in H7; assert (H8 := H7 m H6); + unfold neighbourhood in H8; elim H8; clear H8; intros eps H8; + cut (exists x : R, A x /\ m - eps < x <= m). + intro; elim H9; clear H9; intros x H9; elim H9; clear H9; intros; + case (Req_dec m b); intro. + rewrite H11 in H10; rewrite H11 in H8; unfold A in H9; elim H9; clear H9; + intros; elim H12; clear H12; intros Dx H12; + set (Db := fun x:R => Dx x \/ x = y0); exists Db; + unfold covering_finite in |- *; split. + unfold covering in |- *; unfold covering_finite in H12; elim H12; clear H12; + intros; unfold covering in H12; case (Rle_dec x0 x); + intro. + cut (a <= x0 <= x). + intro; assert (H16 := H12 x0 H15); elim H16; clear H16; intros; exists x1; + simpl in H16; simpl in |- *; unfold Db in |- *; elim H16; + clear H16; intros; split; [ apply H16 | left; apply H17 ]. + split. + elim H14; intros; assumption. + assumption. + exists y0; simpl in |- *; split. + apply H8; unfold disc in |- *; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; + rewrite Rabs_right. + apply Rlt_trans with (b - x). + unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_gt_contravar; + auto with real. + elim H10; intros H15 _; apply Rplus_lt_reg_r with (x - eps); + replace (x - eps + (b - x)) with (b - eps); + [ replace (x - eps + eps) with x; [ apply H15 | ring ] | ring ]. + apply Rge_minus; apply Rle_ge; elim H14; intros _ H15; apply H15. + unfold Db in |- *; right; reflexivity. + unfold family_finite in |- *; unfold domain_finite in |- *; + unfold covering_finite in H12; elim H12; clear H12; + intros; unfold family_finite in H13; unfold domain_finite in H13; + elim H13; clear H13; intros l H13; exists (cons y0 l); + intro; split. + intro; simpl in H14; unfold intersection_domain in H14; elim (H13 x0); + clear H13; intros; case (Req_dec x0 y0); intro. + simpl in |- *; left; apply H16. + simpl in |- *; right; apply H13. + simpl in |- *; unfold intersection_domain in |- *; unfold Db in H14; + decompose [and or] H14. + split; assumption. + elim H16; assumption. + intro; simpl in H14; elim H14; intro; simpl in |- *; + unfold intersection_domain in |- *. + split. + apply (cond_fam f0); rewrite H15; exists m; apply H6. + unfold Db in |- *; right; assumption. + simpl in |- *; unfold intersection_domain in |- *; elim (H13 x0). + intros _ H16; assert (H17 := H16 H15); simpl in H17; + unfold intersection_domain in H17; split. + elim H17; intros; assumption. + unfold Db in |- *; left; elim H17; intros; assumption. + set (m' := Rmin (m + eps / 2) b); cut (A m'). + intro; elim H3; intros; unfold is_upper_bound in H13; + assert (H15 := H13 m' H12); cut (m < m'). + intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H15 H16)). + unfold m' in |- *; unfold Rmin in |- *; case (Rle_dec (m + eps / 2) b); intro. + pattern m at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ]. + elim H4; intros. + elim H17; intro. + assumption. + elim H11; assumption. + unfold A in |- *; split. + split. + apply Rle_trans with m. + elim H4; intros; assumption. + unfold m' in |- *; unfold Rmin in |- *; case (Rle_dec (m + eps / 2) b); intro. + pattern m at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ]. + elim H4; intros. + elim H13; intro. + assumption. + elim H11; assumption. + unfold m' in |- *; apply Rmin_r. + unfold A in H9; elim H9; clear H9; intros; elim H12; clear H12; intros Dx H12; + set (Db := fun x:R => Dx x \/ x = y0); exists Db; + unfold covering_finite in |- *; split. + unfold covering in |- *; unfold covering_finite in H12; elim H12; clear H12; + intros; unfold covering in H12; case (Rle_dec x0 x); + intro. + cut (a <= x0 <= x). + intro; assert (H16 := H12 x0 H15); elim H16; clear H16; intros; exists x1; + simpl in H16; simpl in |- *; unfold Db in |- *. + elim H16; clear H16; intros; split; [ apply H16 | left; apply H17 ]. + elim H14; intros; split; assumption. + exists y0; simpl in |- *; split. + apply H8; unfold disc in |- *; unfold Rabs in |- *; case (Rcase_abs (x0 - m)); + intro. + rewrite Ropp_minus_distr; apply Rlt_trans with (m - x). + unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_gt_contravar; + auto with real. + apply Rplus_lt_reg_r with (x - eps); + replace (x - eps + (m - x)) with (m - eps). + replace (x - eps + eps) with x. + elim H10; intros; assumption. + ring. + ring. + apply Rle_lt_trans with (m' - m). + unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- m)); + apply Rplus_le_compat_l; elim H14; intros; assumption. + apply Rplus_lt_reg_r with m; replace (m + (m' - m)) with m'. + apply Rle_lt_trans with (m + eps / 2). + unfold m' in |- *; apply Rmin_l. + apply Rplus_lt_compat_l; apply Rmult_lt_reg_l with 2. + prove_sup0. + unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. + rewrite Rmult_1_l; pattern (pos eps) at 1 in |- *; rewrite <- Rplus_0_r; + rewrite double; apply Rplus_lt_compat_l; apply (cond_pos eps). + discrR. + ring. + unfold Db in |- *; right; reflexivity. + unfold family_finite in |- *; unfold domain_finite in |- *; + unfold covering_finite in H12; elim H12; clear H12; + intros; unfold family_finite in H13; unfold domain_finite in H13; + elim H13; clear H13; intros l H13; exists (cons y0 l); + intro; split. + intro; simpl in H14; unfold intersection_domain in H14; elim (H13 x0); + clear H13; intros; case (Req_dec x0 y0); intro. + simpl in |- *; left; apply H16. + simpl in |- *; right; apply H13; simpl in |- *; + unfold intersection_domain in |- *; unfold Db in H14; + decompose [and or] H14. + split; assumption. + elim H16; assumption. + intro; simpl in H14; elim H14; intro; simpl in |- *; + unfold intersection_domain in |- *. + split. + apply (cond_fam f0); rewrite H15; exists m; apply H6. + unfold Db in |- *; right; assumption. + elim (H13 x0); intros _ H16. + assert (H17 := H16 H15). + simpl in H17. + unfold intersection_domain in H17. + split. + elim H17; intros; assumption. + unfold Db in |- *; left; elim H17; intros; assumption. + elim (classic (exists x : R, A x /\ m - eps < x <= m)); intro. + assumption. + elim H3; intros; cut (is_upper_bound A (m - eps)). + intro; assert (H13 := H11 _ H12); cut (m - eps < m). + intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H13 H14)). + pattern m at 2 in |- *; rewrite <- Rplus_0_r; unfold Rminus in |- *; + apply Rplus_lt_compat_l; apply Ropp_lt_cancel; rewrite Ropp_involutive; + rewrite Ropp_0; apply (cond_pos eps). + set (P := fun n:R => A n /\ m - eps < n <= m); + assert (H12 := not_ex_all_not _ P H9); unfold P in H12; + unfold is_upper_bound in |- *; intros; + assert (H14 := not_and_or _ _ (H12 x)); elim H14; + intro. + elim H15; apply H13. + elim (not_and_or _ _ H15); intro. + case (Rle_dec x (m - eps)); intro. + assumption. + elim H16; auto with real. + unfold is_upper_bound in H10; assert (H17 := H10 x H13); elim H16; apply H17. + elim H3; clear H3; intros. + unfold is_upper_bound in H3. + split. + apply (H3 _ H0). + apply (H4 b); unfold is_upper_bound in |- *; intros; unfold A in H5; elim H5; + clear H5; intros H5 _; elim H5; clear H5; intros _ H5; + apply H5. + exists a; apply H0. + unfold bound in |- *; exists b; unfold is_upper_bound in |- *; intros; + unfold A in H1; elim H1; clear H1; intros H1 _; elim H1; + clear H1; intros _ H1; apply H1. + unfold A in |- *; split. + split; [ right; reflexivity | apply r ]. + unfold covering_open_set in H; elim H; clear H; intros; unfold covering in H; + cut (a <= a <= b). + intro; elim (H _ H1); intros y0 H2; set (D' := fun x:R => x = y0); exists D'; + unfold covering_finite in |- *; split. + unfold covering in |- *; simpl in |- *; intros; cut (x = a). + intro; exists y0; split. + rewrite H4; apply H2. + unfold D' in |- *; reflexivity. + elim H3; intros; apply Rle_antisym; assumption. + unfold family_finite in |- *; unfold domain_finite in |- *; + exists (cons y0 nil); intro; split. + simpl in |- *; unfold intersection_domain in |- *; intro; elim H3; clear H3; + intros; unfold D' in H4; left; apply H4. + simpl in |- *; unfold intersection_domain in |- *; intro; elim H3; intro. + split; [ rewrite H4; apply (cond_fam f0); exists a; apply H2 | apply H4 ]. + elim H4. + split; [ right; reflexivity | apply r ]. + apply compact_eqDom with (fun c:R => False). + apply compact_EMP. + unfold eq_Dom in |- *; split. + unfold included in |- *; intros; elim H. + unfold included in |- *; intros; elim H; clear H; intros; + assert (H1 := Rle_trans _ _ _ H H0); elim n; apply H1. Qed. Lemma compact_P4 : - forall X F:R -> Prop, compact X -> closed_set F -> included F X -> compact F. -unfold compact in |- *; intros; elim (classic (exists z : R, F z)); - intro Hyp_F_NE. -set (D := ind f0); set (g := f f0); unfold closed_set in H0. -set (g' := fun x y:R => f0 x y \/ complementary F y /\ D x). -set (D' := D). -cut (forall x:R, (exists y : R, g' x y) -> D' x). -intro; set (f' := mkfamily D' g' H3); cut (covering_open_set X f'). -intro; elim (H _ H4); intros DX H5; exists DX. -unfold covering_finite in |- *; unfold covering_finite in H5; elim H5; - clear H5; intros. -split. -unfold covering in |- *; unfold covering in H5; intros. -elim (H5 _ (H1 _ H7)); intros y0 H8; exists y0; simpl in H8; simpl in |- *; - elim H8; clear H8; intros. -split. -unfold g' in H8; elim H8; intro. -apply H10. -elim H10; intros H11 _; unfold complementary in H11; elim H11; apply H7. -apply H9. -unfold family_finite in |- *; unfold domain_finite in |- *; - unfold family_finite in H6; unfold domain_finite in H6; - elim H6; clear H6; intros l H6; exists l; intro; assert (H7 := H6 x); - elim H7; clear H7; intros. -split. -intro; apply H7; simpl in |- *; unfold intersection_domain in |- *; - simpl in H9; unfold intersection_domain in H9; unfold D' in |- *; - apply H9. -intro; assert (H10 := H8 H9); simpl in H10; unfold intersection_domain in H10; - simpl in |- *; unfold intersection_domain in |- *; - unfold D' in H10; apply H10. -unfold covering_open_set in |- *; unfold covering_open_set in H2; elim H2; - clear H2; intros. -split. -unfold covering in |- *; unfold covering in H2; intros. -elim (classic (F x)); intro. -elim (H2 _ H6); intros y0 H7; exists y0; simpl in |- *; unfold g' in |- *; - left; assumption. -cut (exists z : R, D z). -intro; elim H7; clear H7; intros x0 H7; exists x0; simpl in |- *; - unfold g' in |- *; right. -split. -unfold complementary in |- *; apply H6. -apply H7. -elim Hyp_F_NE; intros z0 H7. -assert (H8 := H2 _ H7). -elim H8; clear H8; intros t H8; exists t; apply (cond_fam f0); exists z0; - apply H8. -unfold family_open_set in |- *; intro; simpl in |- *; unfold g' in |- *; - elim (classic (D x)); intro. -apply open_set_P6 with (union_domain (f0 x) (complementary F)). -apply open_set_P2. -unfold family_open_set in H4; apply H4. -apply H0. -unfold eq_Dom in |- *; split. -unfold included, union_domain, complementary in |- *; intros. -elim H6; intro; [ left; apply H7 | right; split; assumption ]. -unfold included, union_domain, complementary in |- *; intros. -elim H6; intro; [ left; apply H7 | right; elim H7; intros; apply H8 ]. -apply open_set_P6 with (f0 x). -unfold family_open_set in H4; apply H4. -unfold eq_Dom in |- *; split. -unfold included, complementary in |- *; intros; left; apply H6. -unfold included, complementary in |- *; intros. -elim H6; intro. -apply H7. -elim H7; intros _ H8; elim H5; apply H8. -intros; elim H3; intros y0 H4; unfold g' in H4; elim H4; intro. -apply (cond_fam f0); exists y0; apply H5. -elim H5; clear H5; intros _ H5; apply H5. + forall X F:R -> Prop, compact X -> closed_set F -> included F X -> compact F. +Proof. + unfold compact in |- *; intros; elim (classic (exists z : R, F z)); + intro Hyp_F_NE. + set (D := ind f0); set (g := f f0); unfold closed_set in H0. + set (g' := fun x y:R => f0 x y \/ complementary F y /\ D x). + set (D' := D). + cut (forall x:R, (exists y : R, g' x y) -> D' x). + intro; set (f' := mkfamily D' g' H3); cut (covering_open_set X f'). + intro; elim (H _ H4); intros DX H5; exists DX. + unfold covering_finite in |- *; unfold covering_finite in H5; elim H5; + clear H5; intros. + split. + unfold covering in |- *; unfold covering in H5; intros. + elim (H5 _ (H1 _ H7)); intros y0 H8; exists y0; simpl in H8; simpl in |- *; + elim H8; clear H8; intros. + split. + unfold g' in H8; elim H8; intro. + apply H10. + elim H10; intros H11 _; unfold complementary in H11; elim H11; apply H7. + apply H9. + unfold family_finite in |- *; unfold domain_finite in |- *; + unfold family_finite in H6; unfold domain_finite in H6; + elim H6; clear H6; intros l H6; exists l; intro; assert (H7 := H6 x); + elim H7; clear H7; intros. + split. + intro; apply H7; simpl in |- *; unfold intersection_domain in |- *; + simpl in H9; unfold intersection_domain in H9; unfold D' in |- *; + apply H9. + intro; assert (H10 := H8 H9); simpl in H10; unfold intersection_domain in H10; + simpl in |- *; unfold intersection_domain in |- *; + unfold D' in H10; apply H10. + unfold covering_open_set in |- *; unfold covering_open_set in H2; elim H2; + clear H2; intros. + split. + unfold covering in |- *; unfold covering in H2; intros. + elim (classic (F x)); intro. + elim (H2 _ H6); intros y0 H7; exists y0; simpl in |- *; unfold g' in |- *; + left; assumption. + cut (exists z : R, D z). + intro; elim H7; clear H7; intros x0 H7; exists x0; simpl in |- *; + unfold g' in |- *; right. + split. + unfold complementary in |- *; apply H6. + apply H7. + elim Hyp_F_NE; intros z0 H7. + assert (H8 := H2 _ H7). + elim H8; clear H8; intros t H8; exists t; apply (cond_fam f0); exists z0; + apply H8. + unfold family_open_set in |- *; intro; simpl in |- *; unfold g' in |- *; + elim (classic (D x)); intro. + apply open_set_P6 with (union_domain (f0 x) (complementary F)). + apply open_set_P2. + unfold family_open_set in H4; apply H4. + apply H0. + unfold eq_Dom in |- *; split. + unfold included, union_domain, complementary in |- *; intros. + elim H6; intro; [ left; apply H7 | right; split; assumption ]. + unfold included, union_domain, complementary in |- *; intros. + elim H6; intro; [ left; apply H7 | right; elim H7; intros; apply H8 ]. + apply open_set_P6 with (f0 x). + unfold family_open_set in H4; apply H4. + unfold eq_Dom in |- *; split. + unfold included, complementary in |- *; intros; left; apply H6. + unfold included, complementary in |- *; intros. + elim H6; intro. + apply H7. + elim H7; intros _ H8; elim H5; apply H8. + intros; elim H3; intros y0 H4; unfold g' in H4; elim H4; intro. + apply (cond_fam f0); exists y0; apply H5. + elim H5; clear H5; intros _ H5; apply H5. (* Cas ou F est l'ensemble vide *) -cut (compact F). -intro; apply (H3 f0 H2). -apply compact_eqDom with (fun _:R => False). -apply compact_EMP. -unfold eq_Dom in |- *; split. -unfold included in |- *; intros; elim H3. -assert (H3 := not_ex_all_not _ _ Hyp_F_NE); unfold included in |- *; intros; - elim (H3 x); apply H4. + cut (compact F). + intro; apply (H3 f0 H2). + apply compact_eqDom with (fun _:R => False). + apply compact_EMP. + unfold eq_Dom in |- *; split. + unfold included in |- *; intros; elim H3. + assert (H3 := not_ex_all_not _ _ Hyp_F_NE); unfold included in |- *; intros; + elim (H3 x); apply H4. Qed. (**********) Lemma compact_P5 : forall X:R -> Prop, closed_set X -> bounded X -> compact X. -intros; unfold bounded in H0. -elim H0; clear H0; intros m H0. -elim H0; clear H0; intros M H0. -assert (H1 := compact_P3 m M). -apply (compact_P4 (fun c:R => m <= c <= M) X H1 H H0). +Proof. + intros; unfold bounded in H0. + elim H0; clear H0; intros m H0. + elim H0; clear H0; intros M H0. + assert (H1 := compact_P3 m M). + apply (compact_P4 (fun c:R => m <= c <= M) X H1 H H0). Qed. (**********) Lemma compact_carac : - forall X:R -> Prop, compact X <-> closed_set X /\ bounded X. -intro; split. -intro; split; [ apply (compact_P2 _ H) | apply (compact_P1 _ H) ]. -intro; elim H; clear H; intros; apply (compact_P5 _ H H0). + forall X:R -> Prop, compact X <-> closed_set X /\ bounded X. +Proof. + intro; split. + intro; split; [ apply (compact_P2 _ H) | apply (compact_P1 _ H) ]. + intro; elim H; clear H; intros; apply (compact_P5 _ H H0). Qed. Definition image_dir (f:R -> R) (D:R -> Prop) (x:R) : Prop := - exists y : R, x = f y /\ D y. + exists y : R, x = f y /\ D y. (**********) Lemma continuity_compact : - forall (f:R -> R) (X:R -> Prop), - (forall x:R, continuity_pt f x) -> compact X -> compact (image_dir f X). -unfold compact in |- *; intros; unfold covering_open_set in H1. -elim H1; clear H1; intros. -set (D := ind f1). -set (g := fun x y:R => image_rec f0 (f1 x) y). -cut (forall x:R, (exists y : R, g x y) -> D x). -intro; set (f' := mkfamily D g H3). -cut (covering_open_set X f'). -intro; elim (H0 f' H4); intros D' H5; exists D'. -unfold covering_finite in H5; elim H5; clear H5; intros; - unfold covering_finite in |- *; split. -unfold covering, image_dir in |- *; simpl in |- *; unfold covering in H5; - intros; elim H7; intros y H8; elim H8; intros; assert (H11 := H5 _ H10); - simpl in H11; elim H11; intros z H12; exists z; unfold g in H12; - unfold image_rec in H12; rewrite H9; apply H12. -unfold family_finite in H6; unfold domain_finite in H6; - unfold family_finite in |- *; unfold domain_finite in |- *; - elim H6; intros l H7; exists l; intro; elim (H7 x); - intros; split; intro. -apply H8; simpl in H10; simpl in |- *; apply H10. -apply (H9 H10). -unfold covering_open_set in |- *; split. -unfold covering in |- *; intros; simpl in |- *; unfold covering in H1; - unfold image_dir in H1; unfold g in |- *; unfold image_rec in |- *; - apply H1. -exists x; split; [ reflexivity | apply H4 ]. -unfold family_open_set in |- *; unfold family_open_set in H2; intro; - simpl in |- *; unfold g in |- *; - cut ((fun y:R => image_rec f0 (f1 x) y) = image_rec f0 (f1 x)). -intro; rewrite H4. -apply (continuity_P2 f0 (f1 x) H (H2 x)). -reflexivity. -intros; apply (cond_fam f1); unfold g in H3; unfold image_rec in H3; elim H3; - intros; exists (f0 x0); apply H4. + forall (f:R -> R) (X:R -> Prop), + (forall x:R, continuity_pt f x) -> compact X -> compact (image_dir f X). +Proof. + unfold compact in |- *; intros; unfold covering_open_set in H1. + elim H1; clear H1; intros. + set (D := ind f1). + set (g := fun x y:R => image_rec f0 (f1 x) y). + cut (forall x:R, (exists y : R, g x y) -> D x). + intro; set (f' := mkfamily D g H3). + cut (covering_open_set X f'). + intro; elim (H0 f' H4); intros D' H5; exists D'. + unfold covering_finite in H5; elim H5; clear H5; intros; + unfold covering_finite in |- *; split. + unfold covering, image_dir in |- *; simpl in |- *; unfold covering in H5; + intros; elim H7; intros y H8; elim H8; intros; assert (H11 := H5 _ H10); + simpl in H11; elim H11; intros z H12; exists z; unfold g in H12; + unfold image_rec in H12; rewrite H9; apply H12. + unfold family_finite in H6; unfold domain_finite in H6; + unfold family_finite in |- *; unfold domain_finite in |- *; + elim H6; intros l H7; exists l; intro; elim (H7 x); + intros; split; intro. + apply H8; simpl in H10; simpl in |- *; apply H10. + apply (H9 H10). + unfold covering_open_set in |- *; split. + unfold covering in |- *; intros; simpl in |- *; unfold covering in H1; + unfold image_dir in H1; unfold g in |- *; unfold image_rec in |- *; + apply H1. + exists x; split; [ reflexivity | apply H4 ]. + unfold family_open_set in |- *; unfold family_open_set in H2; intro; + simpl in |- *; unfold g in |- *; + cut ((fun y:R => image_rec f0 (f1 x) y) = image_rec f0 (f1 x)). + intro; rewrite H4. + apply (continuity_P2 f0 (f1 x) H (H2 x)). + reflexivity. + intros; apply (cond_fam f1); unfold g in H3; unfold image_rec in H3; elim H3; + intros; exists (f0 x0); apply H4. Qed. Lemma Rlt_Rminus : forall a b:R, a < b -> 0 < b - a. -intros; apply Rplus_lt_reg_r with a; rewrite Rplus_0_r; - replace (a + (b - a)) with b; [ assumption | ring ]. +Proof. + intros; apply Rplus_lt_reg_r with a; rewrite Rplus_0_r; + replace (a + (b - a)) with b; [ assumption | ring ]. Qed. Lemma prolongement_C0 : - forall (f:R -> R) (a b:R), - a <= b -> - (forall c:R, a <= c <= b -> continuity_pt f c) -> + forall (f:R -> R) (a b:R), + a <= b -> + (forall c:R, a <= c <= b -> continuity_pt f c) -> exists g : R -> R, - continuity g /\ (forall c:R, a <= c <= b -> g c = f c). -intros; elim H; intro. -set - (h := - fun x:R => - match Rle_dec x a with - | left _ => f0 a - | right _ => - match Rle_dec x b with - | left _ => f0 x - | right _ => f0 b - end - end). -assert (H2 : 0 < b - a). -apply Rlt_Rminus; assumption. -exists h; split. -unfold continuity in |- *; intro; case (Rtotal_order x a); intro. -unfold continuity_pt in |- *; unfold continue_in in |- *; - unfold limit1_in in |- *; unfold limit_in in |- *; - simpl in |- *; unfold R_dist in |- *; intros; exists (a - x); - split. -change (0 < a - x) in |- *; apply Rlt_Rminus; assumption. -intros; elim H5; clear H5; intros _ H5; unfold h in |- *. -case (Rle_dec x a); intro. -case (Rle_dec x0 a); intro. -unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. -elim n; left; apply Rplus_lt_reg_r with (- x); - do 2 rewrite (Rplus_comm (- x)); apply Rle_lt_trans with (Rabs (x0 - x)). -apply RRle_abs. -assumption. -elim n; left; assumption. -elim H3; intro. -assert (H5 : a <= a <= b). -split; [ right; reflexivity | left; assumption ]. -assert (H6 := H0 _ H5); unfold continuity_pt in H6; unfold continue_in in H6; - unfold limit1_in in H6; unfold limit_in in H6; simpl in H6; - unfold R_dist in H6; unfold continuity_pt in |- *; - unfold continue_in in |- *; unfold limit1_in in |- *; - unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; - intros; elim (H6 _ H7); intros; exists (Rmin x0 (b - a)); - split. -unfold Rmin in |- *; case (Rle_dec x0 (b - a)); intro. -elim H8; intros; assumption. -change (0 < b - a) in |- *; apply Rlt_Rminus; assumption. -intros; elim H9; clear H9; intros _ H9; cut (x1 < b). -intro; unfold h in |- *; case (Rle_dec x a); intro. -case (Rle_dec x1 a); intro. -unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. -case (Rle_dec x1 b); intro. -elim H8; intros; apply H12; split. -unfold D_x, no_cond in |- *; split. -trivial. -red in |- *; intro; elim n; right; symmetry in |- *; assumption. -apply Rlt_le_trans with (Rmin x0 (b - a)). -rewrite H4 in H9; apply H9. -apply Rmin_l. -elim n0; left; assumption. -elim n; right; assumption. -apply Rplus_lt_reg_r with (- a); do 2 rewrite (Rplus_comm (- a)); - rewrite H4 in H9; apply Rle_lt_trans with (Rabs (x1 - a)). -apply RRle_abs. -apply Rlt_le_trans with (Rmin x0 (b - a)). -assumption. -apply Rmin_r. -case (Rtotal_order x b); intro. -assert (H6 : a <= x <= b). -split; left; assumption. -assert (H7 := H0 _ H6); unfold continuity_pt in H7; unfold continue_in in H7; - unfold limit1_in in H7; unfold limit_in in H7; simpl in H7; - unfold R_dist in H7; unfold continuity_pt in |- *; - unfold continue_in in |- *; unfold limit1_in in |- *; - unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; - intros; elim (H7 _ H8); intros; elim H9; clear H9; - intros. -assert (H11 : 0 < x - a). -apply Rlt_Rminus; assumption. -assert (H12 : 0 < b - x). -apply Rlt_Rminus; assumption. -exists (Rmin x0 (Rmin (x - a) (b - x))); split. -unfold Rmin in |- *; case (Rle_dec (x - a) (b - x)); intro. -case (Rle_dec x0 (x - a)); intro. -assumption. -assumption. -case (Rle_dec x0 (b - x)); intro. -assumption. -assumption. -intros; elim H13; clear H13; intros; cut (a < x1 < b). -intro; elim H15; clear H15; intros; unfold h in |- *; case (Rle_dec x a); - intro. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H4)). -case (Rle_dec x b); intro. -case (Rle_dec x1 a); intro. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 H15)). -case (Rle_dec x1 b); intro. -apply H10; split. -assumption. -apply Rlt_le_trans with (Rmin x0 (Rmin (x - a) (b - x))). -assumption. -apply Rmin_l. -elim n1; left; assumption. -elim n0; left; assumption. -split. -apply Ropp_lt_cancel; apply Rplus_lt_reg_r with x; - apply Rle_lt_trans with (Rabs (x1 - x)). -rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs. -apply Rlt_le_trans with (Rmin x0 (Rmin (x - a) (b - x))). -assumption. -apply Rle_trans with (Rmin (x - a) (b - x)). -apply Rmin_r. -apply Rmin_l. -apply Rplus_lt_reg_r with (- x); do 2 rewrite (Rplus_comm (- x)); - apply Rle_lt_trans with (Rabs (x1 - x)). -apply RRle_abs. -apply Rlt_le_trans with (Rmin x0 (Rmin (x - a) (b - x))). -assumption. -apply Rle_trans with (Rmin (x - a) (b - x)); apply Rmin_r. -elim H5; intro. -assert (H7 : a <= b <= b). -split; [ left; assumption | right; reflexivity ]. -assert (H8 := H0 _ H7); unfold continuity_pt in H8; unfold continue_in in H8; - unfold limit1_in in H8; unfold limit_in in H8; simpl in H8; - unfold R_dist in H8; unfold continuity_pt in |- *; - unfold continue_in in |- *; unfold limit1_in in |- *; - unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; - intros; elim (H8 _ H9); intros; exists (Rmin x0 (b - a)); - split. -unfold Rmin in |- *; case (Rle_dec x0 (b - a)); intro. -elim H10; intros; assumption. -change (0 < b - a) in |- *; apply Rlt_Rminus; assumption. -intros; elim H11; clear H11; intros _ H11; cut (a < x1). -intro; unfold h in |- *; case (Rle_dec x a); intro. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H4)). -case (Rle_dec x1 a); intro. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H12)). -case (Rle_dec x b); intro. -case (Rle_dec x1 b); intro. -rewrite H6; elim H10; intros; elim r0; intro. -apply H14; split. -unfold D_x, no_cond in |- *; split. -trivial. -red in |- *; intro; rewrite <- H16 in H15; elim (Rlt_irrefl _ H15). -rewrite H6 in H11; apply Rlt_le_trans with (Rmin x0 (b - a)). -apply H11. -apply Rmin_l. -rewrite H15; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; - assumption. -rewrite H6; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; - assumption. -elim n1; right; assumption. -rewrite H6 in H11; apply Ropp_lt_cancel; apply Rplus_lt_reg_r with b; - apply Rle_lt_trans with (Rabs (x1 - b)). -rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs. -apply Rlt_le_trans with (Rmin x0 (b - a)). -assumption. -apply Rmin_r. -unfold continuity_pt in |- *; unfold continue_in in |- *; - unfold limit1_in in |- *; unfold limit_in in |- *; - simpl in |- *; unfold R_dist in |- *; intros; exists (x - b); - split. -change (0 < x - b) in |- *; apply Rlt_Rminus; assumption. -intros; elim H8; clear H8; intros. -assert (H10 : b < x0). -apply Ropp_lt_cancel; apply Rplus_lt_reg_r with x; - apply Rle_lt_trans with (Rabs (x0 - x)). -rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs. -assumption. -unfold h in |- *; case (Rle_dec x a); intro. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H4)). -case (Rle_dec x b); intro. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H6)). -case (Rle_dec x0 a); intro. -elim (Rlt_irrefl _ (Rlt_trans _ _ _ H1 (Rlt_le_trans _ _ _ H10 r))). -case (Rle_dec x0 b); intro. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H10)). -unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. -intros; elim H3; intros; unfold h in |- *; case (Rle_dec c a); intro. -elim r; intro. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 H6)). -rewrite H6; reflexivity. -case (Rle_dec c b); intro. -reflexivity. -elim n0; assumption. -exists (fun _:R => f0 a); split. -apply derivable_continuous; apply (derivable_const (f0 a)). -intros; elim H2; intros; rewrite H1 in H3; cut (b = c). -intro; rewrite <- H5; rewrite H1; reflexivity. -apply Rle_antisym; assumption. + continuity g /\ (forall c:R, a <= c <= b -> g c = f c). +Proof. + intros; elim H; intro. + set + (h := + fun x:R => + match Rle_dec x a with + | left _ => f0 a + | right _ => + match Rle_dec x b with + | left _ => f0 x + | right _ => f0 b + end + end). + assert (H2 : 0 < b - a). + apply Rlt_Rminus; assumption. + exists h; split. + unfold continuity in |- *; intro; case (Rtotal_order x a); intro. + unfold continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros; exists (a - x); + split. + change (0 < a - x) in |- *; apply Rlt_Rminus; assumption. + intros; elim H5; clear H5; intros _ H5; unfold h in |- *. + case (Rle_dec x a); intro. + case (Rle_dec x0 a); intro. + unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. + elim n; left; apply Rplus_lt_reg_r with (- x); + do 2 rewrite (Rplus_comm (- x)); apply Rle_lt_trans with (Rabs (x0 - x)). + apply RRle_abs. + assumption. + elim n; left; assumption. + elim H3; intro. + assert (H5 : a <= a <= b). + split; [ right; reflexivity | left; assumption ]. + assert (H6 := H0 _ H5); unfold continuity_pt in H6; unfold continue_in in H6; + unfold limit1_in in H6; unfold limit_in in H6; simpl in H6; + unfold R_dist in H6; unfold continuity_pt in |- *; + unfold continue_in in |- *; unfold limit1_in in |- *; + unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; + intros; elim (H6 _ H7); intros; exists (Rmin x0 (b - a)); + split. + unfold Rmin in |- *; case (Rle_dec x0 (b - a)); intro. + elim H8; intros; assumption. + change (0 < b - a) in |- *; apply Rlt_Rminus; assumption. + intros; elim H9; clear H9; intros _ H9; cut (x1 < b). + intro; unfold h in |- *; case (Rle_dec x a); intro. + case (Rle_dec x1 a); intro. + unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. + case (Rle_dec x1 b); intro. + elim H8; intros; apply H12; split. + unfold D_x, no_cond in |- *; split. + trivial. + red in |- *; intro; elim n; right; symmetry in |- *; assumption. + apply Rlt_le_trans with (Rmin x0 (b - a)). + rewrite H4 in H9; apply H9. + apply Rmin_l. + elim n0; left; assumption. + elim n; right; assumption. + apply Rplus_lt_reg_r with (- a); do 2 rewrite (Rplus_comm (- a)); + rewrite H4 in H9; apply Rle_lt_trans with (Rabs (x1 - a)). + apply RRle_abs. + apply Rlt_le_trans with (Rmin x0 (b - a)). + assumption. + apply Rmin_r. + case (Rtotal_order x b); intro. + assert (H6 : a <= x <= b). + split; left; assumption. + assert (H7 := H0 _ H6); unfold continuity_pt in H7; unfold continue_in in H7; + unfold limit1_in in H7; unfold limit_in in H7; simpl in H7; + unfold R_dist in H7; unfold continuity_pt in |- *; + unfold continue_in in |- *; unfold limit1_in in |- *; + unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; + intros; elim (H7 _ H8); intros; elim H9; clear H9; + intros. + assert (H11 : 0 < x - a). + apply Rlt_Rminus; assumption. + assert (H12 : 0 < b - x). + apply Rlt_Rminus; assumption. + exists (Rmin x0 (Rmin (x - a) (b - x))); split. + unfold Rmin in |- *; case (Rle_dec (x - a) (b - x)); intro. + case (Rle_dec x0 (x - a)); intro. + assumption. + assumption. + case (Rle_dec x0 (b - x)); intro. + assumption. + assumption. + intros; elim H13; clear H13; intros; cut (a < x1 < b). + intro; elim H15; clear H15; intros; unfold h in |- *; case (Rle_dec x a); + intro. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H4)). + case (Rle_dec x b); intro. + case (Rle_dec x1 a); intro. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 H15)). + case (Rle_dec x1 b); intro. + apply H10; split. + assumption. + apply Rlt_le_trans with (Rmin x0 (Rmin (x - a) (b - x))). + assumption. + apply Rmin_l. + elim n1; left; assumption. + elim n0; left; assumption. + split. + apply Ropp_lt_cancel; apply Rplus_lt_reg_r with x; + apply Rle_lt_trans with (Rabs (x1 - x)). + rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs. + apply Rlt_le_trans with (Rmin x0 (Rmin (x - a) (b - x))). + assumption. + apply Rle_trans with (Rmin (x - a) (b - x)). + apply Rmin_r. + apply Rmin_l. + apply Rplus_lt_reg_r with (- x); do 2 rewrite (Rplus_comm (- x)); + apply Rle_lt_trans with (Rabs (x1 - x)). + apply RRle_abs. + apply Rlt_le_trans with (Rmin x0 (Rmin (x - a) (b - x))). + assumption. + apply Rle_trans with (Rmin (x - a) (b - x)); apply Rmin_r. + elim H5; intro. + assert (H7 : a <= b <= b). + split; [ left; assumption | right; reflexivity ]. + assert (H8 := H0 _ H7); unfold continuity_pt in H8; unfold continue_in in H8; + unfold limit1_in in H8; unfold limit_in in H8; simpl in H8; + unfold R_dist in H8; unfold continuity_pt in |- *; + unfold continue_in in |- *; unfold limit1_in in |- *; + unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; + intros; elim (H8 _ H9); intros; exists (Rmin x0 (b - a)); + split. + unfold Rmin in |- *; case (Rle_dec x0 (b - a)); intro. + elim H10; intros; assumption. + change (0 < b - a) in |- *; apply Rlt_Rminus; assumption. + intros; elim H11; clear H11; intros _ H11; cut (a < x1). + intro; unfold h in |- *; case (Rle_dec x a); intro. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H4)). + case (Rle_dec x1 a); intro. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H12)). + case (Rle_dec x b); intro. + case (Rle_dec x1 b); intro. + rewrite H6; elim H10; intros; elim r0; intro. + apply H14; split. + unfold D_x, no_cond in |- *; split. + trivial. + red in |- *; intro; rewrite <- H16 in H15; elim (Rlt_irrefl _ H15). + rewrite H6 in H11; apply Rlt_le_trans with (Rmin x0 (b - a)). + apply H11. + apply Rmin_l. + rewrite H15; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + assumption. + rewrite H6; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + assumption. + elim n1; right; assumption. + rewrite H6 in H11; apply Ropp_lt_cancel; apply Rplus_lt_reg_r with b; + apply Rle_lt_trans with (Rabs (x1 - b)). + rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs. + apply Rlt_le_trans with (Rmin x0 (b - a)). + assumption. + apply Rmin_r. + unfold continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros; exists (x - b); + split. + change (0 < x - b) in |- *; apply Rlt_Rminus; assumption. + intros; elim H8; clear H8; intros. + assert (H10 : b < x0). + apply Ropp_lt_cancel; apply Rplus_lt_reg_r with x; + apply Rle_lt_trans with (Rabs (x0 - x)). + rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs. + assumption. + unfold h in |- *; case (Rle_dec x a); intro. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H4)). + case (Rle_dec x b); intro. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H6)). + case (Rle_dec x0 a); intro. + elim (Rlt_irrefl _ (Rlt_trans _ _ _ H1 (Rlt_le_trans _ _ _ H10 r))). + case (Rle_dec x0 b); intro. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H10)). + unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. + intros; elim H3; intros; unfold h in |- *; case (Rle_dec c a); intro. + elim r; intro. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 H6)). + rewrite H6; reflexivity. + case (Rle_dec c b); intro. + reflexivity. + elim n0; assumption. + exists (fun _:R => f0 a); split. + apply derivable_continuous; apply (derivable_const (f0 a)). + intros; elim H2; intros; rewrite H1 in H3; cut (b = c). + intro; rewrite <- H5; rewrite H1; reflexivity. + apply Rle_antisym; assumption. Qed. (**********) Lemma continuity_ab_maj : - forall (f:R -> R) (a b:R), - a <= b -> - (forall c:R, a <= c <= b -> continuity_pt f c) -> + forall (f:R -> R) (a b:R), + a <= b -> + (forall c:R, a <= c <= b -> continuity_pt f c) -> exists Mx : R, (forall c:R, a <= c <= b -> f c <= f Mx) /\ a <= Mx <= b. -intros; - cut - (exists g : R -> R, - continuity g /\ (forall c:R, a <= c <= b -> g c = f0 c)). -intro HypProl. -elim HypProl; intros g Hcont_eq. -elim Hcont_eq; clear Hcont_eq; intros Hcont Heq. -assert (H1 := compact_P3 a b). -assert (H2 := continuity_compact g (fun c:R => a <= c <= b) Hcont H1). -assert (H3 := compact_P2 _ H2). -assert (H4 := compact_P1 _ H2). -cut (bound (image_dir g (fun c:R => a <= c <= b))). -cut (exists x : R, image_dir g (fun c:R => a <= c <= b) x). -intros; assert (H7 := completeness _ H6 H5). -elim H7; clear H7; intros M H7; cut (image_dir g (fun c:R => a <= c <= b) M). -intro; unfold image_dir in H8; elim H8; clear H8; intros Mxx H8; elim H8; - clear H8; intros; exists Mxx; split. -intros; rewrite <- (Heq c H10); rewrite <- (Heq Mxx H9); intros; - rewrite <- H8; unfold is_lub in H7; elim H7; clear H7; - intros H7 _; unfold is_upper_bound in H7; apply H7; - unfold image_dir in |- *; exists c; split; [ reflexivity | apply H10 ]. -apply H9. -elim (classic (image_dir g (fun c:R => a <= c <= b) M)); intro. -assumption. -cut - (exists eps : posreal, - (forall y:R, - ~ - intersection_domain (disc M eps) - (image_dir g (fun c:R => a <= c <= b)) y)). -intro; elim H9; clear H9; intros eps H9; unfold is_lub in H7; elim H7; - clear H7; intros; - cut (is_upper_bound (image_dir g (fun c:R => a <= c <= b)) (M - eps)). -intro; assert (H12 := H10 _ H11); cut (M - eps < M). -intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H12 H13)). -pattern M at 2 in |- *; rewrite <- Rplus_0_r; unfold Rminus in |- *; - apply Rplus_lt_compat_l; apply Ropp_lt_cancel; rewrite Ropp_0; - rewrite Ropp_involutive; apply (cond_pos eps). -unfold is_upper_bound, image_dir in |- *; intros; cut (x <= M). -intro; case (Rle_dec x (M - eps)); intro. -apply r. -elim (H9 x); unfold intersection_domain, disc, image_dir in |- *; split. -rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; rewrite Rabs_right. -apply Rplus_lt_reg_r with (x - eps); - replace (x - eps + (M - x)) with (M - eps). -replace (x - eps + eps) with x. -auto with real. -ring. -ring. -apply Rge_minus; apply Rle_ge; apply H12. -apply H11. -apply H7; apply H11. -cut - (exists V : R -> Prop, - neighbourhood V M /\ - (forall y:R, - ~ intersection_domain V (image_dir g (fun c:R => a <= c <= b)) y)). -intro; elim H9; intros V H10; elim H10; clear H10; intros. -unfold neighbourhood in H10; elim H10; intros del H12; exists del; intros; - red in |- *; intro; elim (H11 y). -unfold intersection_domain in |- *; unfold intersection_domain in H13; - elim H13; clear H13; intros; split. -apply (H12 _ H13). -apply H14. -cut (~ point_adherent (image_dir g (fun c:R => a <= c <= b)) M). -intro; unfold point_adherent in H9. -assert - (H10 := - not_all_ex_not _ - (fun V:R -> Prop => - neighbourhood V M -> +Proof. + intros; + cut + (exists g : R -> R, + continuity g /\ (forall c:R, a <= c <= b -> g c = f0 c)). + intro HypProl. + elim HypProl; intros g Hcont_eq. + elim Hcont_eq; clear Hcont_eq; intros Hcont Heq. + assert (H1 := compact_P3 a b). + assert (H2 := continuity_compact g (fun c:R => a <= c <= b) Hcont H1). + assert (H3 := compact_P2 _ H2). + assert (H4 := compact_P1 _ H2). + cut (bound (image_dir g (fun c:R => a <= c <= b))). + cut (exists x : R, image_dir g (fun c:R => a <= c <= b) x). + intros; assert (H7 := completeness _ H6 H5). + elim H7; clear H7; intros M H7; cut (image_dir g (fun c:R => a <= c <= b) M). + intro; unfold image_dir in H8; elim H8; clear H8; intros Mxx H8; elim H8; + clear H8; intros; exists Mxx; split. + intros; rewrite <- (Heq c H10); rewrite <- (Heq Mxx H9); intros; + rewrite <- H8; unfold is_lub in H7; elim H7; clear H7; + intros H7 _; unfold is_upper_bound in H7; apply H7; + unfold image_dir in |- *; exists c; split; [ reflexivity | apply H10 ]. + apply H9. + elim (classic (image_dir g (fun c:R => a <= c <= b) M)); intro. + assumption. + cut + (exists eps : posreal, + (forall y:R, + ~ + intersection_domain (disc M eps) + (image_dir g (fun c:R => a <= c <= b)) y)). + intro; elim H9; clear H9; intros eps H9; unfold is_lub in H7; elim H7; + clear H7; intros; + cut (is_upper_bound (image_dir g (fun c:R => a <= c <= b)) (M - eps)). + intro; assert (H12 := H10 _ H11); cut (M - eps < M). + intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H12 H13)). + pattern M at 2 in |- *; rewrite <- Rplus_0_r; unfold Rminus in |- *; + apply Rplus_lt_compat_l; apply Ropp_lt_cancel; rewrite Ropp_0; + rewrite Ropp_involutive; apply (cond_pos eps). + unfold is_upper_bound, image_dir in |- *; intros; cut (x <= M). + intro; case (Rle_dec x (M - eps)); intro. + apply r. + elim (H9 x); unfold intersection_domain, disc, image_dir in |- *; split. + rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; rewrite Rabs_right. + apply Rplus_lt_reg_r with (x - eps); + replace (x - eps + (M - x)) with (M - eps). + replace (x - eps + eps) with x. + auto with real. + ring. + ring. + apply Rge_minus; apply Rle_ge; apply H12. + apply H11. + apply H7; apply H11. + cut + (exists V : R -> Prop, + neighbourhood V M /\ + (forall y:R, + ~ intersection_domain V (image_dir g (fun c:R => a <= c <= b)) y)). + intro; elim H9; intros V H10; elim H10; clear H10; intros. + unfold neighbourhood in H10; elim H10; intros del H12; exists del; intros; + red in |- *; intro; elim (H11 y). + unfold intersection_domain in |- *; unfold intersection_domain in H13; + elim H13; clear H13; intros; split. + apply (H12 _ H13). + apply H14. + cut (~ point_adherent (image_dir g (fun c:R => a <= c <= b)) M). + intro; unfold point_adherent in H9. + assert + (H10 := + not_all_ex_not _ + (fun V:R -> Prop => + neighbourhood V M -> exists y : R, - intersection_domain V (image_dir g (fun c:R => a <= c <= b)) y) H9). -elim H10; intros V0 H11; exists V0; assert (H12 := imply_to_and _ _ H11); - elim H12; clear H12; intros. -split. -apply H12. -apply (not_ex_all_not _ _ H13). -red in |- *; intro; cut (adherence (image_dir g (fun c:R => a <= c <= b)) M). -intro; elim (closed_set_P1 (image_dir g (fun c:R => a <= c <= b))); - intros H11 _; assert (H12 := H11 H3). -elim H8. -unfold eq_Dom in H12; elim H12; clear H12; intros. -apply (H13 _ H10). -apply H9. -exists (g a); unfold image_dir in |- *; exists a; split. -reflexivity. -split; [ right; reflexivity | apply H ]. -unfold bound in |- *; unfold bounded in H4; elim H4; clear H4; intros m H4; - elim H4; clear H4; intros M H4; exists M; unfold is_upper_bound in |- *; - intros; elim (H4 _ H5); intros _ H6; apply H6. -apply prolongement_C0; assumption. + intersection_domain V (image_dir g (fun c:R => a <= c <= b)) y) H9). + elim H10; intros V0 H11; exists V0; assert (H12 := imply_to_and _ _ H11); + elim H12; clear H12; intros. + split. + apply H12. + apply (not_ex_all_not _ _ H13). + red in |- *; intro; cut (adherence (image_dir g (fun c:R => a <= c <= b)) M). + intro; elim (closed_set_P1 (image_dir g (fun c:R => a <= c <= b))); + intros H11 _; assert (H12 := H11 H3). + elim H8. + unfold eq_Dom in H12; elim H12; clear H12; intros. + apply (H13 _ H10). + apply H9. + exists (g a); unfold image_dir in |- *; exists a; split. + reflexivity. + split; [ right; reflexivity | apply H ]. + unfold bound in |- *; unfold bounded in H4; elim H4; clear H4; intros m H4; + elim H4; clear H4; intros M H4; exists M; unfold is_upper_bound in |- *; + intros; elim (H4 _ H5); intros _ H6; apply H6. + apply prolongement_C0; assumption. Qed. (**********) Lemma continuity_ab_min : - forall (f:R -> R) (a b:R), - a <= b -> - (forall c:R, a <= c <= b -> continuity_pt f c) -> + forall (f:R -> R) (a b:R), + a <= b -> + (forall c:R, a <= c <= b -> continuity_pt f c) -> exists mx : R, (forall c:R, a <= c <= b -> f mx <= f c) /\ a <= mx <= b. -intros. -cut (forall c:R, a <= c <= b -> continuity_pt (- f0) c). -intro; assert (H2 := continuity_ab_maj (- f0)%F a b H H1); elim H2; - intros x0 H3; exists x0; intros; split. -intros; rewrite <- (Ropp_involutive (f0 x0)); - rewrite <- (Ropp_involutive (f0 c)); apply Ropp_le_contravar; - elim H3; intros; unfold opp_fct in H5; apply H5; apply H4. -elim H3; intros; assumption. -intros. -assert (H2 := H0 _ H1). -apply (continuity_pt_opp _ _ H2). +Proof. + intros. + cut (forall c:R, a <= c <= b -> continuity_pt (- f0) c). + intro; assert (H2 := continuity_ab_maj (- f0)%F a b H H1); elim H2; + intros x0 H3; exists x0; intros; split. + intros; rewrite <- (Ropp_involutive (f0 x0)); + rewrite <- (Ropp_involutive (f0 c)); apply Ropp_le_contravar; + elim H3; intros; unfold opp_fct in H5; apply H5; apply H4. + elim H3; intros; assumption. + intros. + assert (H2 := H0 _ H1). + apply (continuity_pt_opp _ _ H2). Qed. (********************************************************) -(* Proof of Bolzano-Weierstrass theorem *) +(** * Proof of Bolzano-Weierstrass theorem *) (********************************************************) Definition ValAdh (un:nat -> R) (x:R) : Prop := @@ -1280,66 +1319,69 @@ Definition intersection_family (f:family) (x:R) : Prop := forall y:R, ind f y -> f y x. Lemma ValAdh_un_exists : - forall (un:nat -> R) (D:=fun x:R => exists n : nat, x = INR n) - (f:= - fun x:R => - adherence + forall (un:nat -> R) (D:=fun x:R => exists n : nat, x = INR n) + (f:= + fun x:R => + adherence (fun y:R => (exists p : nat, y = un p /\ x <= INR p) /\ D x)) - (x:R), (exists y : R, f x y) -> D x. -intros; elim H; intros; unfold f in H0; unfold adherence in H0; - unfold point_adherent in H0; - assert (H1 : neighbourhood (disc x0 (mkposreal _ Rlt_0_1)) x0). -unfold neighbourhood, disc in |- *; exists (mkposreal _ Rlt_0_1); - unfold included in |- *; trivial. -elim (H0 _ H1); intros; unfold intersection_domain in H2; elim H2; intros; - elim H4; intros; apply H6. + (x:R), (exists y : R, f x y) -> D x. +Proof. + intros; elim H; intros; unfold f in H0; unfold adherence in H0; + unfold point_adherent in H0; + assert (H1 : neighbourhood (disc x0 (mkposreal _ Rlt_0_1)) x0). + unfold neighbourhood, disc in |- *; exists (mkposreal _ Rlt_0_1); + unfold included in |- *; trivial. + elim (H0 _ H1); intros; unfold intersection_domain in H2; elim H2; intros; + elim H4; intros; apply H6. Qed. Definition ValAdh_un (un:nat -> R) : R -> Prop := let D := fun x:R => exists n : nat, x = INR n in - let f := - fun x:R => - adherence + let f := + fun x:R => + adherence (fun y:R => (exists p : nat, y = un p /\ x <= INR p) /\ D x) in - intersection_family (mkfamily D f (ValAdh_un_exists un)). + intersection_family (mkfamily D f (ValAdh_un_exists un)). Lemma ValAdh_un_prop : - forall (un:nat -> R) (x:R), ValAdh un x <-> ValAdh_un un x. -intros; split; intro. -unfold ValAdh in H; unfold ValAdh_un in |- *; - unfold intersection_family in |- *; simpl in |- *; - intros; elim H0; intros N H1; unfold adherence in |- *; - unfold point_adherent in |- *; intros; elim (H V N H2); - intros; exists (un x0); unfold intersection_domain in |- *; - elim H3; clear H3; intros; split. -assumption. -split. -exists x0; split; [ reflexivity | rewrite H1; apply (le_INR _ _ H3) ]. -exists N; assumption. -unfold ValAdh in |- *; intros; unfold ValAdh_un in H; - unfold intersection_family in H; simpl in H; - assert - (H1 : - adherence - (fun y0:R => - (exists p : nat, y0 = un p /\ INR N <= INR p) /\ - (exists n : nat, INR N = INR n)) x). -apply H; exists N; reflexivity. -unfold adherence in H1; unfold point_adherent in H1; assert (H2 := H1 _ H0); - elim H2; intros; unfold intersection_domain in H3; - elim H3; clear H3; intros; elim H4; clear H4; intros; - elim H4; clear H4; intros; elim H4; clear H4; intros; - exists x1; split. -apply (INR_le _ _ H6). -rewrite H4 in H3; apply H3. + forall (un:nat -> R) (x:R), ValAdh un x <-> ValAdh_un un x. +Proof. + intros; split; intro. + unfold ValAdh in H; unfold ValAdh_un in |- *; + unfold intersection_family in |- *; simpl in |- *; + intros; elim H0; intros N H1; unfold adherence in |- *; + unfold point_adherent in |- *; intros; elim (H V N H2); + intros; exists (un x0); unfold intersection_domain in |- *; + elim H3; clear H3; intros; split. + assumption. + split. + exists x0; split; [ reflexivity | rewrite H1; apply (le_INR _ _ H3) ]. + exists N; assumption. + unfold ValAdh in |- *; intros; unfold ValAdh_un in H; + unfold intersection_family in H; simpl in H; + assert + (H1 : + adherence + (fun y0:R => + (exists p : nat, y0 = un p /\ INR N <= INR p) /\ + (exists n : nat, INR N = INR n)) x). + apply H; exists N; reflexivity. + unfold adherence in H1; unfold point_adherent in H1; assert (H2 := H1 _ H0); + elim H2; intros; unfold intersection_domain in H3; + elim H3; clear H3; intros; elim H4; clear H4; intros; + elim H4; clear H4; intros; elim H4; clear H4; intros; + exists x1; split. + apply (INR_le _ _ H6). + rewrite H4 in H3; apply H3. Qed. Lemma adherence_P4 : - forall F G:R -> Prop, included F G -> included (adherence F) (adherence G). -unfold adherence, included in |- *; unfold point_adherent in |- *; intros; - elim (H0 _ H1); unfold intersection_domain in |- *; - intros; elim H2; clear H2; intros; exists x0; split; - [ assumption | apply (H _ H3) ]. + forall F G:R -> Prop, included F G -> included (adherence F) (adherence G). +Proof. + unfold adherence, included in |- *; unfold point_adherent in |- *; intros; + elim (H0 _ H1); unfold intersection_domain in |- *; + intros; elim H2; clear H2; intros; exists x0; split; + [ assumption | apply (H _ H3) ]. Qed. Definition family_closed_set (f:family) : Prop := @@ -1355,471 +1397,476 @@ Definition intersection_vide_finite_in (D:R -> Prop) (**********) Lemma compact_P6 : - forall X:R -> Prop, - compact X -> - (exists z : R, X z) -> - forall g:family, - family_closed_set g -> - intersection_vide_in X g -> + forall X:R -> Prop, + compact X -> + (exists z : R, X z) -> + forall g:family, + family_closed_set g -> + intersection_vide_in X g -> exists D : R -> Prop, intersection_vide_finite_in X (subfamily g D). -intros X H Hyp g H0 H1. -set (D' := ind g). -set (f' := fun x y:R => complementary (g x) y /\ D' x). -assert (H2 : forall x:R, (exists y : R, f' x y) -> D' x). -intros; elim H2; intros; unfold f' in H3; elim H3; intros; assumption. -set (f0 := mkfamily D' f' H2). -unfold compact in H; assert (H3 : covering_open_set X f0). -unfold covering_open_set in |- *; split. -unfold covering in |- *; intros; unfold intersection_vide_in in H1; - elim (H1 x); intros; unfold intersection_family in H5; - assert - (H6 := not_ex_all_not _ (fun y:R => forall y0:R, ind g y0 -> g y0 y) H5 x); - assert (H7 := not_all_ex_not _ (fun y0:R => ind g y0 -> g y0 x) H6); - elim H7; intros; exists x0; elim (imply_to_and _ _ H8); - intros; unfold f0 in |- *; simpl in |- *; unfold f' in |- *; - split; [ apply H10 | apply H9 ]. -unfold family_open_set in |- *; intro; elim (classic (D' x)); intro. -apply open_set_P6 with (complementary (g x)). -unfold family_closed_set in H0; unfold closed_set in H0; apply H0. -unfold f0 in |- *; simpl in |- *; unfold f' in |- *; unfold eq_Dom in |- *; - split. -unfold included in |- *; intros; split; [ apply H4 | apply H3 ]. -unfold included in |- *; intros; elim H4; intros; assumption. -apply open_set_P6 with (fun _:R => False). -apply open_set_P4. -unfold eq_Dom in |- *; unfold included in |- *; split; intros; - [ elim H4 - | simpl in H4; unfold f' in H4; elim H4; intros; elim H3; assumption ]. -elim (H _ H3); intros SF H4; exists SF; - unfold intersection_vide_finite_in in |- *; split. -unfold intersection_vide_in in |- *; simpl in |- *; intros; split. -intros; unfold included in |- *; intros; unfold intersection_vide_in in H1; - elim (H1 x); intros; elim H6; intros; apply H7. -unfold intersection_domain in H5; elim H5; intros; assumption. -assumption. -elim (classic (exists y : R, intersection_domain (ind g) SF y)); intro Hyp'. -red in |- *; intro; elim H5; intros; unfold intersection_family in H6; - simpl in H6. -cut (X x0). -intro; unfold covering_finite in H4; elim H4; clear H4; intros H4 _; - unfold covering in H4; elim (H4 x0 H7); intros; simpl in H8; - unfold intersection_domain in H6; cut (ind g x1 /\ SF x1). -intro; assert (H10 := H6 x1 H9); elim H10; clear H10; intros H10 _; elim H8; - clear H8; intros H8 _; unfold f' in H8; unfold complementary in H8; - elim H8; clear H8; intros H8 _; elim H8; assumption. -split. -apply (cond_fam f0). -exists x0; elim H8; intros; assumption. -elim H8; intros; assumption. -unfold intersection_vide_in in H1; elim Hyp'; intros; assert (H8 := H6 _ H7); - elim H8; intros; cut (ind g x1). -intro; elim (H1 x1); intros; apply H12. -apply H11. -apply H9. -apply (cond_fam g); exists x0; assumption. -unfold covering_finite in H4; elim H4; clear H4; intros H4 _; - cut (exists z : R, X z). -intro; elim H5; clear H5; intros; unfold covering in H4; elim (H4 x0 H5); - intros; simpl in H6; elim Hyp'; exists x1; elim H6; - intros; unfold intersection_domain in |- *; split. -apply (cond_fam f0); exists x0; apply H7. -apply H8. -apply Hyp. -unfold covering_finite in H4; elim H4; clear H4; intros; - unfold family_finite in H5; unfold domain_finite in H5; - unfold family_finite in |- *; unfold domain_finite in |- *; - elim H5; clear H5; intros l H5; exists l; intro; elim (H5 x); - intros; split; intro; - [ apply H6; simpl in |- *; simpl in H8; apply H8 | apply (H7 H8) ]. +Proof. + intros X H Hyp g H0 H1. + set (D' := ind g). + set (f' := fun x y:R => complementary (g x) y /\ D' x). + assert (H2 : forall x:R, (exists y : R, f' x y) -> D' x). + intros; elim H2; intros; unfold f' in H3; elim H3; intros; assumption. + set (f0 := mkfamily D' f' H2). + unfold compact in H; assert (H3 : covering_open_set X f0). + unfold covering_open_set in |- *; split. + unfold covering in |- *; intros; unfold intersection_vide_in in H1; + elim (H1 x); intros; unfold intersection_family in H5; + assert + (H6 := not_ex_all_not _ (fun y:R => forall y0:R, ind g y0 -> g y0 y) H5 x); + assert (H7 := not_all_ex_not _ (fun y0:R => ind g y0 -> g y0 x) H6); + elim H7; intros; exists x0; elim (imply_to_and _ _ H8); + intros; unfold f0 in |- *; simpl in |- *; unfold f' in |- *; + split; [ apply H10 | apply H9 ]. + unfold family_open_set in |- *; intro; elim (classic (D' x)); intro. + apply open_set_P6 with (complementary (g x)). + unfold family_closed_set in H0; unfold closed_set in H0; apply H0. + unfold f0 in |- *; simpl in |- *; unfold f' in |- *; unfold eq_Dom in |- *; + split. + unfold included in |- *; intros; split; [ apply H4 | apply H3 ]. + unfold included in |- *; intros; elim H4; intros; assumption. + apply open_set_P6 with (fun _:R => False). + apply open_set_P4. + unfold eq_Dom in |- *; unfold included in |- *; split; intros; + [ elim H4 + | simpl in H4; unfold f' in H4; elim H4; intros; elim H3; assumption ]. + elim (H _ H3); intros SF H4; exists SF; + unfold intersection_vide_finite_in in |- *; split. + unfold intersection_vide_in in |- *; simpl in |- *; intros; split. + intros; unfold included in |- *; intros; unfold intersection_vide_in in H1; + elim (H1 x); intros; elim H6; intros; apply H7. + unfold intersection_domain in H5; elim H5; intros; assumption. + assumption. + elim (classic (exists y : R, intersection_domain (ind g) SF y)); intro Hyp'. + red in |- *; intro; elim H5; intros; unfold intersection_family in H6; + simpl in H6. + cut (X x0). + intro; unfold covering_finite in H4; elim H4; clear H4; intros H4 _; + unfold covering in H4; elim (H4 x0 H7); intros; simpl in H8; + unfold intersection_domain in H6; cut (ind g x1 /\ SF x1). + intro; assert (H10 := H6 x1 H9); elim H10; clear H10; intros H10 _; elim H8; + clear H8; intros H8 _; unfold f' in H8; unfold complementary in H8; + elim H8; clear H8; intros H8 _; elim H8; assumption. + split. + apply (cond_fam f0). + exists x0; elim H8; intros; assumption. + elim H8; intros; assumption. + unfold intersection_vide_in in H1; elim Hyp'; intros; assert (H8 := H6 _ H7); + elim H8; intros; cut (ind g x1). + intro; elim (H1 x1); intros; apply H12. + apply H11. + apply H9. + apply (cond_fam g); exists x0; assumption. + unfold covering_finite in H4; elim H4; clear H4; intros H4 _; + cut (exists z : R, X z). + intro; elim H5; clear H5; intros; unfold covering in H4; elim (H4 x0 H5); + intros; simpl in H6; elim Hyp'; exists x1; elim H6; + intros; unfold intersection_domain in |- *; split. + apply (cond_fam f0); exists x0; apply H7. + apply H8. + apply Hyp. + unfold covering_finite in H4; elim H4; clear H4; intros; + unfold family_finite in H5; unfold domain_finite in H5; + unfold family_finite in |- *; unfold domain_finite in |- *; + elim H5; clear H5; intros l H5; exists l; intro; elim (H5 x); + intros; split; intro; + [ apply H6; simpl in |- *; simpl in H8; apply H8 | apply (H7 H8) ]. Qed. Theorem Bolzano_Weierstrass : - forall (un:nat -> R) (X:R -> Prop), - compact X -> (forall n:nat, X (un n)) -> exists l : R, ValAdh un l. -intros; cut (exists l : R, ValAdh_un un l). -intro; elim H1; intros; exists x; elim (ValAdh_un_prop un x); intros; - apply (H4 H2). -assert (H1 : exists z : R, X z). -exists (un 0%nat); apply H0. -set (D := fun x:R => exists n : nat, x = INR n). -set - (g := - fun x:R => - adherence (fun y:R => (exists p : nat, y = un p /\ x <= INR p) /\ D x)). -assert (H2 : forall x:R, (exists y : R, g x y) -> D x). -intros; elim H2; intros; unfold g in H3; unfold adherence in H3; - unfold point_adherent in H3. -assert (H4 : neighbourhood (disc x0 (mkposreal _ Rlt_0_1)) x0). -unfold neighbourhood in |- *; exists (mkposreal _ Rlt_0_1); - unfold included in |- *; trivial. -elim (H3 _ H4); intros; unfold intersection_domain in H5; decompose [and] H5; - assumption. -set (f0 := mkfamily D g H2). -assert (H3 := compact_P6 X H H1 f0). -elim (classic (exists l : R, ValAdh_un un l)); intro. -assumption. -cut (family_closed_set f0). -intro; cut (intersection_vide_in X f0). -intro; assert (H7 := H3 H5 H6). -elim H7; intros SF H8; unfold intersection_vide_finite_in in H8; elim H8; - clear H8; intros; unfold intersection_vide_in in H8; - elim (H8 0); intros _ H10; elim H10; unfold family_finite in H9; - unfold domain_finite in H9; elim H9; clear H9; intros l H9; - set (r := MaxRlist l); cut (D r). -intro; unfold D in H11; elim H11; intros; exists (un x); - unfold intersection_family in |- *; simpl in |- *; - unfold intersection_domain in |- *; intros; split. -unfold g in |- *; apply adherence_P1; split. -exists x; split; - [ reflexivity - | rewrite <- H12; unfold r in |- *; apply MaxRlist_P1; elim (H9 y); intros; - apply H14; simpl in |- *; apply H13 ]. -elim H13; intros; assumption. -elim H13; intros; assumption. -elim (H9 r); intros. -simpl in H12; unfold intersection_domain in H12; cut (In r l). -intro; elim (H12 H13); intros; assumption. -unfold r in |- *; apply MaxRlist_P2; - cut (exists z : R, intersection_domain (ind f0) SF z). -intro; elim H13; intros; elim (H9 x); intros; simpl in H15; - assert (H17 := H15 H14); exists x; apply H17. -elim (classic (exists z : R, intersection_domain (ind f0) SF z)); intro. -assumption. -elim (H8 0); intros _ H14; elim H1; intros; - assert - (H16 := - not_ex_all_not _ (fun y:R => intersection_family (subfamily f0 SF) y) H14); - assert - (H17 := - not_ex_all_not _ (fun z:R => intersection_domain (ind f0) SF z) H13); - assert (H18 := H16 x); unfold intersection_family in H18; - simpl in H18; - assert - (H19 := - not_all_ex_not _ (fun y:R => intersection_domain D SF y -> g y x /\ SF y) - H18); elim H19; intros; assert (H21 := imply_to_and _ _ H20); - elim (H17 x0); elim H21; intros; assumption. -unfold intersection_vide_in in |- *; intros; split. -intro; simpl in H6; unfold f0 in |- *; simpl in |- *; unfold g in |- *; - apply included_trans with (adherence X). -apply adherence_P4. -unfold included in |- *; intros; elim H7; intros; elim H8; intros; elim H10; - intros; rewrite H11; apply H0. -apply adherence_P2; apply compact_P2; assumption. -apply H4. -unfold family_closed_set in |- *; unfold f0 in |- *; simpl in |- *; - unfold g in |- *; intro; apply adherence_P3. + forall (un:nat -> R) (X:R -> Prop), + compact X -> (forall n:nat, X (un n)) -> exists l : R, ValAdh un l. +Proof. + intros; cut (exists l : R, ValAdh_un un l). + intro; elim H1; intros; exists x; elim (ValAdh_un_prop un x); intros; + apply (H4 H2). + assert (H1 : exists z : R, X z). + exists (un 0%nat); apply H0. + set (D := fun x:R => exists n : nat, x = INR n). + set + (g := + fun x:R => + adherence (fun y:R => (exists p : nat, y = un p /\ x <= INR p) /\ D x)). + assert (H2 : forall x:R, (exists y : R, g x y) -> D x). + intros; elim H2; intros; unfold g in H3; unfold adherence in H3; + unfold point_adherent in H3. + assert (H4 : neighbourhood (disc x0 (mkposreal _ Rlt_0_1)) x0). + unfold neighbourhood in |- *; exists (mkposreal _ Rlt_0_1); + unfold included in |- *; trivial. + elim (H3 _ H4); intros; unfold intersection_domain in H5; decompose [and] H5; + assumption. + set (f0 := mkfamily D g H2). + assert (H3 := compact_P6 X H H1 f0). + elim (classic (exists l : R, ValAdh_un un l)); intro. + assumption. + cut (family_closed_set f0). + intro; cut (intersection_vide_in X f0). + intro; assert (H7 := H3 H5 H6). + elim H7; intros SF H8; unfold intersection_vide_finite_in in H8; elim H8; + clear H8; intros; unfold intersection_vide_in in H8; + elim (H8 0); intros _ H10; elim H10; unfold family_finite in H9; + unfold domain_finite in H9; elim H9; clear H9; intros l H9; + set (r := MaxRlist l); cut (D r). + intro; unfold D in H11; elim H11; intros; exists (un x); + unfold intersection_family in |- *; simpl in |- *; + unfold intersection_domain in |- *; intros; split. + unfold g in |- *; apply adherence_P1; split. + exists x; split; + [ reflexivity + | rewrite <- H12; unfold r in |- *; apply MaxRlist_P1; elim (H9 y); intros; + apply H14; simpl in |- *; apply H13 ]. + elim H13; intros; assumption. + elim H13; intros; assumption. + elim (H9 r); intros. + simpl in H12; unfold intersection_domain in H12; cut (In r l). + intro; elim (H12 H13); intros; assumption. + unfold r in |- *; apply MaxRlist_P2; + cut (exists z : R, intersection_domain (ind f0) SF z). + intro; elim H13; intros; elim (H9 x); intros; simpl in H15; + assert (H17 := H15 H14); exists x; apply H17. + elim (classic (exists z : R, intersection_domain (ind f0) SF z)); intro. + assumption. + elim (H8 0); intros _ H14; elim H1; intros; + assert + (H16 := + not_ex_all_not _ (fun y:R => intersection_family (subfamily f0 SF) y) H14); + assert + (H17 := + not_ex_all_not _ (fun z:R => intersection_domain (ind f0) SF z) H13); + assert (H18 := H16 x); unfold intersection_family in H18; + simpl in H18; + assert + (H19 := + not_all_ex_not _ (fun y:R => intersection_domain D SF y -> g y x /\ SF y) + H18); elim H19; intros; assert (H21 := imply_to_and _ _ H20); + elim (H17 x0); elim H21; intros; assumption. + unfold intersection_vide_in in |- *; intros; split. + intro; simpl in H6; unfold f0 in |- *; simpl in |- *; unfold g in |- *; + apply included_trans with (adherence X). + apply adherence_P4. + unfold included in |- *; intros; elim H7; intros; elim H8; intros; elim H10; + intros; rewrite H11; apply H0. + apply adherence_P2; apply compact_P2; assumption. + apply H4. + unfold family_closed_set in |- *; unfold f0 in |- *; simpl in |- *; + unfold g in |- *; intro; apply adherence_P3. Qed. (********************************************************) -(* Proof of Heine's theorem *) +(** * Proof of Heine's theorem *) (********************************************************) Definition uniform_continuity (f:R -> R) (X:R -> Prop) : Prop := forall eps:posreal, - exists delta : posreal, + exists delta : posreal, (forall x y:R, - X x -> X y -> Rabs (x - y) < delta -> Rabs (f x - f y) < eps). + X x -> X y -> Rabs (x - y) < delta -> Rabs (f x - f y) < eps). Lemma is_lub_u : - forall (E:R -> Prop) (x y:R), is_lub E x -> is_lub E y -> x = y. -unfold is_lub in |- *; intros; elim H; elim H0; intros; apply Rle_antisym; - [ apply (H4 _ H1) | apply (H2 _ H3) ]. + forall (E:R -> Prop) (x y:R), is_lub E x -> is_lub E y -> x = y. +Proof. + unfold is_lub in |- *; intros; elim H; elim H0; intros; apply Rle_antisym; + [ apply (H4 _ H1) | apply (H2 _ H3) ]. Qed. Lemma domain_P1 : - forall X:R -> Prop, - ~ (exists y : R, X y) \/ - (exists y : R, X y /\ (forall x:R, X x -> x = y)) \/ - (exists x : R, (exists y : R, X x /\ X y /\ x <> y)). -intro; elim (classic (exists y : R, X y)); intro. -right; elim H; intros; elim (classic (exists y : R, X y /\ y <> x)); intro. -right; elim H1; intros; elim H2; intros; exists x; exists x0; intros. -split; - [ assumption - | split; [ assumption | apply (sym_not_eq (A:=R)); assumption ] ]. -left; exists x; split. -assumption. -intros; case (Req_dec x0 x); intro. -assumption. -elim H1; exists x0; split; assumption. -left; assumption. + forall X:R -> Prop, + ~ (exists y : R, X y) \/ + (exists y : R, X y /\ (forall x:R, X x -> x = y)) \/ + (exists x : R, (exists y : R, X x /\ X y /\ x <> y)). +Proof. + intro; elim (classic (exists y : R, X y)); intro. + right; elim H; intros; elim (classic (exists y : R, X y /\ y <> x)); intro. + right; elim H1; intros; elim H2; intros; exists x; exists x0; intros. + split; + [ assumption + | split; [ assumption | apply (sym_not_eq (A:=R)); assumption ] ]. + left; exists x; split. + assumption. + intros; case (Req_dec x0 x); intro. + assumption. + elim H1; exists x0; split; assumption. + left; assumption. Qed. Theorem Heine : - forall (f:R -> R) (X:R -> Prop), - compact X -> - (forall x:R, X x -> continuity_pt f x) -> uniform_continuity f X. -intros f0 X H0 H; elim (domain_P1 X); intro Hyp. + forall (f:R -> R) (X:R -> Prop), + compact X -> + (forall x:R, X x -> continuity_pt f x) -> uniform_continuity f X. +Proof. + intros f0 X H0 H; elim (domain_P1 X); intro Hyp. (* X est vide *) -unfold uniform_continuity in |- *; intros; exists (mkposreal _ Rlt_0_1); - intros; elim Hyp; exists x; assumption. -elim Hyp; clear Hyp; intro Hyp. + unfold uniform_continuity in |- *; intros; exists (mkposreal _ Rlt_0_1); + intros; elim Hyp; exists x; assumption. + elim Hyp; clear Hyp; intro Hyp. (* X possède un seul élément *) -unfold uniform_continuity in |- *; intros; exists (mkposreal _ Rlt_0_1); - intros; elim Hyp; clear Hyp; intros; elim H4; clear H4; - intros; assert (H6 := H5 _ H1); assert (H7 := H5 _ H2); - rewrite H6; rewrite H7; unfold Rminus in |- *; rewrite Rplus_opp_r; - rewrite Rabs_R0; apply (cond_pos eps). + unfold uniform_continuity in |- *; intros; exists (mkposreal _ Rlt_0_1); + intros; elim Hyp; clear Hyp; intros; elim H4; clear H4; + intros; assert (H6 := H5 _ H1); assert (H7 := H5 _ H2); + rewrite H6; rewrite H7; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; apply (cond_pos eps). (* X possède au moins deux éléments distincts *) -assert - (X_enc : - exists m : R, (exists M : R, (forall x:R, X x -> m <= x <= M) /\ m < M)). -assert (H1 := compact_P1 X H0); unfold bounded in H1; elim H1; intros; - elim H2; intros; exists x; exists x0; split. -apply H3. -elim Hyp; intros; elim H4; intros; decompose [and] H5; - assert (H10 := H3 _ H6); assert (H11 := H3 _ H8); - elim H10; intros; elim H11; intros; case (total_order_T x x0); - intro. -elim s; intro. -assumption. -rewrite b in H13; rewrite b in H7; elim H9; apply Rle_antisym; - apply Rle_trans with x0; assumption. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H13 H14) r)). -elim X_enc; clear X_enc; intros m X_enc; elim X_enc; clear X_enc; - intros M X_enc; elim X_enc; clear X_enc Hyp; intros X_enc Hyp; - unfold uniform_continuity in |- *; intro; - assert (H1 : forall t:posreal, 0 < t / 2). -intro; unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ apply (cond_pos t) | apply Rinv_0_lt_compat; prove_sup0 ]. -set - (g := - fun x y:R => - X x /\ - (exists del : posreal, - (forall z:R, Rabs (z - x) < del -> Rabs (f0 z - f0 x) < eps / 2) /\ - is_lub - (fun zeta:R => + assert + (X_enc : + exists m : R, (exists M : R, (forall x:R, X x -> m <= x <= M) /\ m < M)). + assert (H1 := compact_P1 X H0); unfold bounded in H1; elim H1; intros; + elim H2; intros; exists x; exists x0; split. + apply H3. + elim Hyp; intros; elim H4; intros; decompose [and] H5; + assert (H10 := H3 _ H6); assert (H11 := H3 _ H8); + elim H10; intros; elim H11; intros; case (total_order_T x x0); + intro. + elim s; intro. + assumption. + rewrite b in H13; rewrite b in H7; elim H9; apply Rle_antisym; + apply Rle_trans with x0; assumption. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H13 H14) r)). + elim X_enc; clear X_enc; intros m X_enc; elim X_enc; clear X_enc; + intros M X_enc; elim X_enc; clear X_enc Hyp; intros X_enc Hyp; + unfold uniform_continuity in |- *; intro; + assert (H1 : forall t:posreal, 0 < t / 2). + intro; unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply (cond_pos t) | apply Rinv_0_lt_compat; prove_sup0 ]. + set + (g := + fun x y:R => + X x /\ + (exists del : posreal, + (forall z:R, Rabs (z - x) < del -> Rabs (f0 z - f0 x) < eps / 2) /\ + is_lub + (fun zeta:R => 0 < zeta <= M - m /\ (forall z:R, Rabs (z - x) < zeta -> Rabs (f0 z - f0 x) < eps / 2)) - del /\ disc x (mkposreal (del / 2) (H1 del)) y)). -assert (H2 : forall x:R, (exists y : R, g x y) -> X x). -intros; elim H2; intros; unfold g in H3; elim H3; clear H3; intros H3 _; - apply H3. -set (f' := mkfamily X g H2); unfold compact in H0; - assert (H3 : covering_open_set X f'). -unfold covering_open_set in |- *; split. -unfold covering in |- *; intros; exists x; simpl in |- *; unfold g in |- *; - split. -assumption. -assert (H4 := H _ H3); unfold continuity_pt in H4; unfold continue_in in H4; - unfold limit1_in in H4; unfold limit_in in H4; simpl in H4; - unfold R_dist in H4; elim (H4 (eps / 2) (H1 eps)); - intros; - set - (E := - fun zeta:R => - 0 < zeta <= M - m /\ - (forall z:R, Rabs (z - x) < zeta -> Rabs (f0 z - f0 x) < eps / 2)); - assert (H6 : bound E). -unfold bound in |- *; exists (M - m); unfold is_upper_bound in |- *; - unfold E in |- *; intros; elim H6; clear H6; intros H6 _; - elim H6; clear H6; intros _ H6; apply H6. -assert (H7 : exists x : R, E x). -elim H5; clear H5; intros; exists (Rmin x0 (M - m)); unfold E in |- *; intros; - split. -split. -unfold Rmin in |- *; case (Rle_dec x0 (M - m)); intro. -apply H5. -apply Rlt_Rminus; apply Hyp. -apply Rmin_r. -intros; case (Req_dec x z); intro. -rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; - apply (H1 eps). -apply H7; split. -unfold D_x, no_cond in |- *; split; [ trivial | assumption ]. -apply Rlt_le_trans with (Rmin x0 (M - m)); [ apply H8 | apply Rmin_l ]. -assert (H8 := completeness _ H6 H7); elim H8; clear H8; intros; - cut (0 < x1 <= M - m). -intro; elim H8; clear H8; intros; exists (mkposreal _ H8); split. -intros; cut (exists alp : R, Rabs (z - x) < alp <= x1 /\ E alp). -intros; elim H11; intros; elim H12; clear H12; intros; unfold E in H13; - elim H13; intros; apply H15. -elim H12; intros; assumption. -elim (classic (exists alp : R, Rabs (z - x) < alp <= x1 /\ E alp)); intro. -assumption. -assert - (H12 := - not_ex_all_not _ (fun alp:R => Rabs (z - x) < alp <= x1 /\ E alp) H11); - unfold is_lub in p; elim p; intros; cut (is_upper_bound E (Rabs (z - x))). -intro; assert (H16 := H14 _ H15); - elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H10 H16)). -unfold is_upper_bound in |- *; intros; unfold is_upper_bound in H13; - assert (H16 := H13 _ H15); case (Rle_dec x2 (Rabs (z - x))); - intro. -assumption. -elim (H12 x2); split; [ split; [ auto with real | assumption ] | assumption ]. -split. -apply p. -unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; - rewrite Rabs_R0; simpl in |- *; unfold Rdiv in |- *; - apply Rmult_lt_0_compat; [ apply H8 | apply Rinv_0_lt_compat; prove_sup0 ]. -elim H7; intros; unfold E in H8; elim H8; intros H9 _; elim H9; intros H10 _; - unfold is_lub in p; elim p; intros; unfold is_upper_bound in H12; - unfold is_upper_bound in H11; split. -apply Rlt_le_trans with x2; [ assumption | apply (H11 _ H8) ]. -apply H12; intros; unfold E in H13; elim H13; intros; elim H14; intros; - assumption. -unfold family_open_set in |- *; intro; simpl in |- *; elim (classic (X x)); - intro. -unfold g in |- *; unfold open_set in |- *; intros; elim H4; clear H4; - intros _ H4; elim H4; clear H4; intros; elim H4; clear H4; - intros; unfold neighbourhood in |- *; case (Req_dec x x0); - intro. -exists (mkposreal _ (H1 x1)); rewrite <- H6; unfold included in |- *; intros; - split. -assumption. -exists x1; split. -apply H4. -split. -elim H5; intros; apply H8. -apply H7. -set (d := x1 / 2 - Rabs (x0 - x)); assert (H7 : 0 < d). -unfold d in |- *; apply Rlt_Rminus; elim H5; clear H5; intros; - unfold disc in H7; apply H7. -exists (mkposreal _ H7); unfold included in |- *; intros; split. -assumption. -exists x1; split. -apply H4. -elim H5; intros; split. -assumption. -unfold disc in H8; simpl in H8; unfold disc in |- *; simpl in |- *; - unfold disc in H10; simpl in H10; - apply Rle_lt_trans with (Rabs (x2 - x0) + Rabs (x0 - x)). -replace (x2 - x) with (x2 - x0 + (x0 - x)); [ apply Rabs_triang | ring ]. -replace (x1 / 2) with (d + Rabs (x0 - x)); [ idtac | unfold d in |- *; ring ]. -do 2 rewrite <- (Rplus_comm (Rabs (x0 - x))); apply Rplus_lt_compat_l; - apply H8. -apply open_set_P6 with (fun _:R => False). -apply open_set_P4. -unfold eq_Dom in |- *; unfold included in |- *; intros; split. -intros; elim H4. -intros; unfold g in H4; elim H4; clear H4; intros H4 _; elim H3; apply H4. -elim (H0 _ H3); intros DF H4; unfold covering_finite in H4; elim H4; clear H4; - intros; unfold family_finite in H5; unfold domain_finite in H5; - unfold covering in H4; simpl in H4; simpl in H5; elim H5; - clear H5; intros l H5; unfold intersection_domain in H5; - cut - (forall x:R, - In x l -> - exists del : R, - 0 < del /\ - (forall z:R, Rabs (z - x) < del -> Rabs (f0 z - f0 x) < eps / 2) /\ - included (g x) (fun z:R => Rabs (z - x) < del / 2)). -intros; - assert - (H7 := - Rlist_P1 l - (fun x del:R => - 0 < del /\ - (forall z:R, Rabs (z - x) < del -> Rabs (f0 z - f0 x) < eps / 2) /\ - included (g x) (fun z:R => Rabs (z - x) < del / 2)) H6); - elim H7; clear H7; intros l' H7; elim H7; clear H7; - intros; set (D := MinRlist l'); cut (0 < D / 2). -intro; exists (mkposreal _ H9); intros; assert (H13 := H4 _ H10); elim H13; - clear H13; intros xi H13; assert (H14 : In xi l). -unfold g in H13; decompose [and] H13; elim (H5 xi); intros; apply H14; split; - assumption. -elim (pos_Rl_P2 l xi); intros H15 _; elim (H15 H14); intros i H16; elim H16; - intros; apply Rle_lt_trans with (Rabs (f0 x - f0 xi) + Rabs (f0 xi - f0 y)). -replace (f0 x - f0 y) with (f0 x - f0 xi + (f0 xi - f0 y)); - [ apply Rabs_triang | ring ]. -rewrite (double_var eps); apply Rplus_lt_compat. -assert (H19 := H8 i H17); elim H19; clear H19; intros; rewrite <- H18 in H20; - elim H20; clear H20; intros; apply H20; unfold included in H21; - apply Rlt_trans with (pos_Rl l' i / 2). -apply H21. -elim H13; clear H13; intros; assumption. -unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2. -prove_sup0. -rewrite Rmult_comm; rewrite Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_r; pattern (pos_Rl l' i) at 1 in |- *; rewrite <- Rplus_0_r; - rewrite double; apply Rplus_lt_compat_l; apply H19. -discrR. -assert (H19 := H8 i H17); elim H19; clear H19; intros; rewrite <- H18 in H20; - elim H20; clear H20; intros; rewrite <- Rabs_Ropp; - rewrite Ropp_minus_distr; apply H20; unfold included in H21; - elim H13; intros; assert (H24 := H21 x H22); - apply Rle_lt_trans with (Rabs (y - x) + Rabs (x - xi)). -replace (y - xi) with (y - x + (x - xi)); [ apply Rabs_triang | ring ]. -rewrite (double_var (pos_Rl l' i)); apply Rplus_lt_compat. -apply Rlt_le_trans with (D / 2). -rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H12. -unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ 2)); - apply Rmult_le_compat_l. -left; apply Rinv_0_lt_compat; prove_sup0. -unfold D in |- *; apply MinRlist_P1; elim (pos_Rl_P2 l' (pos_Rl l' i)); - intros; apply H26; exists i; split; - [ rewrite <- H7; assumption | reflexivity ]. -assumption. -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ unfold D in |- *; apply MinRlist_P2; intros; elim (pos_Rl_P2 l' y); intros; - elim (H10 H9); intros; elim H12; intros; rewrite H14; - rewrite <- H7 in H13; elim (H8 x H13); intros; - apply H15 - | apply Rinv_0_lt_compat; prove_sup0 ]. -intros; elim (H5 x); intros; elim (H8 H6); intros; - set - (E := - fun zeta:R => - 0 < zeta <= M - m /\ - (forall z:R, Rabs (z - x) < zeta -> Rabs (f0 z - f0 x) < eps / 2)); - assert (H11 : bound E). -unfold bound in |- *; exists (M - m); unfold is_upper_bound in |- *; - unfold E in |- *; intros; elim H11; clear H11; intros H11 _; - elim H11; clear H11; intros _ H11; apply H11. -assert (H12 : exists x : R, E x). -assert (H13 := H _ H9); unfold continuity_pt in H13; - unfold continue_in in H13; unfold limit1_in in H13; - unfold limit_in in H13; simpl in H13; unfold R_dist in H13; - elim (H13 _ (H1 eps)); intros; elim H12; clear H12; - intros; exists (Rmin x0 (M - m)); unfold E in |- *; - intros; split. -split; - [ unfold Rmin in |- *; case (Rle_dec x0 (M - m)); intro; - [ apply H12 | apply Rlt_Rminus; apply Hyp ] - | apply Rmin_r ]. -intros; case (Req_dec x z); intro. -rewrite H16; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; - apply (H1 eps). -apply H14; split; - [ unfold D_x, no_cond in |- *; split; [ trivial | assumption ] - | apply Rlt_le_trans with (Rmin x0 (M - m)); [ apply H15 | apply Rmin_l ] ]. -assert (H13 := completeness _ H11 H12); elim H13; clear H13; intros; - cut (0 < x0 <= M - m). -intro; elim H13; clear H13; intros; exists x0; split. -assumption. -split. -intros; cut (exists alp : R, Rabs (z - x) < alp <= x0 /\ E alp). -intros; elim H16; intros; elim H17; clear H17; intros; unfold E in H18; - elim H18; intros; apply H20; elim H17; intros; assumption. -elim (classic (exists alp : R, Rabs (z - x) < alp <= x0 /\ E alp)); intro. -assumption. -assert - (H17 := - not_ex_all_not _ (fun alp:R => Rabs (z - x) < alp <= x0 /\ E alp) H16); - unfold is_lub in p; elim p; intros; cut (is_upper_bound E (Rabs (z - x))). -intro; assert (H21 := H19 _ H20); - elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H15 H21)). -unfold is_upper_bound in |- *; intros; unfold is_upper_bound in H18; - assert (H21 := H18 _ H20); case (Rle_dec x1 (Rabs (z - x))); - intro. -assumption. -elim (H17 x1); split. -split; [ auto with real | assumption ]. -assumption. -unfold included, g in |- *; intros; elim H15; intros; elim H17; intros; - decompose [and] H18; cut (x0 = x2). -intro; rewrite H20; apply H22. -unfold E in p; eapply is_lub_u. -apply p. -apply H21. -elim H12; intros; unfold E in H13; elim H13; intros H14 _; elim H14; - intros H15 _; unfold is_lub in p; elim p; intros; - unfold is_upper_bound in H16; unfold is_upper_bound in H17; - split. -apply Rlt_le_trans with x1; [ assumption | apply (H16 _ H13) ]. -apply H17; intros; unfold E in H18; elim H18; intros; elim H19; intros; - assumption. + del /\ disc x (mkposreal (del / 2) (H1 del)) y)). + assert (H2 : forall x:R, (exists y : R, g x y) -> X x). + intros; elim H2; intros; unfold g in H3; elim H3; clear H3; intros H3 _; + apply H3. + set (f' := mkfamily X g H2); unfold compact in H0; + assert (H3 : covering_open_set X f'). + unfold covering_open_set in |- *; split. + unfold covering in |- *; intros; exists x; simpl in |- *; unfold g in |- *; + split. + assumption. + assert (H4 := H _ H3); unfold continuity_pt in H4; unfold continue_in in H4; + unfold limit1_in in H4; unfold limit_in in H4; simpl in H4; + unfold R_dist in H4; elim (H4 (eps / 2) (H1 eps)); + intros; + set + (E := + fun zeta:R => + 0 < zeta <= M - m /\ + (forall z:R, Rabs (z - x) < zeta -> Rabs (f0 z - f0 x) < eps / 2)); + assert (H6 : bound E). + unfold bound in |- *; exists (M - m); unfold is_upper_bound in |- *; + unfold E in |- *; intros; elim H6; clear H6; intros H6 _; + elim H6; clear H6; intros _ H6; apply H6. + assert (H7 : exists x : R, E x). + elim H5; clear H5; intros; exists (Rmin x0 (M - m)); unfold E in |- *; intros; + split. + split. + unfold Rmin in |- *; case (Rle_dec x0 (M - m)); intro. + apply H5. + apply Rlt_Rminus; apply Hyp. + apply Rmin_r. + intros; case (Req_dec x z); intro. + rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + apply (H1 eps). + apply H7; split. + unfold D_x, no_cond in |- *; split; [ trivial | assumption ]. + apply Rlt_le_trans with (Rmin x0 (M - m)); [ apply H8 | apply Rmin_l ]. + assert (H8 := completeness _ H6 H7); elim H8; clear H8; intros; + cut (0 < x1 <= M - m). + intro; elim H8; clear H8; intros; exists (mkposreal _ H8); split. + intros; cut (exists alp : R, Rabs (z - x) < alp <= x1 /\ E alp). + intros; elim H11; intros; elim H12; clear H12; intros; unfold E in H13; + elim H13; intros; apply H15. + elim H12; intros; assumption. + elim (classic (exists alp : R, Rabs (z - x) < alp <= x1 /\ E alp)); intro. + assumption. + assert + (H12 := + not_ex_all_not _ (fun alp:R => Rabs (z - x) < alp <= x1 /\ E alp) H11); + unfold is_lub in p; elim p; intros; cut (is_upper_bound E (Rabs (z - x))). + intro; assert (H16 := H14 _ H15); + elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H10 H16)). + unfold is_upper_bound in |- *; intros; unfold is_upper_bound in H13; + assert (H16 := H13 _ H15); case (Rle_dec x2 (Rabs (z - x))); + intro. + assumption. + elim (H12 x2); split; [ split; [ auto with real | assumption ] | assumption ]. + split. + apply p. + unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; + rewrite Rabs_R0; simpl in |- *; unfold Rdiv in |- *; + apply Rmult_lt_0_compat; [ apply H8 | apply Rinv_0_lt_compat; prove_sup0 ]. + elim H7; intros; unfold E in H8; elim H8; intros H9 _; elim H9; intros H10 _; + unfold is_lub in p; elim p; intros; unfold is_upper_bound in H12; + unfold is_upper_bound in H11; split. + apply Rlt_le_trans with x2; [ assumption | apply (H11 _ H8) ]. + apply H12; intros; unfold E in H13; elim H13; intros; elim H14; intros; + assumption. + unfold family_open_set in |- *; intro; simpl in |- *; elim (classic (X x)); + intro. + unfold g in |- *; unfold open_set in |- *; intros; elim H4; clear H4; + intros _ H4; elim H4; clear H4; intros; elim H4; clear H4; + intros; unfold neighbourhood in |- *; case (Req_dec x x0); + intro. + exists (mkposreal _ (H1 x1)); rewrite <- H6; unfold included in |- *; intros; + split. + assumption. + exists x1; split. + apply H4. + split. + elim H5; intros; apply H8. + apply H7. + set (d := x1 / 2 - Rabs (x0 - x)); assert (H7 : 0 < d). + unfold d in |- *; apply Rlt_Rminus; elim H5; clear H5; intros; + unfold disc in H7; apply H7. + exists (mkposreal _ H7); unfold included in |- *; intros; split. + assumption. + exists x1; split. + apply H4. + elim H5; intros; split. + assumption. + unfold disc in H8; simpl in H8; unfold disc in |- *; simpl in |- *; + unfold disc in H10; simpl in H10; + apply Rle_lt_trans with (Rabs (x2 - x0) + Rabs (x0 - x)). + replace (x2 - x) with (x2 - x0 + (x0 - x)); [ apply Rabs_triang | ring ]. + replace (x1 / 2) with (d + Rabs (x0 - x)); [ idtac | unfold d in |- *; ring ]. + do 2 rewrite <- (Rplus_comm (Rabs (x0 - x))); apply Rplus_lt_compat_l; + apply H8. + apply open_set_P6 with (fun _:R => False). + apply open_set_P4. + unfold eq_Dom in |- *; unfold included in |- *; intros; split. + intros; elim H4. + intros; unfold g in H4; elim H4; clear H4; intros H4 _; elim H3; apply H4. + elim (H0 _ H3); intros DF H4; unfold covering_finite in H4; elim H4; clear H4; + intros; unfold family_finite in H5; unfold domain_finite in H5; + unfold covering in H4; simpl in H4; simpl in H5; elim H5; + clear H5; intros l H5; unfold intersection_domain in H5; + cut + (forall x:R, + In x l -> + exists del : R, + 0 < del /\ + (forall z:R, Rabs (z - x) < del -> Rabs (f0 z - f0 x) < eps / 2) /\ + included (g x) (fun z:R => Rabs (z - x) < del / 2)). + intros; + assert + (H7 := + Rlist_P1 l + (fun x del:R => + 0 < del /\ + (forall z:R, Rabs (z - x) < del -> Rabs (f0 z - f0 x) < eps / 2) /\ + included (g x) (fun z:R => Rabs (z - x) < del / 2)) H6); + elim H7; clear H7; intros l' H7; elim H7; clear H7; + intros; set (D := MinRlist l'); cut (0 < D / 2). + intro; exists (mkposreal _ H9); intros; assert (H13 := H4 _ H10); elim H13; + clear H13; intros xi H13; assert (H14 : In xi l). + unfold g in H13; decompose [and] H13; elim (H5 xi); intros; apply H14; split; + assumption. + elim (pos_Rl_P2 l xi); intros H15 _; elim (H15 H14); intros i H16; elim H16; + intros; apply Rle_lt_trans with (Rabs (f0 x - f0 xi) + Rabs (f0 xi - f0 y)). + replace (f0 x - f0 y) with (f0 x - f0 xi + (f0 xi - f0 y)); + [ apply Rabs_triang | ring ]. + rewrite (double_var eps); apply Rplus_lt_compat. + assert (H19 := H8 i H17); elim H19; clear H19; intros; rewrite <- H18 in H20; + elim H20; clear H20; intros; apply H20; unfold included in H21; + apply Rlt_trans with (pos_Rl l' i / 2). + apply H21. + elim H13; clear H13; intros; assumption. + unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2. + prove_sup0. + rewrite Rmult_comm; rewrite Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_r; pattern (pos_Rl l' i) at 1 in |- *; rewrite <- Rplus_0_r; + rewrite double; apply Rplus_lt_compat_l; apply H19. + discrR. + assert (H19 := H8 i H17); elim H19; clear H19; intros; rewrite <- H18 in H20; + elim H20; clear H20; intros; rewrite <- Rabs_Ropp; + rewrite Ropp_minus_distr; apply H20; unfold included in H21; + elim H13; intros; assert (H24 := H21 x H22); + apply Rle_lt_trans with (Rabs (y - x) + Rabs (x - xi)). + replace (y - xi) with (y - x + (x - xi)); [ apply Rabs_triang | ring ]. + rewrite (double_var (pos_Rl l' i)); apply Rplus_lt_compat. + apply Rlt_le_trans with (D / 2). + rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H12. + unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ 2)); + apply Rmult_le_compat_l. + left; apply Rinv_0_lt_compat; prove_sup0. + unfold D in |- *; apply MinRlist_P1; elim (pos_Rl_P2 l' (pos_Rl l' i)); + intros; apply H26; exists i; split; + [ rewrite <- H7; assumption | reflexivity ]. + assumption. + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ unfold D in |- *; apply MinRlist_P2; intros; elim (pos_Rl_P2 l' y); intros; + elim (H10 H9); intros; elim H12; intros; rewrite H14; + rewrite <- H7 in H13; elim (H8 x H13); intros; + apply H15 + | apply Rinv_0_lt_compat; prove_sup0 ]. + intros; elim (H5 x); intros; elim (H8 H6); intros; + set + (E := + fun zeta:R => + 0 < zeta <= M - m /\ + (forall z:R, Rabs (z - x) < zeta -> Rabs (f0 z - f0 x) < eps / 2)); + assert (H11 : bound E). + unfold bound in |- *; exists (M - m); unfold is_upper_bound in |- *; + unfold E in |- *; intros; elim H11; clear H11; intros H11 _; + elim H11; clear H11; intros _ H11; apply H11. + assert (H12 : exists x : R, E x). + assert (H13 := H _ H9); unfold continuity_pt in H13; + unfold continue_in in H13; unfold limit1_in in H13; + unfold limit_in in H13; simpl in H13; unfold R_dist in H13; + elim (H13 _ (H1 eps)); intros; elim H12; clear H12; + intros; exists (Rmin x0 (M - m)); unfold E in |- *; + intros; split. + split; + [ unfold Rmin in |- *; case (Rle_dec x0 (M - m)); intro; + [ apply H12 | apply Rlt_Rminus; apply Hyp ] + | apply Rmin_r ]. + intros; case (Req_dec x z); intro. + rewrite H16; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + apply (H1 eps). + apply H14; split; + [ unfold D_x, no_cond in |- *; split; [ trivial | assumption ] + | apply Rlt_le_trans with (Rmin x0 (M - m)); [ apply H15 | apply Rmin_l ] ]. + assert (H13 := completeness _ H11 H12); elim H13; clear H13; intros; + cut (0 < x0 <= M - m). + intro; elim H13; clear H13; intros; exists x0; split. + assumption. + split. + intros; cut (exists alp : R, Rabs (z - x) < alp <= x0 /\ E alp). + intros; elim H16; intros; elim H17; clear H17; intros; unfold E in H18; + elim H18; intros; apply H20; elim H17; intros; assumption. + elim (classic (exists alp : R, Rabs (z - x) < alp <= x0 /\ E alp)); intro. + assumption. + assert + (H17 := + not_ex_all_not _ (fun alp:R => Rabs (z - x) < alp <= x0 /\ E alp) H16); + unfold is_lub in p; elim p; intros; cut (is_upper_bound E (Rabs (z - x))). + intro; assert (H21 := H19 _ H20); + elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H15 H21)). + unfold is_upper_bound in |- *; intros; unfold is_upper_bound in H18; + assert (H21 := H18 _ H20); case (Rle_dec x1 (Rabs (z - x))); + intro. + assumption. + elim (H17 x1); split. + split; [ auto with real | assumption ]. + assumption. + unfold included, g in |- *; intros; elim H15; intros; elim H17; intros; + decompose [and] H18; cut (x0 = x2). + intro; rewrite H20; apply H22. + unfold E in p; eapply is_lub_u. + apply p. + apply H21. + elim H12; intros; unfold E in H13; elim H13; intros H14 _; elim H14; + intros H15 _; unfold is_lub in p; elim p; intros; + unfold is_upper_bound in H16; unfold is_upper_bound in H17; + split. + apply Rlt_le_trans with x1; [ assumption | apply (H16 _ H13) ]. + apply H17; intros; unfold E in H18; elim H18; intros; elim H19; intros; + assumption. Qed. diff --git a/theories/Reals/Rtrigo.v b/theories/Reals/Rtrigo.v index 060070c4..6e992aa3 100644 --- a/theories/Reals/Rtrigo.v +++ b/theories/Reals/Rtrigo.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Rtrigo.v 6245 2004-10-20 13:50:08Z barras $ i*) +(*i $Id: Rtrigo.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -27,312 +27,356 @@ Axiom sin_PI2 : sin (PI / 2) = 1. (**********) Lemma PI_neq0 : PI <> 0. -red in |- *; intro; assert (H0 := PI_RGT_0); rewrite H in H0; - elim (Rlt_irrefl _ H0). +Proof. + red in |- *; intro; assert (H0 := PI_RGT_0); rewrite H in H0; + elim (Rlt_irrefl _ H0). Qed. (**********) Lemma cos_minus : forall x y:R, cos (x - y) = cos x * cos y + sin x * sin y. -intros; unfold Rminus in |- *; rewrite cos_plus. -rewrite <- cos_sym; rewrite sin_antisym; ring. +Proof. + intros; unfold Rminus in |- *; rewrite cos_plus. + rewrite <- cos_sym; rewrite sin_antisym; ring. Qed. (**********) Lemma sin2_cos2 : forall x:R, Rsqr (sin x) + Rsqr (cos x) = 1. -intro; unfold Rsqr in |- *; rewrite Rplus_comm; rewrite <- (cos_minus x x); - unfold Rminus in |- *; rewrite Rplus_opp_r; apply cos_0. +Proof. + intro; unfold Rsqr in |- *; rewrite Rplus_comm; rewrite <- (cos_minus x x); + unfold Rminus in |- *; rewrite Rplus_opp_r; apply cos_0. Qed. Lemma cos2 : forall x:R, Rsqr (cos x) = 1 - Rsqr (sin x). -intro x; generalize (sin2_cos2 x); intro H1; rewrite <- H1; - unfold Rminus in |- *; rewrite <- (Rplus_comm (Rsqr (cos x))); - rewrite Rplus_assoc; rewrite Rplus_opp_r; symmetry in |- *; - apply Rplus_0_r. +Proof. + intro x; generalize (sin2_cos2 x); intro H1; rewrite <- H1; + unfold Rminus in |- *; rewrite <- (Rplus_comm (Rsqr (cos x))); + rewrite Rplus_assoc; rewrite Rplus_opp_r; symmetry in |- *; + apply Rplus_0_r. Qed. (**********) Lemma cos_PI2 : cos (PI / 2) = 0. -apply Rsqr_eq_0; rewrite cos2; rewrite sin_PI2; rewrite Rsqr_1; - unfold Rminus in |- *; apply Rplus_opp_r. +Proof. + apply Rsqr_eq_0; rewrite cos2; rewrite sin_PI2; rewrite Rsqr_1; + unfold Rminus in |- *; apply Rplus_opp_r. Qed. (**********) Lemma cos_PI : cos PI = -1. -replace PI with (PI / 2 + PI / 2). -rewrite cos_plus. -rewrite sin_PI2; rewrite cos_PI2. -ring. -symmetry in |- *; apply double_var. +Proof. + replace PI with (PI / 2 + PI / 2). + rewrite cos_plus. + rewrite sin_PI2; rewrite cos_PI2. + ring. + symmetry in |- *; apply double_var. Qed. Lemma sin_PI : sin PI = 0. -assert (H := sin2_cos2 PI). -rewrite cos_PI in H. -rewrite <- Rsqr_neg in H. -rewrite Rsqr_1 in H. -cut (Rsqr (sin PI) = 0). -intro; apply (Rsqr_eq_0 _ H0). -apply Rplus_eq_reg_l with 1. -rewrite Rplus_0_r; rewrite Rplus_comm; exact H. +Proof. + assert (H := sin2_cos2 PI). + rewrite cos_PI in H. + rewrite <- Rsqr_neg in H. + rewrite Rsqr_1 in H. + cut (Rsqr (sin PI) = 0). + intro; apply (Rsqr_eq_0 _ H0). + apply Rplus_eq_reg_l with 1. + rewrite Rplus_0_r; rewrite Rplus_comm; exact H. Qed. (**********) Lemma neg_cos : forall x:R, cos (x + PI) = - cos x. -intro x; rewrite cos_plus; rewrite sin_PI; rewrite cos_PI; ring. +Proof. + intro x; rewrite cos_plus; rewrite sin_PI; rewrite cos_PI; ring. Qed. (**********) Lemma sin_cos : forall x:R, sin x = - cos (PI / 2 + x). -intro x; rewrite cos_plus; rewrite sin_PI2; rewrite cos_PI2; ring. +Proof. + intro x; rewrite cos_plus; rewrite sin_PI2; rewrite cos_PI2; ring. Qed. (**********) Lemma sin_plus : forall x y:R, sin (x + y) = sin x * cos y + cos x * sin y. -intros. -rewrite (sin_cos (x + y)). -replace (PI / 2 + (x + y)) with (PI / 2 + x + y); [ rewrite cos_plus | ring ]. -rewrite (sin_cos (PI / 2 + x)). -replace (PI / 2 + (PI / 2 + x)) with (x + PI). -rewrite neg_cos. -replace (cos (PI / 2 + x)) with (- sin x). -ring. -rewrite sin_cos; rewrite Ropp_involutive; reflexivity. -pattern PI at 1 in |- *; rewrite (double_var PI); ring. +Proof. + intros. + rewrite (sin_cos (x + y)). + replace (PI / 2 + (x + y)) with (PI / 2 + x + y); [ rewrite cos_plus | ring ]. + rewrite (sin_cos (PI / 2 + x)). + replace (PI / 2 + (PI / 2 + x)) with (x + PI). + rewrite neg_cos. + replace (cos (PI / 2 + x)) with (- sin x). + ring. + rewrite sin_cos; rewrite Ropp_involutive; reflexivity. + pattern PI at 1 in |- *; rewrite (double_var PI); ring. Qed. Lemma sin_minus : forall x y:R, sin (x - y) = sin x * cos y - cos x * sin y. -intros; unfold Rminus in |- *; rewrite sin_plus. -rewrite <- cos_sym; rewrite sin_antisym; ring. +Proof. + intros; unfold Rminus in |- *; rewrite sin_plus. + rewrite <- cos_sym; rewrite sin_antisym; ring. Qed. (**********) Definition tan (x:R) : R := sin x / cos x. Lemma tan_plus : - forall x y:R, - cos x <> 0 -> - cos y <> 0 -> - cos (x + y) <> 0 -> - 1 - tan x * tan y <> 0 -> - tan (x + y) = (tan x + tan y) / (1 - tan x * tan y). -intros; unfold tan in |- *; rewrite sin_plus; rewrite cos_plus; - unfold Rdiv in |- *; - replace (cos x * cos y - sin x * sin y) with - (cos x * cos y * (1 - sin x * / cos x * (sin y * / cos y))). -rewrite Rinv_mult_distr. -repeat rewrite <- Rmult_assoc; - replace ((sin x * cos y + cos x * sin y) * / (cos x * cos y)) with - (sin x * / cos x + sin y * / cos y). -reflexivity. -rewrite Rmult_plus_distr_r; rewrite Rinv_mult_distr. -repeat rewrite Rmult_assoc; repeat rewrite (Rmult_comm (sin x)); - repeat rewrite <- Rmult_assoc. -repeat rewrite Rinv_r_simpl_m; [ reflexivity | assumption | assumption ]. -assumption. -assumption. -apply prod_neq_R0; assumption. -assumption. -unfold Rminus in |- *; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r; - apply Rplus_eq_compat_l; repeat rewrite Rmult_assoc; - rewrite (Rmult_comm (sin x)); rewrite (Rmult_comm (cos y)); - rewrite <- Ropp_mult_distr_r_reverse; repeat rewrite <- Rmult_assoc; - rewrite <- Rinv_r_sym. -rewrite Rmult_1_l; rewrite (Rmult_comm (sin x)); - rewrite <- Ropp_mult_distr_r_reverse; repeat rewrite Rmult_assoc; - apply Rmult_eq_compat_l; rewrite (Rmult_comm (/ cos y)); - rewrite Rmult_assoc; rewrite <- Rinv_r_sym. -apply Rmult_1_r. -assumption. -assumption. + forall x y:R, + cos x <> 0 -> + cos y <> 0 -> + cos (x + y) <> 0 -> + 1 - tan x * tan y <> 0 -> + tan (x + y) = (tan x + tan y) / (1 - tan x * tan y). +Proof. + intros; unfold tan in |- *; rewrite sin_plus; rewrite cos_plus; + unfold Rdiv in |- *; + replace (cos x * cos y - sin x * sin y) with + (cos x * cos y * (1 - sin x * / cos x * (sin y * / cos y))). + rewrite Rinv_mult_distr. + repeat rewrite <- Rmult_assoc; + replace ((sin x * cos y + cos x * sin y) * / (cos x * cos y)) with + (sin x * / cos x + sin y * / cos y). + reflexivity. + rewrite Rmult_plus_distr_r; rewrite Rinv_mult_distr. + repeat rewrite Rmult_assoc; repeat rewrite (Rmult_comm (sin x)); + repeat rewrite <- Rmult_assoc. + repeat rewrite Rinv_r_simpl_m; [ reflexivity | assumption | assumption ]. + assumption. + assumption. + apply prod_neq_R0; assumption. + assumption. + unfold Rminus in |- *; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r; + apply Rplus_eq_compat_l; repeat rewrite Rmult_assoc; + rewrite (Rmult_comm (sin x)); rewrite (Rmult_comm (cos y)); + rewrite <- Ropp_mult_distr_r_reverse; repeat rewrite <- Rmult_assoc; + rewrite <- Rinv_r_sym. + rewrite Rmult_1_l; rewrite (Rmult_comm (sin x)); + rewrite <- Ropp_mult_distr_r_reverse; repeat rewrite Rmult_assoc; + apply Rmult_eq_compat_l; rewrite (Rmult_comm (/ cos y)); + rewrite Rmult_assoc; rewrite <- Rinv_r_sym. + apply Rmult_1_r. + assumption. + assumption. Qed. (*******************************************************) -(* Some properties of cos, sin and tan *) +(** * Some properties of cos, sin and tan *) (*******************************************************) Lemma sin2 : forall x:R, Rsqr (sin x) = 1 - Rsqr (cos x). -intro x; generalize (cos2 x); intro H1; rewrite H1. -unfold Rminus in |- *; rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; - rewrite Rplus_opp_r; rewrite Rplus_0_l; symmetry in |- *; - apply Ropp_involutive. +Proof. + intro x; generalize (cos2 x); intro H1; rewrite H1. + unfold Rminus in |- *; rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; + rewrite Rplus_opp_r; rewrite Rplus_0_l; symmetry in |- *; + apply Ropp_involutive. Qed. Lemma sin_2a : forall x:R, sin (2 * x) = 2 * sin x * cos x. -intro x; rewrite double; rewrite sin_plus. -rewrite <- (Rmult_comm (sin x)); symmetry in |- *; rewrite Rmult_assoc; - apply double. +Proof. + intro x; rewrite double; rewrite sin_plus. + rewrite <- (Rmult_comm (sin x)); symmetry in |- *; rewrite Rmult_assoc; + apply double. Qed. Lemma cos_2a : forall x:R, cos (2 * x) = cos x * cos x - sin x * sin x. -intro x; rewrite double; apply cos_plus. +Proof. + intro x; rewrite double; apply cos_plus. Qed. Lemma cos_2a_cos : forall x:R, cos (2 * x) = 2 * cos x * cos x - 1. -intro x; rewrite double; unfold Rminus in |- *; rewrite Rmult_assoc; - rewrite cos_plus; generalize (sin2_cos2 x); rewrite double; - intro H1; rewrite <- H1; ring_Rsqr. +Proof. + intro x; rewrite double; unfold Rminus in |- *; rewrite Rmult_assoc; + rewrite cos_plus; generalize (sin2_cos2 x); rewrite double; + intro H1; rewrite <- H1; ring_Rsqr. Qed. Lemma cos_2a_sin : forall x:R, cos (2 * x) = 1 - 2 * sin x * sin x. -intro x; rewrite Rmult_assoc; unfold Rminus in |- *; repeat rewrite double. -generalize (sin2_cos2 x); intro H1; rewrite <- H1; rewrite cos_plus; - ring_Rsqr. +Proof. + intro x; rewrite Rmult_assoc; unfold Rminus in |- *; repeat rewrite double. + generalize (sin2_cos2 x); intro H1; rewrite <- H1; rewrite cos_plus; + ring_Rsqr. Qed. Lemma tan_2a : - forall x:R, - cos x <> 0 -> - cos (2 * x) <> 0 -> - 1 - tan x * tan x <> 0 -> tan (2 * x) = 2 * tan x / (1 - tan x * tan x). -repeat rewrite double; intros; repeat rewrite double; rewrite double in H0; - apply tan_plus; assumption. + forall x:R, + cos x <> 0 -> + cos (2 * x) <> 0 -> + 1 - tan x * tan x <> 0 -> tan (2 * x) = 2 * tan x / (1 - tan x * tan x). +Proof. + repeat rewrite double; intros; repeat rewrite double; rewrite double in H0; + apply tan_plus; assumption. Qed. Lemma sin_neg : forall x:R, sin (- x) = - sin x. -apply sin_antisym. +Proof. + apply sin_antisym. Qed. Lemma cos_neg : forall x:R, cos (- x) = cos x. -intro; symmetry in |- *; apply cos_sym. +Proof. + intro; symmetry in |- *; apply cos_sym. Qed. Lemma tan_0 : tan 0 = 0. -unfold tan in |- *; rewrite sin_0; rewrite cos_0. -unfold Rdiv in |- *; apply Rmult_0_l. +Proof. + unfold tan in |- *; rewrite sin_0; rewrite cos_0. + unfold Rdiv in |- *; apply Rmult_0_l. Qed. Lemma tan_neg : forall x:R, tan (- x) = - tan x. -intros x; unfold tan in |- *; rewrite sin_neg; rewrite cos_neg; - unfold Rdiv in |- *. -apply Ropp_mult_distr_l_reverse. +Proof. + intros x; unfold tan in |- *; rewrite sin_neg; rewrite cos_neg; + unfold Rdiv in |- *. + apply Ropp_mult_distr_l_reverse. Qed. Lemma tan_minus : - forall x y:R, - cos x <> 0 -> - cos y <> 0 -> - cos (x - y) <> 0 -> - 1 + tan x * tan y <> 0 -> - tan (x - y) = (tan x - tan y) / (1 + tan x * tan y). -intros; unfold Rminus in |- *; rewrite tan_plus. -rewrite tan_neg; unfold Rminus in |- *; rewrite <- Ropp_mult_distr_l_reverse; - rewrite Rmult_opp_opp; reflexivity. -assumption. -rewrite cos_neg; assumption. -assumption. -rewrite tan_neg; unfold Rminus in |- *; rewrite <- Ropp_mult_distr_l_reverse; - rewrite Rmult_opp_opp; assumption. + forall x y:R, + cos x <> 0 -> + cos y <> 0 -> + cos (x - y) <> 0 -> + 1 + tan x * tan y <> 0 -> + tan (x - y) = (tan x - tan y) / (1 + tan x * tan y). +Proof. + intros; unfold Rminus in |- *; rewrite tan_plus. + rewrite tan_neg; unfold Rminus in |- *; rewrite <- Ropp_mult_distr_l_reverse; + rewrite Rmult_opp_opp; reflexivity. + assumption. + rewrite cos_neg; assumption. + assumption. + rewrite tan_neg; unfold Rminus in |- *; rewrite <- Ropp_mult_distr_l_reverse; + rewrite Rmult_opp_opp; assumption. Qed. Lemma cos_3PI2 : cos (3 * (PI / 2)) = 0. -replace (3 * (PI / 2)) with (PI + PI / 2). -rewrite cos_plus; rewrite sin_PI; rewrite cos_PI2; ring. -pattern PI at 1 in |- *; rewrite (double_var PI). -ring. +Proof. + replace (3 * (PI / 2)) with (PI + PI / 2). + rewrite cos_plus; rewrite sin_PI; rewrite cos_PI2; ring. + pattern PI at 1 in |- *; rewrite (double_var PI). + ring. Qed. Lemma sin_2PI : sin (2 * PI) = 0. -rewrite sin_2a; rewrite sin_PI; ring. +Proof. + rewrite sin_2a; rewrite sin_PI; ring. Qed. Lemma cos_2PI : cos (2 * PI) = 1. -rewrite cos_2a; rewrite sin_PI; rewrite cos_PI; ring. +Proof. + rewrite cos_2a; rewrite sin_PI; rewrite cos_PI; ring. Qed. Lemma neg_sin : forall x:R, sin (x + PI) = - sin x. -intro x; rewrite sin_plus; rewrite sin_PI; rewrite cos_PI; ring. +Proof. + intro x; rewrite sin_plus; rewrite sin_PI; rewrite cos_PI; ring. Qed. Lemma sin_PI_x : forall x:R, sin (PI - x) = sin x. -intro x; rewrite sin_minus; rewrite sin_PI; rewrite cos_PI; rewrite Rmult_0_l; - unfold Rminus in |- *; rewrite Rplus_0_l; rewrite Ropp_mult_distr_l_reverse; - rewrite Ropp_involutive; apply Rmult_1_l. +Proof. + intro x; rewrite sin_minus; rewrite sin_PI; rewrite cos_PI; rewrite Rmult_0_l; + unfold Rminus in |- *; rewrite Rplus_0_l; rewrite Ropp_mult_distr_l_reverse; + rewrite Ropp_involutive; apply Rmult_1_l. Qed. Lemma sin_period : forall (x:R) (k:nat), sin (x + 2 * INR k * PI) = sin x. -intros x k; induction k as [| k Hreck]. -cut (x + 2 * INR 0 * PI = x); [ intro; rewrite H; reflexivity | ring ]. -replace (x + 2 * INR (S k) * PI) with (x + 2 * INR k * PI + 2 * PI); - [ rewrite sin_plus; rewrite sin_2PI; rewrite cos_2PI; ring; apply Hreck - | rewrite S_INR; ring ]. +Proof. + intros x k; induction k as [| k Hreck]. + simpl in |- *; ring_simplify (x + 2 * 0 * PI). + trivial. + + replace (x + 2 * INR (S k) * PI) with (x + 2 * INR k * PI + 2 * PI). + rewrite sin_plus in |- *; rewrite sin_2PI in |- *; rewrite cos_2PI in |- *. + ring_simplify; trivial. + rewrite S_INR in |- *; ring. Qed. Lemma cos_period : forall (x:R) (k:nat), cos (x + 2 * INR k * PI) = cos x. -intros x k; induction k as [| k Hreck]. -cut (x + 2 * INR 0 * PI = x); [ intro; rewrite H; reflexivity | ring ]. -replace (x + 2 * INR (S k) * PI) with (x + 2 * INR k * PI + 2 * PI); - [ rewrite cos_plus; rewrite sin_2PI; rewrite cos_2PI; ring; apply Hreck - | rewrite S_INR; ring ]. +Proof. + intros x k; induction k as [| k Hreck]. + simpl in |- *; ring_simplify (x + 2 * 0 * PI). + trivial. + + replace (x + 2 * INR (S k) * PI) with (x + 2 * INR k * PI + 2 * PI). + rewrite cos_plus in |- *; rewrite sin_2PI in |- *; rewrite cos_2PI in |- *. + ring_simplify; trivial. + rewrite S_INR in |- *; ring. Qed. Lemma sin_shift : forall x:R, sin (PI / 2 - x) = cos x. -intro x; rewrite sin_minus; rewrite sin_PI2; rewrite cos_PI2; ring. +Proof. + intro x; rewrite sin_minus; rewrite sin_PI2; rewrite cos_PI2; ring. Qed. Lemma cos_shift : forall x:R, cos (PI / 2 - x) = sin x. -intro x; rewrite cos_minus; rewrite sin_PI2; rewrite cos_PI2; ring. +Proof. + intro x; rewrite cos_minus; rewrite sin_PI2; rewrite cos_PI2; ring. Qed. Lemma cos_sin : forall x:R, cos x = sin (PI / 2 + x). -intro x; rewrite sin_plus; rewrite sin_PI2; rewrite cos_PI2; ring. +Proof. + intro x; rewrite sin_plus; rewrite sin_PI2; rewrite cos_PI2; ring. Qed. Lemma PI2_RGT_0 : 0 < PI / 2. -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup ]. +Proof. + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup ]. Qed. Lemma SIN_bound : forall x:R, -1 <= sin x <= 1. -intro; case (Rle_dec (-1) (sin x)); intro. -case (Rle_dec (sin x) 1); intro. -split; assumption. -cut (1 < sin x). -intro; - generalize - (Rsqr_incrst_1 1 (sin x) H (Rlt_le 0 1 Rlt_0_1) - (Rlt_le 0 (sin x) (Rlt_trans 0 1 (sin x) Rlt_0_1 H))); - rewrite Rsqr_1; intro; rewrite sin2 in H0; unfold Rminus in H0; - generalize (Rplus_lt_compat_l (-1) 1 (1 + - Rsqr (cos x)) H0); - repeat rewrite <- Rplus_assoc; repeat rewrite Rplus_opp_l; - rewrite Rplus_0_l; intro; rewrite <- Ropp_0 in H1; - generalize (Ropp_lt_gt_contravar (-0) (- Rsqr (cos x)) H1); - repeat rewrite Ropp_involutive; intro; generalize (Rle_0_sqr (cos x)); - intro; elim (Rlt_irrefl 0 (Rle_lt_trans 0 (Rsqr (cos x)) 0 H3 H2)). -auto with real. -cut (sin x < -1). -intro; generalize (Ropp_lt_gt_contravar (sin x) (-1) H); - rewrite Ropp_involutive; clear H; intro; - generalize - (Rsqr_incrst_1 1 (- sin x) H (Rlt_le 0 1 Rlt_0_1) - (Rlt_le 0 (- sin x) (Rlt_trans 0 1 (- sin x) Rlt_0_1 H))); - rewrite Rsqr_1; intro; rewrite <- Rsqr_neg in H0; - rewrite sin2 in H0; unfold Rminus in H0; - generalize (Rplus_lt_compat_l (-1) 1 (1 + - Rsqr (cos x)) H0); - repeat rewrite <- Rplus_assoc; repeat rewrite Rplus_opp_l; - rewrite Rplus_0_l; intro; rewrite <- Ropp_0 in H1; - generalize (Ropp_lt_gt_contravar (-0) (- Rsqr (cos x)) H1); - repeat rewrite Ropp_involutive; intro; generalize (Rle_0_sqr (cos x)); - intro; elim (Rlt_irrefl 0 (Rle_lt_trans 0 (Rsqr (cos x)) 0 H3 H2)). -auto with real. +Proof. + intro; case (Rle_dec (-1) (sin x)); intro. + case (Rle_dec (sin x) 1); intro. + split; assumption. + cut (1 < sin x). + intro; + generalize + (Rsqr_incrst_1 1 (sin x) H (Rlt_le 0 1 Rlt_0_1) + (Rlt_le 0 (sin x) (Rlt_trans 0 1 (sin x) Rlt_0_1 H))); + rewrite Rsqr_1; intro; rewrite sin2 in H0; unfold Rminus in H0; + generalize (Rplus_lt_compat_l (-1) 1 (1 + - Rsqr (cos x)) H0); + repeat rewrite <- Rplus_assoc; repeat rewrite Rplus_opp_l; + rewrite Rplus_0_l; intro; rewrite <- Ropp_0 in H1; + generalize (Ropp_lt_gt_contravar (-0) (- Rsqr (cos x)) H1); + repeat rewrite Ropp_involutive; intro; generalize (Rle_0_sqr (cos x)); + intro; elim (Rlt_irrefl 0 (Rle_lt_trans 0 (Rsqr (cos x)) 0 H3 H2)). + auto with real. + cut (sin x < -1). + intro; generalize (Ropp_lt_gt_contravar (sin x) (-1) H); + rewrite Ropp_involutive; clear H; intro; + generalize + (Rsqr_incrst_1 1 (- sin x) H (Rlt_le 0 1 Rlt_0_1) + (Rlt_le 0 (- sin x) (Rlt_trans 0 1 (- sin x) Rlt_0_1 H))); + rewrite Rsqr_1; intro; rewrite <- Rsqr_neg in H0; + rewrite sin2 in H0; unfold Rminus in H0; + generalize (Rplus_lt_compat_l (-1) 1 (1 + - Rsqr (cos x)) H0); + repeat rewrite <- Rplus_assoc; repeat rewrite Rplus_opp_l; + rewrite Rplus_0_l; intro; rewrite <- Ropp_0 in H1; + generalize (Ropp_lt_gt_contravar (-0) (- Rsqr (cos x)) H1); + repeat rewrite Ropp_involutive; intro; generalize (Rle_0_sqr (cos x)); + intro; elim (Rlt_irrefl 0 (Rle_lt_trans 0 (Rsqr (cos x)) 0 H3 H2)). + auto with real. Qed. Lemma COS_bound : forall x:R, -1 <= cos x <= 1. -intro; rewrite <- sin_shift; apply SIN_bound. +Proof. + intro; rewrite <- sin_shift; apply SIN_bound. Qed. Lemma cos_sin_0 : forall x:R, ~ (cos x = 0 /\ sin x = 0). -intro; red in |- *; intro; elim H; intros; generalize (sin2_cos2 x); intro; - rewrite H0 in H2; rewrite H1 in H2; repeat rewrite Rsqr_0 in H2; - rewrite Rplus_0_r in H2; generalize Rlt_0_1; intro; - rewrite <- H2 in H3; elim (Rlt_irrefl 0 H3). +Proof. + intro; red in |- *; intro; elim H; intros; generalize (sin2_cos2 x); intro; + rewrite H0 in H2; rewrite H1 in H2; repeat rewrite Rsqr_0 in H2; + rewrite Rplus_0_r in H2; generalize Rlt_0_1; intro; + rewrite <- H2 in H3; elim (Rlt_irrefl 0 H3). Qed. - + Lemma cos_sin_0_var : forall x:R, cos x <> 0 \/ sin x <> 0. -intro; apply not_and_or; apply cos_sin_0. +Proof. + intro; apply not_and_or; apply cos_sin_0. Qed. (*****************************************************************) -(* Using series definitions of cos and sin *) +(** * Using series definitions of cos and sin *) (*****************************************************************) Definition sin_lb (a:R) : R := sin_approx a 3. @@ -341,1367 +385,1415 @@ Definition cos_lb (a:R) : R := cos_approx a 3. Definition cos_ub (a:R) : R := cos_approx a 4. Lemma sin_lb_gt_0 : forall a:R, 0 < a -> a <= PI / 2 -> 0 < sin_lb a. -intros. -unfold sin_lb in |- *; unfold sin_approx in |- *; unfold sin_term in |- *. -set (Un := fun i:nat => a ^ (2 * i + 1) / INR (fact (2 * i + 1))). -replace - (sum_f_R0 +Proof. + intros. + unfold sin_lb in |- *; unfold sin_approx in |- *; unfold sin_term in |- *. + set (Un := fun i:nat => a ^ (2 * i + 1) / INR (fact (2 * i + 1))). + replace + (sum_f_R0 (fun i:nat => (-1) ^ i * (a ^ (2 * i + 1) / INR (fact (2 * i + 1)))) 3) - with (sum_f_R0 (fun i:nat => (-1) ^ i * Un i) 3); - [ idtac | apply sum_eq; intros; unfold Un in |- *; reflexivity ]. -cut (forall n:nat, Un (S n) < Un n). -intro; simpl in |- *. -repeat rewrite Rmult_1_l; repeat rewrite Rmult_1_r; - replace (-1 * Un 1%nat) with (- Un 1%nat); [ idtac | ring ]; - replace (-1 * -1 * Un 2%nat) with (Un 2%nat); [ idtac | ring ]; - replace (-1 * (-1 * -1) * Un 3%nat) with (- Un 3%nat); - [ idtac | ring ]; - replace (Un 0%nat + - Un 1%nat + Un 2%nat + - Un 3%nat) with - (Un 0%nat - Un 1%nat + (Un 2%nat - Un 3%nat)); [ idtac | ring ]. -apply Rplus_lt_0_compat. -unfold Rminus in |- *; apply Rplus_lt_reg_r with (Un 1%nat); - rewrite Rplus_0_r; rewrite (Rplus_comm (Un 1%nat)); - rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; - apply H1. -unfold Rminus in |- *; apply Rplus_lt_reg_r with (Un 3%nat); - rewrite Rplus_0_r; rewrite (Rplus_comm (Un 3%nat)); - rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; - apply H1. -intro; unfold Un in |- *. -cut ((2 * S n + 1)%nat = (2 * n + 1 + 2)%nat). -intro; rewrite H1. -rewrite pow_add; unfold Rdiv in |- *; rewrite Rmult_assoc; - apply Rmult_lt_compat_l. -apply pow_lt; assumption. -rewrite <- H1; apply Rmult_lt_reg_l with (INR (fact (2 * n + 1))). -apply lt_INR_0; apply neq_O_lt. -assert (H2 := fact_neq_0 (2 * n + 1)). -red in |- *; intro; elim H2; symmetry in |- *; assumption. -rewrite <- Rinv_r_sym. -apply Rmult_lt_reg_l with (INR (fact (2 * S n + 1))). -apply lt_INR_0; apply neq_O_lt. -assert (H2 := fact_neq_0 (2 * S n + 1)). -red in |- *; intro; elim H2; symmetry in |- *; assumption. -rewrite (Rmult_comm (INR (fact (2 * S n + 1)))); repeat rewrite Rmult_assoc; - rewrite <- Rinv_l_sym. -do 2 rewrite Rmult_1_r; apply Rle_lt_trans with (INR (fact (2 * n + 1)) * 4). -apply Rmult_le_compat_l. -replace 0 with (INR 0); [ idtac | reflexivity ]; apply le_INR; apply le_O_n. -simpl in |- *; rewrite Rmult_1_r; replace 4 with (Rsqr 2); - [ idtac | ring_Rsqr ]; replace (a * a) with (Rsqr a); - [ idtac | reflexivity ]; apply Rsqr_incr_1. -apply Rle_trans with (PI / 2); - [ assumption - | unfold Rdiv in |- *; apply Rmult_le_reg_l with 2; - [ prove_sup0 - | rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m; - [ replace 4 with 4; [ apply PI_4 | ring ] | discrR ] ] ]. -left; assumption. -left; prove_sup0. -rewrite H1; replace (2 * n + 1 + 2)%nat with (S (S (2 * n + 1))). -do 2 rewrite fact_simpl; do 2 rewrite mult_INR. -repeat rewrite <- Rmult_assoc. -rewrite <- (Rmult_comm (INR (fact (2 * n + 1)))). -rewrite Rmult_assoc. -apply Rmult_lt_compat_l. -apply lt_INR_0; apply neq_O_lt. -assert (H2 := fact_neq_0 (2 * n + 1)). -red in |- *; intro; elim H2; symmetry in |- *; assumption. -do 2 rewrite S_INR; rewrite plus_INR; rewrite mult_INR; set (x := INR n); - unfold INR in |- *. -replace ((2 * x + 1 + 1 + 1) * (2 * x + 1 + 1)) with (4 * x * x + 10 * x + 6); - [ idtac | ring ]. -apply Rplus_lt_reg_r with (-4); rewrite Rplus_opp_l; - replace (-4 + (4 * x * x + 10 * x + 6)) with (4 * x * x + 10 * x + 2); - [ idtac | ring ]. -apply Rplus_le_lt_0_compat. -cut (0 <= x). -intro; apply Rplus_le_le_0_compat; repeat apply Rmult_le_pos; - assumption || left; prove_sup. -unfold x in |- *; replace 0 with (INR 0); - [ apply le_INR; apply le_O_n | reflexivity ]. -prove_sup0. -apply INR_eq; do 2 rewrite S_INR; do 3 rewrite plus_INR; rewrite mult_INR; - repeat rewrite S_INR; ring. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -apply INR_eq; do 3 rewrite plus_INR; do 2 rewrite mult_INR; - repeat rewrite S_INR; ring. + with (sum_f_R0 (fun i:nat => (-1) ^ i * Un i) 3); + [ idtac | apply sum_eq; intros; unfold Un in |- *; reflexivity ]. + cut (forall n:nat, Un (S n) < Un n). + intro; simpl in |- *. + repeat rewrite Rmult_1_l; repeat rewrite Rmult_1_r; + replace (-1 * Un 1%nat) with (- Un 1%nat); [ idtac | ring ]; + replace (-1 * -1 * Un 2%nat) with (Un 2%nat); [ idtac | ring ]; + replace (-1 * (-1 * -1) * Un 3%nat) with (- Un 3%nat); + [ idtac | ring ]; + replace (Un 0%nat + - Un 1%nat + Un 2%nat + - Un 3%nat) with + (Un 0%nat - Un 1%nat + (Un 2%nat - Un 3%nat)); [ idtac | ring ]. + apply Rplus_lt_0_compat. + unfold Rminus in |- *; apply Rplus_lt_reg_r with (Un 1%nat); + rewrite Rplus_0_r; rewrite (Rplus_comm (Un 1%nat)); + rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; + apply H1. + unfold Rminus in |- *; apply Rplus_lt_reg_r with (Un 3%nat); + rewrite Rplus_0_r; rewrite (Rplus_comm (Un 3%nat)); + rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; + apply H1. + intro; unfold Un in |- *. + cut ((2 * S n + 1)%nat = (2 * n + 1 + 2)%nat). + intro; rewrite H1. + rewrite pow_add; unfold Rdiv in |- *; rewrite Rmult_assoc; + apply Rmult_lt_compat_l. + apply pow_lt; assumption. + rewrite <- H1; apply Rmult_lt_reg_l with (INR (fact (2 * n + 1))). + apply lt_INR_0; apply neq_O_lt. + assert (H2 := fact_neq_0 (2 * n + 1)). + red in |- *; intro; elim H2; symmetry in |- *; assumption. + rewrite <- Rinv_r_sym. + apply Rmult_lt_reg_l with (INR (fact (2 * S n + 1))). + apply lt_INR_0; apply neq_O_lt. + assert (H2 := fact_neq_0 (2 * S n + 1)). + red in |- *; intro; elim H2; symmetry in |- *; assumption. + rewrite (Rmult_comm (INR (fact (2 * S n + 1)))); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. + do 2 rewrite Rmult_1_r; apply Rle_lt_trans with (INR (fact (2 * n + 1)) * 4). + apply Rmult_le_compat_l. + replace 0 with (INR 0); [ idtac | reflexivity ]; apply le_INR; apply le_O_n. + simpl in |- *; rewrite Rmult_1_r; replace 4 with (Rsqr 2); + [ idtac | ring_Rsqr ]; replace (a * a) with (Rsqr a); + [ idtac | reflexivity ]; apply Rsqr_incr_1. + apply Rle_trans with (PI / 2); + [ assumption + | unfold Rdiv in |- *; apply Rmult_le_reg_l with 2; + [ prove_sup0 + | rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m; + [ replace 4 with 4; [ apply PI_4 | ring ] | discrR ] ] ]. + left; assumption. + left; prove_sup0. + rewrite H1; replace (2 * n + 1 + 2)%nat with (S (S (2 * n + 1))). + do 2 rewrite fact_simpl; do 2 rewrite mult_INR. + repeat rewrite <- Rmult_assoc. + rewrite <- (Rmult_comm (INR (fact (2 * n + 1)))). + rewrite Rmult_assoc. + apply Rmult_lt_compat_l. + apply lt_INR_0; apply neq_O_lt. + assert (H2 := fact_neq_0 (2 * n + 1)). + red in |- *; intro; elim H2; symmetry in |- *; assumption. + do 2 rewrite S_INR; rewrite plus_INR; rewrite mult_INR; set (x := INR n); + unfold INR in |- *. + replace ((2 * x + 1 + 1 + 1) * (2 * x + 1 + 1)) with (4 * x * x + 10 * x + 6); + [ idtac | ring ]. + apply Rplus_lt_reg_r with (-4); rewrite Rplus_opp_l; + replace (-4 + (4 * x * x + 10 * x + 6)) with (4 * x * x + 10 * x + 2); + [ idtac | ring ]. + apply Rplus_le_lt_0_compat. + cut (0 <= x). + intro; apply Rplus_le_le_0_compat; repeat apply Rmult_le_pos; + assumption || left; prove_sup. + unfold x in |- *; replace 0 with (INR 0); + [ apply le_INR; apply le_O_n | reflexivity ]. + prove_sup0. + ring_nat. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + ring_nat. Qed. Lemma SIN : forall a:R, 0 <= a -> a <= PI -> sin_lb a <= sin a <= sin_ub a. -intros; unfold sin_lb, sin_ub in |- *; apply (sin_bound a 1 H H0). + intros; unfold sin_lb, sin_ub in |- *; apply (sin_bound a 1 H H0). Qed. Lemma COS : - forall a:R, - PI / 2 <= a -> a <= PI / 2 -> cos_lb a <= cos a <= cos_ub a. -intros; unfold cos_lb, cos_ub in |- *; apply (cos_bound a 1 H H0). + forall a:R, - PI / 2 <= a -> a <= PI / 2 -> cos_lb a <= cos a <= cos_ub a. + intros; unfold cos_lb, cos_ub in |- *; apply (cos_bound a 1 H H0). Qed. (**********) Lemma _PI2_RLT_0 : - (PI / 2) < 0. -rewrite <- Ropp_0; apply Ropp_lt_contravar; apply PI2_RGT_0. +Proof. + rewrite <- Ropp_0; apply Ropp_lt_contravar; apply PI2_RGT_0. Qed. Lemma PI4_RLT_PI2 : PI / 4 < PI / 2. -unfold Rdiv in |- *; apply Rmult_lt_compat_l. -apply PI_RGT_0. -apply Rinv_lt_contravar. -apply Rmult_lt_0_compat; prove_sup0. -pattern 2 at 1 in |- *; rewrite <- Rplus_0_r. -replace 4 with (2 + 2); [ apply Rplus_lt_compat_l; prove_sup0 | ring ]. +Proof. + unfold Rdiv in |- *; apply Rmult_lt_compat_l. + apply PI_RGT_0. + apply Rinv_lt_contravar. + apply Rmult_lt_0_compat; prove_sup0. + pattern 2 at 1 in |- *; rewrite <- Rplus_0_r. + replace 4 with (2 + 2); [ apply Rplus_lt_compat_l; prove_sup0 | ring ]. Qed. Lemma PI2_Rlt_PI : PI / 2 < PI. -unfold Rdiv in |- *; pattern PI at 2 in |- *; rewrite <- Rmult_1_r. -apply Rmult_lt_compat_l. -apply PI_RGT_0. -pattern 1 at 3 in |- *; rewrite <- Rinv_1; apply Rinv_lt_contravar. -rewrite Rmult_1_l; prove_sup0. -pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; - apply Rlt_0_1. -Qed. - -(********************************************) -(* Increasing and decreasing of COS and SIN *) -(********************************************) +Proof. + unfold Rdiv in |- *; pattern PI at 2 in |- *; rewrite <- Rmult_1_r. + apply Rmult_lt_compat_l. + apply PI_RGT_0. + pattern 1 at 3 in |- *; rewrite <- Rinv_1; apply Rinv_lt_contravar. + rewrite Rmult_1_l; prove_sup0. + pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + apply Rlt_0_1. +Qed. + +(***************************************************) +(** * Increasing and decreasing of [cos] and [sin] *) +(***************************************************) Theorem sin_gt_0 : forall x:R, 0 < x -> x < PI -> 0 < sin x. -intros; elim (SIN x (Rlt_le 0 x H) (Rlt_le x PI H0)); intros H1 _; - case (Rtotal_order x (PI / 2)); intro H2. -apply Rlt_le_trans with (sin_lb x). -apply sin_lb_gt_0; [ assumption | left; assumption ]. -assumption. -elim H2; intro H3. -rewrite H3; rewrite sin_PI2; apply Rlt_0_1. -rewrite <- sin_PI_x; generalize (Ropp_gt_lt_contravar x (PI / 2) H3); - intro H4; generalize (Rplus_lt_compat_l PI (- x) (- (PI / 2)) H4). -replace (PI + - x) with (PI - x). -replace (PI + - (PI / 2)) with (PI / 2). -intro H5; generalize (Ropp_lt_gt_contravar x PI H0); intro H6; - change (- PI < - x) in H6; generalize (Rplus_lt_compat_l PI (- PI) (- x) H6). -rewrite Rplus_opp_r. -replace (PI + - x) with (PI - x). -intro H7; - elim - (SIN (PI - x) (Rlt_le 0 (PI - x) H7) - (Rlt_le (PI - x) PI (Rlt_trans (PI - x) (PI / 2) PI H5 PI2_Rlt_PI))); - intros H8 _; - generalize (sin_lb_gt_0 (PI - x) H7 (Rlt_le (PI - x) (PI / 2) H5)); - intro H9; apply (Rlt_le_trans 0 (sin_lb (PI - x)) (sin (PI - x)) H9 H8). -reflexivity. -pattern PI at 2 in |- *; rewrite double_var; ring. -reflexivity. +Proof. + intros; elim (SIN x (Rlt_le 0 x H) (Rlt_le x PI H0)); intros H1 _; + case (Rtotal_order x (PI / 2)); intro H2. + apply Rlt_le_trans with (sin_lb x). + apply sin_lb_gt_0; [ assumption | left; assumption ]. + assumption. + elim H2; intro H3. + rewrite H3; rewrite sin_PI2; apply Rlt_0_1. + rewrite <- sin_PI_x; generalize (Ropp_gt_lt_contravar x (PI / 2) H3); + intro H4; generalize (Rplus_lt_compat_l PI (- x) (- (PI / 2)) H4). + replace (PI + - x) with (PI - x). + replace (PI + - (PI / 2)) with (PI / 2). + intro H5; generalize (Ropp_lt_gt_contravar x PI H0); intro H6; + change (- PI < - x) in H6; generalize (Rplus_lt_compat_l PI (- PI) (- x) H6). + rewrite Rplus_opp_r. + replace (PI + - x) with (PI - x). + intro H7; + elim + (SIN (PI - x) (Rlt_le 0 (PI - x) H7) + (Rlt_le (PI - x) PI (Rlt_trans (PI - x) (PI / 2) PI H5 PI2_Rlt_PI))); + intros H8 _; + generalize (sin_lb_gt_0 (PI - x) H7 (Rlt_le (PI - x) (PI / 2) H5)); + intro H9; apply (Rlt_le_trans 0 (sin_lb (PI - x)) (sin (PI - x)) H9 H8). + reflexivity. + pattern PI at 2 in |- *; rewrite double_var; ring. + reflexivity. Qed. Theorem cos_gt_0 : forall x:R, - (PI / 2) < x -> x < PI / 2 -> 0 < cos x. -intros; rewrite cos_sin; - generalize (Rplus_lt_compat_l (PI / 2) (- (PI / 2)) x H). -rewrite Rplus_opp_r; intro H1; - generalize (Rplus_lt_compat_l (PI / 2) x (PI / 2) H0); - rewrite <- double_var; intro H2; apply (sin_gt_0 (PI / 2 + x) H1 H2). +Proof. + intros; rewrite cos_sin; + generalize (Rplus_lt_compat_l (PI / 2) (- (PI / 2)) x H). + rewrite Rplus_opp_r; intro H1; + generalize (Rplus_lt_compat_l (PI / 2) x (PI / 2) H0); + rewrite <- double_var; intro H2; apply (sin_gt_0 (PI / 2 + x) H1 H2). Qed. Lemma sin_ge_0 : forall x:R, 0 <= x -> x <= PI -> 0 <= sin x. -intros x H1 H2; elim H1; intro H3; - [ elim H2; intro H4; - [ left; apply (sin_gt_0 x H3 H4) - | rewrite H4; right; symmetry in |- *; apply sin_PI ] - | rewrite <- H3; right; symmetry in |- *; apply sin_0 ]. +Proof. + intros x H1 H2; elim H1; intro H3; + [ elim H2; intro H4; + [ left; apply (sin_gt_0 x H3 H4) + | rewrite H4; right; symmetry in |- *; apply sin_PI ] + | rewrite <- H3; right; symmetry in |- *; apply sin_0 ]. Qed. Lemma cos_ge_0 : forall x:R, - (PI / 2) <= x -> x <= PI / 2 -> 0 <= cos x. -intros x H1 H2; elim H1; intro H3; - [ elim H2; intro H4; - [ left; apply (cos_gt_0 x H3 H4) - | rewrite H4; right; symmetry in |- *; apply cos_PI2 ] - | rewrite <- H3; rewrite cos_neg; right; symmetry in |- *; apply cos_PI2 ]. +Proof. + intros x H1 H2; elim H1; intro H3; + [ elim H2; intro H4; + [ left; apply (cos_gt_0 x H3 H4) + | rewrite H4; right; symmetry in |- *; apply cos_PI2 ] + | rewrite <- H3; rewrite cos_neg; right; symmetry in |- *; apply cos_PI2 ]. Qed. Lemma sin_le_0 : forall x:R, PI <= x -> x <= 2 * PI -> sin x <= 0. -intros x H1 H2; apply Rge_le; rewrite <- Ropp_0; - rewrite <- (Ropp_involutive (sin x)); apply Ropp_le_ge_contravar; - rewrite <- neg_sin; replace (x + PI) with (x - PI + 2 * INR 1 * PI); - [ rewrite (sin_period (x - PI) 1); apply sin_ge_0; - [ replace (x - PI) with (x + - PI); - [ rewrite Rplus_comm; replace 0 with (- PI + PI); - [ apply Rplus_le_compat_l; assumption | ring ] - | ring ] - | replace (x - PI) with (x + - PI); rewrite Rplus_comm; - [ pattern PI at 2 in |- *; replace PI with (- PI + 2 * PI); - [ apply Rplus_le_compat_l; assumption | ring ] - | ring ] ] - | unfold INR in |- *; ring ]. +Proof. + intros x H1 H2; apply Rge_le; rewrite <- Ropp_0; + rewrite <- (Ropp_involutive (sin x)); apply Ropp_le_ge_contravar; + rewrite <- neg_sin; replace (x + PI) with (x - PI + 2 * INR 1 * PI); + [ rewrite (sin_period (x - PI) 1); apply sin_ge_0; + [ replace (x - PI) with (x + - PI); + [ rewrite Rplus_comm; replace 0 with (- PI + PI); + [ apply Rplus_le_compat_l; assumption | ring ] + | ring ] + | replace (x - PI) with (x + - PI); rewrite Rplus_comm; + [ pattern PI at 2 in |- *; replace PI with (- PI + 2 * PI); + [ apply Rplus_le_compat_l; assumption | ring ] + | ring ] ] + | unfold INR in |- *; ring ]. Qed. Lemma cos_le_0 : forall x:R, PI / 2 <= x -> x <= 3 * (PI / 2) -> cos x <= 0. -intros x H1 H2; apply Rge_le; rewrite <- Ropp_0; - rewrite <- (Ropp_involutive (cos x)); apply Ropp_le_ge_contravar; - rewrite <- neg_cos; replace (x + PI) with (x - PI + 2 * INR 1 * PI). -rewrite cos_period; apply cos_ge_0. -replace (- (PI / 2)) with (- PI + PI / 2). -unfold Rminus in |- *; rewrite (Rplus_comm x); apply Rplus_le_compat_l; - assumption. -pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr; - ring. -unfold Rminus in |- *; rewrite Rplus_comm; - replace (PI / 2) with (- PI + 3 * (PI / 2)). -apply Rplus_le_compat_l; assumption. -pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr; - ring. -unfold INR in |- *; ring. +Proof. + intros x H1 H2; apply Rge_le; rewrite <- Ropp_0; + rewrite <- (Ropp_involutive (cos x)); apply Ropp_le_ge_contravar; + rewrite <- neg_cos; replace (x + PI) with (x - PI + 2 * INR 1 * PI). + rewrite cos_period; apply cos_ge_0. + replace (- (PI / 2)) with (- PI + PI / 2). + unfold Rminus in |- *; rewrite (Rplus_comm x); apply Rplus_le_compat_l; + assumption. + pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr; + ring. + unfold Rminus in |- *; rewrite Rplus_comm; + replace (PI / 2) with (- PI + 3 * (PI / 2)). + apply Rplus_le_compat_l; assumption. + pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr; + ring. + unfold INR in |- *; ring. Qed. Lemma sin_lt_0 : forall x:R, PI < x -> x < 2 * PI -> sin x < 0. -intros x H1 H2; rewrite <- Ropp_0; rewrite <- (Ropp_involutive (sin x)); - apply Ropp_lt_gt_contravar; rewrite <- neg_sin; - replace (x + PI) with (x - PI + 2 * INR 1 * PI); - [ rewrite (sin_period (x - PI) 1); apply sin_gt_0; - [ replace (x - PI) with (x + - PI); - [ rewrite Rplus_comm; replace 0 with (- PI + PI); - [ apply Rplus_lt_compat_l; assumption | ring ] - | ring ] - | replace (x - PI) with (x + - PI); rewrite Rplus_comm; - [ pattern PI at 2 in |- *; replace PI with (- PI + 2 * PI); - [ apply Rplus_lt_compat_l; assumption | ring ] - | ring ] ] - | unfold INR in |- *; ring ]. +Proof. + intros x H1 H2; rewrite <- Ropp_0; rewrite <- (Ropp_involutive (sin x)); + apply Ropp_lt_gt_contravar; rewrite <- neg_sin; + replace (x + PI) with (x - PI + 2 * INR 1 * PI); + [ rewrite (sin_period (x - PI) 1); apply sin_gt_0; + [ replace (x - PI) with (x + - PI); + [ rewrite Rplus_comm; replace 0 with (- PI + PI); + [ apply Rplus_lt_compat_l; assumption | ring ] + | ring ] + | replace (x - PI) with (x + - PI); rewrite Rplus_comm; + [ pattern PI at 2 in |- *; replace PI with (- PI + 2 * PI); + [ apply Rplus_lt_compat_l; assumption | ring ] + | ring ] ] + | unfold INR in |- *; ring ]. Qed. Lemma sin_lt_0_var : forall x:R, - PI < x -> x < 0 -> sin x < 0. -intros; generalize (Rplus_lt_compat_l (2 * PI) (- PI) x H); - replace (2 * PI + - PI) with PI; - [ intro H1; rewrite Rplus_comm in H1; - generalize (Rplus_lt_compat_l (2 * PI) x 0 H0); - intro H2; rewrite (Rplus_comm (2 * PI)) in H2; - rewrite <- (Rplus_comm 0) in H2; rewrite Rplus_0_l in H2; - rewrite <- (sin_period x 1); unfold INR in |- *; - replace (2 * 1 * PI) with (2 * PI); - [ apply (sin_lt_0 (x + 2 * PI) H1 H2) | ring ] - | ring ]. +Proof. + intros; generalize (Rplus_lt_compat_l (2 * PI) (- PI) x H); + replace (2 * PI + - PI) with PI; + [ intro H1; rewrite Rplus_comm in H1; + generalize (Rplus_lt_compat_l (2 * PI) x 0 H0); + intro H2; rewrite (Rplus_comm (2 * PI)) in H2; + rewrite <- (Rplus_comm 0) in H2; rewrite Rplus_0_l in H2; + rewrite <- (sin_period x 1); unfold INR in |- *; + replace (2 * 1 * PI) with (2 * PI); + [ apply (sin_lt_0 (x + 2 * PI) H1 H2) | ring ] + | ring ]. Qed. Lemma cos_lt_0 : forall x:R, PI / 2 < x -> x < 3 * (PI / 2) -> cos x < 0. -intros x H1 H2; rewrite <- Ropp_0; rewrite <- (Ropp_involutive (cos x)); - apply Ropp_lt_gt_contravar; rewrite <- neg_cos; - replace (x + PI) with (x - PI + 2 * INR 1 * PI). -rewrite cos_period; apply cos_gt_0. -replace (- (PI / 2)) with (- PI + PI / 2). -unfold Rminus in |- *; rewrite (Rplus_comm x); apply Rplus_lt_compat_l; - assumption. -pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr; - ring. -unfold Rminus in |- *; rewrite Rplus_comm; - replace (PI / 2) with (- PI + 3 * (PI / 2)). -apply Rplus_lt_compat_l; assumption. -pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr; - ring. -unfold INR in |- *; ring. +Proof. + intros x H1 H2; rewrite <- Ropp_0; rewrite <- (Ropp_involutive (cos x)); + apply Ropp_lt_gt_contravar; rewrite <- neg_cos; + replace (x + PI) with (x - PI + 2 * INR 1 * PI). + rewrite cos_period; apply cos_gt_0. + replace (- (PI / 2)) with (- PI + PI / 2). + unfold Rminus in |- *; rewrite (Rplus_comm x); apply Rplus_lt_compat_l; + assumption. + pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr; + ring. + unfold Rminus in |- *; rewrite Rplus_comm; + replace (PI / 2) with (- PI + 3 * (PI / 2)). + apply Rplus_lt_compat_l; assumption. + pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr; + ring. + unfold INR in |- *; ring. Qed. Lemma tan_gt_0 : forall x:R, 0 < x -> x < PI / 2 -> 0 < tan x. -intros x H1 H2; unfold tan in |- *; generalize _PI2_RLT_0; - generalize (Rlt_trans 0 x (PI / 2) H1 H2); intros; - generalize (Rlt_trans (- (PI / 2)) 0 x H0 H1); intro H5; - generalize (Rlt_trans x (PI / 2) PI H2 PI2_Rlt_PI); - intro H7; unfold Rdiv in |- *; apply Rmult_lt_0_compat. -apply sin_gt_0; assumption. -apply Rinv_0_lt_compat; apply cos_gt_0; assumption. +Proof. + intros x H1 H2; unfold tan in |- *; generalize _PI2_RLT_0; + generalize (Rlt_trans 0 x (PI / 2) H1 H2); intros; + generalize (Rlt_trans (- (PI / 2)) 0 x H0 H1); intro H5; + generalize (Rlt_trans x (PI / 2) PI H2 PI2_Rlt_PI); + intro H7; unfold Rdiv in |- *; apply Rmult_lt_0_compat. + apply sin_gt_0; assumption. + apply Rinv_0_lt_compat; apply cos_gt_0; assumption. Qed. Lemma tan_lt_0 : forall x:R, - (PI / 2) < x -> x < 0 -> tan x < 0. -intros x H1 H2; unfold tan in |- *; - generalize (cos_gt_0 x H1 (Rlt_trans x 0 (PI / 2) H2 PI2_RGT_0)); - intro H3; rewrite <- Ropp_0; - replace (sin x / cos x) with (- (- sin x / cos x)). -rewrite <- sin_neg; apply Ropp_gt_lt_contravar; - change (0 < sin (- x) / cos x) in |- *; unfold Rdiv in |- *; - apply Rmult_lt_0_compat. -apply sin_gt_0. -rewrite <- Ropp_0; apply Ropp_gt_lt_contravar; assumption. -apply Rlt_trans with (PI / 2). -rewrite <- (Ropp_involutive (PI / 2)); apply Ropp_gt_lt_contravar; assumption. -apply PI2_Rlt_PI. -apply Rinv_0_lt_compat; assumption. -unfold Rdiv in |- *; ring. +Proof. + intros x H1 H2; unfold tan in |- *; + generalize (cos_gt_0 x H1 (Rlt_trans x 0 (PI / 2) H2 PI2_RGT_0)); + intro H3; rewrite <- Ropp_0; + replace (sin x / cos x) with (- (- sin x / cos x)). + rewrite <- sin_neg; apply Ropp_gt_lt_contravar; + change (0 < sin (- x) / cos x) in |- *; unfold Rdiv in |- *; + apply Rmult_lt_0_compat. + apply sin_gt_0. + rewrite <- Ropp_0; apply Ropp_gt_lt_contravar; assumption. + apply Rlt_trans with (PI / 2). + rewrite <- (Ropp_involutive (PI / 2)); apply Ropp_gt_lt_contravar; assumption. + apply PI2_Rlt_PI. + apply Rinv_0_lt_compat; assumption. + unfold Rdiv in |- *; ring. Qed. Lemma cos_ge_0_3PI2 : - forall x:R, 3 * (PI / 2) <= x -> x <= 2 * PI -> 0 <= cos x. -intros; rewrite <- cos_neg; rewrite <- (cos_period (- x) 1); - unfold INR in |- *; replace (- x + 2 * 1 * PI) with (2 * PI - x). -generalize (Ropp_le_ge_contravar x (2 * PI) H0); intro H1; - generalize (Rge_le (- x) (- (2 * PI)) H1); clear H1; - intro H1; generalize (Rplus_le_compat_l (2 * PI) (- (2 * PI)) (- x) H1). -rewrite Rplus_opp_r. -intro H2; generalize (Ropp_le_ge_contravar (3 * (PI / 2)) x H); intro H3; - generalize (Rge_le (- (3 * (PI / 2))) (- x) H3); clear H3; - intro H3; - generalize (Rplus_le_compat_l (2 * PI) (- x) (- (3 * (PI / 2))) H3). -replace (2 * PI + - (3 * (PI / 2))) with (PI / 2). -intro H4; - apply - (cos_ge_0 (2 * PI - x) - (Rlt_le (- (PI / 2)) (2 * PI - x) - (Rlt_le_trans (- (PI / 2)) 0 (2 * PI - x) _PI2_RLT_0 H2)) H4). -rewrite double; pattern PI at 2 3 in |- *; rewrite double_var; ring. -ring. + forall x:R, 3 * (PI / 2) <= x -> x <= 2 * PI -> 0 <= cos x. +Proof. + intros; rewrite <- cos_neg; rewrite <- (cos_period (- x) 1); + unfold INR in |- *; replace (- x + 2 * 1 * PI) with (2 * PI - x). + generalize (Ropp_le_ge_contravar x (2 * PI) H0); intro H1; + generalize (Rge_le (- x) (- (2 * PI)) H1); clear H1; + intro H1; generalize (Rplus_le_compat_l (2 * PI) (- (2 * PI)) (- x) H1). + rewrite Rplus_opp_r. + intro H2; generalize (Ropp_le_ge_contravar (3 * (PI / 2)) x H); intro H3; + generalize (Rge_le (- (3 * (PI / 2))) (- x) H3); clear H3; + intro H3; + generalize (Rplus_le_compat_l (2 * PI) (- x) (- (3 * (PI / 2))) H3). + replace (2 * PI + - (3 * (PI / 2))) with (PI / 2). + intro H4; + apply + (cos_ge_0 (2 * PI - x) + (Rlt_le (- (PI / 2)) (2 * PI - x) + (Rlt_le_trans (- (PI / 2)) 0 (2 * PI - x) _PI2_RLT_0 H2)) H4). + rewrite double; pattern PI at 2 3 in |- *; rewrite double_var; ring. + ring. Qed. Lemma form1 : - forall p q:R, cos p + cos q = 2 * cos ((p - q) / 2) * cos ((p + q) / 2). -intros p q; pattern p at 1 in |- *; - replace p with ((p - q) / 2 + (p + q) / 2). -rewrite <- (cos_neg q); replace (- q) with ((p - q) / 2 - (p + q) / 2). -rewrite cos_plus; rewrite cos_minus; ring. -pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. -pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. + forall p q:R, cos p + cos q = 2 * cos ((p - q) / 2) * cos ((p + q) / 2). +Proof. + intros p q; pattern p at 1 in |- *; + replace p with ((p - q) / 2 + (p + q) / 2). + rewrite <- (cos_neg q); replace (- q) with ((p - q) / 2 - (p + q) / 2). + rewrite cos_plus; rewrite cos_minus; ring. + pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. + pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. Qed. Lemma form2 : - forall p q:R, cos p - cos q = -2 * sin ((p - q) / 2) * sin ((p + q) / 2). -intros p q; pattern p at 1 in |- *; - replace p with ((p - q) / 2 + (p + q) / 2). -rewrite <- (cos_neg q); replace (- q) with ((p - q) / 2 - (p + q) / 2). -rewrite cos_plus; rewrite cos_minus; ring. -pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. -pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. + forall p q:R, cos p - cos q = -2 * sin ((p - q) / 2) * sin ((p + q) / 2). +Proof. + intros p q; pattern p at 1 in |- *; + replace p with ((p - q) / 2 + (p + q) / 2). + rewrite <- (cos_neg q); replace (- q) with ((p - q) / 2 - (p + q) / 2). + rewrite cos_plus; rewrite cos_minus; ring. + pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. + pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. Qed. Lemma form3 : - forall p q:R, sin p + sin q = 2 * cos ((p - q) / 2) * sin ((p + q) / 2). -intros p q; pattern p at 1 in |- *; - replace p with ((p - q) / 2 + (p + q) / 2). -pattern q at 3 in |- *; replace q with ((p + q) / 2 - (p - q) / 2). -rewrite sin_plus; rewrite sin_minus; ring. -pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. -pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. + forall p q:R, sin p + sin q = 2 * cos ((p - q) / 2) * sin ((p + q) / 2). +Proof. + intros p q; pattern p at 1 in |- *; + replace p with ((p - q) / 2 + (p + q) / 2). + pattern q at 3 in |- *; replace q with ((p + q) / 2 - (p - q) / 2). + rewrite sin_plus; rewrite sin_minus; ring. + pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. + pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. Qed. Lemma form4 : - forall p q:R, sin p - sin q = 2 * cos ((p + q) / 2) * sin ((p - q) / 2). -intros p q; pattern p at 1 in |- *; - replace p with ((p - q) / 2 + (p + q) / 2). -pattern q at 3 in |- *; replace q with ((p + q) / 2 - (p - q) / 2). -rewrite sin_plus; rewrite sin_minus; ring. -pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. -pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. + forall p q:R, sin p - sin q = 2 * cos ((p + q) / 2) * sin ((p - q) / 2). +Proof. + intros p q; pattern p at 1 in |- *; + replace p with ((p - q) / 2 + (p + q) / 2). + pattern q at 3 in |- *; replace q with ((p + q) / 2 - (p - q) / 2). + rewrite sin_plus; rewrite sin_minus; ring. + pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. + pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring. Qed. Lemma sin_increasing_0 : - forall x y:R, - - (PI / 2) <= x -> - x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> sin x < sin y -> x < y. -intros; cut (sin ((x - y) / 2) < 0). -intro H4; case (Rtotal_order ((x - y) / 2) 0); intro H5. -assert (Hyp : 0 < 2). -prove_sup0. -generalize (Rmult_lt_compat_l 2 ((x - y) / 2) 0 Hyp H5). -unfold Rdiv in |- *. -rewrite <- Rmult_assoc. -rewrite Rinv_r_simpl_m. -rewrite Rmult_0_r. -clear H5; intro H5; apply Rminus_lt; assumption. -discrR. -elim H5; intro H6. -rewrite H6 in H4; rewrite sin_0 in H4; elim (Rlt_irrefl 0 H4). -change (0 < (x - y) / 2) in H6; - generalize (Ropp_le_ge_contravar (- (PI / 2)) y H1). -rewrite Ropp_involutive. -intro H7; generalize (Rge_le (PI / 2) (- y) H7); clear H7; intro H7; - generalize (Rplus_le_compat x (PI / 2) (- y) (PI / 2) H0 H7). -rewrite <- double_var. -intro H8. -assert (Hyp : 0 < 2). -prove_sup0. -generalize - (Rmult_le_compat_l (/ 2) (x - y) PI - (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H8). -repeat rewrite (Rmult_comm (/ 2)). -intro H9; - generalize - (sin_gt_0 ((x - y) / 2) H6 - (Rle_lt_trans ((x - y) / 2) (PI / 2) PI H9 PI2_Rlt_PI)); - intro H10; - elim - (Rlt_irrefl (sin ((x - y) / 2)) - (Rlt_trans (sin ((x - y) / 2)) 0 (sin ((x - y) / 2)) H4 H10)). -generalize (Rlt_minus (sin x) (sin y) H3); clear H3; intro H3; - rewrite form4 in H3; - generalize (Rplus_le_compat x (PI / 2) y (PI / 2) H0 H2). -rewrite <- double_var. -assert (Hyp : 0 < 2). -prove_sup0. -intro H4; - generalize - (Rmult_le_compat_l (/ 2) (x + y) PI - (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H4). -repeat rewrite (Rmult_comm (/ 2)). -clear H4; intro H4; - generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) y H H1); - replace (- (PI / 2) + - (PI / 2)) with (- PI). -intro H5; - generalize - (Rmult_le_compat_l (/ 2) (- PI) (x + y) - (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H5). -replace (/ 2 * (x + y)) with ((x + y) / 2). -replace (/ 2 * - PI) with (- (PI / 2)). -clear H5; intro H5; elim H4; intro H40. -elim H5; intro H50. -generalize (cos_gt_0 ((x + y) / 2) H50 H40); intro H6; - generalize (Rmult_lt_compat_l 2 0 (cos ((x + y) / 2)) Hyp H6). -rewrite Rmult_0_r. -clear H6; intro H6; case (Rcase_abs (sin ((x - y) / 2))); intro H7. -assumption. -generalize (Rge_le (sin ((x - y) / 2)) 0 H7); clear H7; intro H7; - generalize - (Rmult_le_pos (2 * cos ((x + y) / 2)) (sin ((x - y) / 2)) - (Rlt_le 0 (2 * cos ((x + y) / 2)) H6) H7); intro H8; - generalize - (Rle_lt_trans 0 (2 * cos ((x + y) / 2) * sin ((x - y) / 2)) 0 H8 H3); - intro H9; elim (Rlt_irrefl 0 H9). -rewrite <- H50 in H3; rewrite cos_neg in H3; rewrite cos_PI2 in H3; - rewrite Rmult_0_r in H3; rewrite Rmult_0_l in H3; - elim (Rlt_irrefl 0 H3). -unfold Rdiv in H3. -rewrite H40 in H3; assert (H50 := cos_PI2); unfold Rdiv in H50; - rewrite H50 in H3; rewrite Rmult_0_r in H3; rewrite Rmult_0_l in H3; - elim (Rlt_irrefl 0 H3). -unfold Rdiv in |- *. -rewrite <- Ropp_mult_distr_l_reverse. -apply Rmult_comm. -unfold Rdiv in |- *; apply Rmult_comm. -pattern PI at 1 in |- *; rewrite double_var. -rewrite Ropp_plus_distr. -reflexivity. + forall x y:R, + - (PI / 2) <= x -> + x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> sin x < sin y -> x < y. +Proof. + intros; cut (sin ((x - y) / 2) < 0). + intro H4; case (Rtotal_order ((x - y) / 2) 0); intro H5. + assert (Hyp : 0 < 2). + prove_sup0. + generalize (Rmult_lt_compat_l 2 ((x - y) / 2) 0 Hyp H5). + unfold Rdiv in |- *. + rewrite <- Rmult_assoc. + rewrite Rinv_r_simpl_m. + rewrite Rmult_0_r. + clear H5; intro H5; apply Rminus_lt; assumption. + discrR. + elim H5; intro H6. + rewrite H6 in H4; rewrite sin_0 in H4; elim (Rlt_irrefl 0 H4). + change (0 < (x - y) / 2) in H6; + generalize (Ropp_le_ge_contravar (- (PI / 2)) y H1). + rewrite Ropp_involutive. + intro H7; generalize (Rge_le (PI / 2) (- y) H7); clear H7; intro H7; + generalize (Rplus_le_compat x (PI / 2) (- y) (PI / 2) H0 H7). + rewrite <- double_var. + intro H8. + assert (Hyp : 0 < 2). + prove_sup0. + generalize + (Rmult_le_compat_l (/ 2) (x - y) PI + (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H8). + repeat rewrite (Rmult_comm (/ 2)). + intro H9; + generalize + (sin_gt_0 ((x - y) / 2) H6 + (Rle_lt_trans ((x - y) / 2) (PI / 2) PI H9 PI2_Rlt_PI)); + intro H10; + elim + (Rlt_irrefl (sin ((x - y) / 2)) + (Rlt_trans (sin ((x - y) / 2)) 0 (sin ((x - y) / 2)) H4 H10)). + generalize (Rlt_minus (sin x) (sin y) H3); clear H3; intro H3; + rewrite form4 in H3; + generalize (Rplus_le_compat x (PI / 2) y (PI / 2) H0 H2). + rewrite <- double_var. + assert (Hyp : 0 < 2). + prove_sup0. + intro H4; + generalize + (Rmult_le_compat_l (/ 2) (x + y) PI + (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H4). + repeat rewrite (Rmult_comm (/ 2)). + clear H4; intro H4; + generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) y H H1); + replace (- (PI / 2) + - (PI / 2)) with (- PI). + intro H5; + generalize + (Rmult_le_compat_l (/ 2) (- PI) (x + y) + (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H5). + replace (/ 2 * (x + y)) with ((x + y) / 2). + replace (/ 2 * - PI) with (- (PI / 2)). + clear H5; intro H5; elim H4; intro H40. + elim H5; intro H50. + generalize (cos_gt_0 ((x + y) / 2) H50 H40); intro H6; + generalize (Rmult_lt_compat_l 2 0 (cos ((x + y) / 2)) Hyp H6). + rewrite Rmult_0_r. + clear H6; intro H6; case (Rcase_abs (sin ((x - y) / 2))); intro H7. + assumption. + generalize (Rge_le (sin ((x - y) / 2)) 0 H7); clear H7; intro H7; + generalize + (Rmult_le_pos (2 * cos ((x + y) / 2)) (sin ((x - y) / 2)) + (Rlt_le 0 (2 * cos ((x + y) / 2)) H6) H7); intro H8; + generalize + (Rle_lt_trans 0 (2 * cos ((x + y) / 2) * sin ((x - y) / 2)) 0 H8 H3); + intro H9; elim (Rlt_irrefl 0 H9). + rewrite <- H50 in H3; rewrite cos_neg in H3; rewrite cos_PI2 in H3; + rewrite Rmult_0_r in H3; rewrite Rmult_0_l in H3; + elim (Rlt_irrefl 0 H3). + unfold Rdiv in H3. + rewrite H40 in H3; assert (H50 := cos_PI2); unfold Rdiv in H50; + rewrite H50 in H3; rewrite Rmult_0_r in H3; rewrite Rmult_0_l in H3; + elim (Rlt_irrefl 0 H3). + unfold Rdiv in |- *. + rewrite <- Ropp_mult_distr_l_reverse. + apply Rmult_comm. + unfold Rdiv in |- *; apply Rmult_comm. + pattern PI at 1 in |- *; rewrite double_var. + rewrite Ropp_plus_distr. + reflexivity. Qed. Lemma sin_increasing_1 : - forall x y:R, - - (PI / 2) <= x -> - x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> x < y -> sin x < sin y. -intros; generalize (Rplus_lt_compat_l x x y H3); intro H4; - generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) x H H); - replace (- (PI / 2) + - (PI / 2)) with (- PI). -assert (Hyp : 0 < 2). -prove_sup0. -intro H5; generalize (Rle_lt_trans (- PI) (x + x) (x + y) H5 H4); intro H6; - generalize - (Rmult_lt_compat_l (/ 2) (- PI) (x + y) (Rinv_0_lt_compat 2 Hyp) H6); - replace (/ 2 * - PI) with (- (PI / 2)). -replace (/ 2 * (x + y)) with ((x + y) / 2). -clear H4 H5 H6; intro H4; generalize (Rplus_lt_compat_l y x y H3); intro H5; - rewrite Rplus_comm in H5; - generalize (Rplus_le_compat y (PI / 2) y (PI / 2) H2 H2). -rewrite <- double_var. -intro H6; generalize (Rlt_le_trans (x + y) (y + y) PI H5 H6); intro H7; - generalize (Rmult_lt_compat_l (/ 2) (x + y) PI (Rinv_0_lt_compat 2 Hyp) H7); - replace (/ 2 * PI) with (PI / 2). -replace (/ 2 * (x + y)) with ((x + y) / 2). -clear H5 H6 H7; intro H5; generalize (Ropp_le_ge_contravar (- (PI / 2)) y H1); - rewrite Ropp_involutive; clear H1; intro H1; - generalize (Rge_le (PI / 2) (- y) H1); clear H1; intro H1; - generalize (Ropp_le_ge_contravar y (PI / 2) H2); clear H2; - intro H2; generalize (Rge_le (- y) (- (PI / 2)) H2); - clear H2; intro H2; generalize (Rplus_lt_compat_l (- y) x y H3); - replace (- y + x) with (x - y). -rewrite Rplus_opp_l. -intro H6; - generalize (Rmult_lt_compat_l (/ 2) (x - y) 0 (Rinv_0_lt_compat 2 Hyp) H6); - rewrite Rmult_0_r; replace (/ 2 * (x - y)) with ((x - y) / 2). -clear H6; intro H6; - generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) (- y) H H2); - replace (- (PI / 2) + - (PI / 2)) with (- PI). -replace (x + - y) with (x - y). -intro H7; - generalize - (Rmult_le_compat_l (/ 2) (- PI) (x - y) - (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H7); - replace (/ 2 * - PI) with (- (PI / 2)). -replace (/ 2 * (x - y)) with ((x - y) / 2). -clear H7; intro H7; clear H H0 H1 H2; apply Rminus_lt; rewrite form4; - generalize (cos_gt_0 ((x + y) / 2) H4 H5); intro H8; - generalize (Rmult_lt_0_compat 2 (cos ((x + y) / 2)) Hyp H8); - clear H8; intro H8; cut (- PI < - (PI / 2)). -intro H9; - generalize - (sin_lt_0_var ((x - y) / 2) - (Rlt_le_trans (- PI) (- (PI / 2)) ((x - y) / 2) H9 H7) H6); - intro H10; - generalize - (Rmult_lt_gt_compat_neg_l (sin ((x - y) / 2)) 0 ( - 2 * cos ((x + y) / 2)) H10 H8); intro H11; rewrite Rmult_0_r in H11; - rewrite Rmult_comm; assumption. -apply Ropp_lt_gt_contravar; apply PI2_Rlt_PI. -unfold Rdiv in |- *; apply Rmult_comm. -unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse; apply Rmult_comm. -reflexivity. -pattern PI at 1 in |- *; rewrite double_var. -rewrite Ropp_plus_distr. -reflexivity. -unfold Rdiv in |- *; apply Rmult_comm. -unfold Rminus in |- *; apply Rplus_comm. -unfold Rdiv in |- *; apply Rmult_comm. -unfold Rdiv in |- *; apply Rmult_comm. -unfold Rdiv in |- *; apply Rmult_comm. -unfold Rdiv in |- *. -rewrite <- Ropp_mult_distr_l_reverse. -apply Rmult_comm. -pattern PI at 1 in |- *; rewrite double_var. -rewrite Ropp_plus_distr. -reflexivity. + forall x y:R, + - (PI / 2) <= x -> + x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> x < y -> sin x < sin y. +Proof. + intros; generalize (Rplus_lt_compat_l x x y H3); intro H4; + generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) x H H); + replace (- (PI / 2) + - (PI / 2)) with (- PI). + assert (Hyp : 0 < 2). + prove_sup0. + intro H5; generalize (Rle_lt_trans (- PI) (x + x) (x + y) H5 H4); intro H6; + generalize + (Rmult_lt_compat_l (/ 2) (- PI) (x + y) (Rinv_0_lt_compat 2 Hyp) H6); + replace (/ 2 * - PI) with (- (PI / 2)). + replace (/ 2 * (x + y)) with ((x + y) / 2). + clear H4 H5 H6; intro H4; generalize (Rplus_lt_compat_l y x y H3); intro H5; + rewrite Rplus_comm in H5; + generalize (Rplus_le_compat y (PI / 2) y (PI / 2) H2 H2). + rewrite <- double_var. + intro H6; generalize (Rlt_le_trans (x + y) (y + y) PI H5 H6); intro H7; + generalize (Rmult_lt_compat_l (/ 2) (x + y) PI (Rinv_0_lt_compat 2 Hyp) H7); + replace (/ 2 * PI) with (PI / 2). + replace (/ 2 * (x + y)) with ((x + y) / 2). + clear H5 H6 H7; intro H5; generalize (Ropp_le_ge_contravar (- (PI / 2)) y H1); + rewrite Ropp_involutive; clear H1; intro H1; + generalize (Rge_le (PI / 2) (- y) H1); clear H1; intro H1; + generalize (Ropp_le_ge_contravar y (PI / 2) H2); clear H2; + intro H2; generalize (Rge_le (- y) (- (PI / 2)) H2); + clear H2; intro H2; generalize (Rplus_lt_compat_l (- y) x y H3); + replace (- y + x) with (x - y). + rewrite Rplus_opp_l. + intro H6; + generalize (Rmult_lt_compat_l (/ 2) (x - y) 0 (Rinv_0_lt_compat 2 Hyp) H6); + rewrite Rmult_0_r; replace (/ 2 * (x - y)) with ((x - y) / 2). + clear H6; intro H6; + generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) (- y) H H2); + replace (- (PI / 2) + - (PI / 2)) with (- PI). + replace (x + - y) with (x - y). + intro H7; + generalize + (Rmult_le_compat_l (/ 2) (- PI) (x - y) + (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H7); + replace (/ 2 * - PI) with (- (PI / 2)). + replace (/ 2 * (x - y)) with ((x - y) / 2). + clear H7; intro H7; clear H H0 H1 H2; apply Rminus_lt; rewrite form4; + generalize (cos_gt_0 ((x + y) / 2) H4 H5); intro H8; + generalize (Rmult_lt_0_compat 2 (cos ((x + y) / 2)) Hyp H8); + clear H8; intro H8; cut (- PI < - (PI / 2)). + intro H9; + generalize + (sin_lt_0_var ((x - y) / 2) + (Rlt_le_trans (- PI) (- (PI / 2)) ((x - y) / 2) H9 H7) H6); + intro H10; + generalize + (Rmult_lt_gt_compat_neg_l (sin ((x - y) / 2)) 0 ( + 2 * cos ((x + y) / 2)) H10 H8); intro H11; rewrite Rmult_0_r in H11; + rewrite Rmult_comm; assumption. + apply Ropp_lt_gt_contravar; apply PI2_Rlt_PI. + unfold Rdiv in |- *; apply Rmult_comm. + unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse; apply Rmult_comm. + reflexivity. + pattern PI at 1 in |- *; rewrite double_var. + rewrite Ropp_plus_distr. + reflexivity. + unfold Rdiv in |- *; apply Rmult_comm. + unfold Rminus in |- *; apply Rplus_comm. + unfold Rdiv in |- *; apply Rmult_comm. + unfold Rdiv in |- *; apply Rmult_comm. + unfold Rdiv in |- *; apply Rmult_comm. + unfold Rdiv in |- *. + rewrite <- Ropp_mult_distr_l_reverse. + apply Rmult_comm. + pattern PI at 1 in |- *; rewrite double_var. + rewrite Ropp_plus_distr. + reflexivity. Qed. Lemma sin_decreasing_0 : - forall x y:R, - x <= 3 * (PI / 2) -> - PI / 2 <= x -> y <= 3 * (PI / 2) -> PI / 2 <= y -> sin x < sin y -> y < x. -intros; rewrite <- (sin_PI_x x) in H3; rewrite <- (sin_PI_x y) in H3; - generalize (Ropp_lt_gt_contravar (sin (PI - x)) (sin (PI - y)) H3); - repeat rewrite <- sin_neg; - generalize (Rplus_le_compat_l (- PI) x (3 * (PI / 2)) H); - generalize (Rplus_le_compat_l (- PI) (PI / 2) x H0); - generalize (Rplus_le_compat_l (- PI) y (3 * (PI / 2)) H1); - generalize (Rplus_le_compat_l (- PI) (PI / 2) y H2); - replace (- PI + x) with (x - PI). -replace (- PI + PI / 2) with (- (PI / 2)). -replace (- PI + y) with (y - PI). -replace (- PI + 3 * (PI / 2)) with (PI / 2). -replace (- (PI - x)) with (x - PI). -replace (- (PI - y)) with (y - PI). -intros; change (sin (y - PI) < sin (x - PI)) in H8; - apply Rplus_lt_reg_r with (- PI); rewrite Rplus_comm; - replace (y + - PI) with (y - PI). -rewrite Rplus_comm; replace (x + - PI) with (x - PI). -apply (sin_increasing_0 (y - PI) (x - PI) H4 H5 H6 H7 H8). -reflexivity. -reflexivity. -unfold Rminus in |- *; rewrite Ropp_plus_distr. -rewrite Ropp_involutive. -apply Rplus_comm. -unfold Rminus in |- *; rewrite Ropp_plus_distr. -rewrite Ropp_involutive. -apply Rplus_comm. -pattern PI at 2 in |- *; rewrite double_var. -rewrite Ropp_plus_distr. -ring. -unfold Rminus in |- *; apply Rplus_comm. -pattern PI at 2 in |- *; rewrite double_var. -rewrite Ropp_plus_distr. -ring. -unfold Rminus in |- *; apply Rplus_comm. + forall x y:R, + x <= 3 * (PI / 2) -> + PI / 2 <= x -> y <= 3 * (PI / 2) -> PI / 2 <= y -> sin x < sin y -> y < x. +Proof. + intros; rewrite <- (sin_PI_x x) in H3; rewrite <- (sin_PI_x y) in H3; + generalize (Ropp_lt_gt_contravar (sin (PI - x)) (sin (PI - y)) H3); + repeat rewrite <- sin_neg; + generalize (Rplus_le_compat_l (- PI) x (3 * (PI / 2)) H); + generalize (Rplus_le_compat_l (- PI) (PI / 2) x H0); + generalize (Rplus_le_compat_l (- PI) y (3 * (PI / 2)) H1); + generalize (Rplus_le_compat_l (- PI) (PI / 2) y H2); + replace (- PI + x) with (x - PI). + replace (- PI + PI / 2) with (- (PI / 2)). + replace (- PI + y) with (y - PI). + replace (- PI + 3 * (PI / 2)) with (PI / 2). + replace (- (PI - x)) with (x - PI). + replace (- (PI - y)) with (y - PI). + intros; change (sin (y - PI) < sin (x - PI)) in H8; + apply Rplus_lt_reg_r with (- PI); rewrite Rplus_comm; + replace (y + - PI) with (y - PI). + rewrite Rplus_comm; replace (x + - PI) with (x - PI). + apply (sin_increasing_0 (y - PI) (x - PI) H4 H5 H6 H7 H8). + reflexivity. + reflexivity. + unfold Rminus in |- *; rewrite Ropp_plus_distr. + rewrite Ropp_involutive. + apply Rplus_comm. + unfold Rminus in |- *; rewrite Ropp_plus_distr. + rewrite Ropp_involutive. + apply Rplus_comm. + pattern PI at 2 in |- *; rewrite double_var. + rewrite Ropp_plus_distr. + ring. + unfold Rminus in |- *; apply Rplus_comm. + pattern PI at 2 in |- *; rewrite double_var. + rewrite Ropp_plus_distr. + ring. + unfold Rminus in |- *; apply Rplus_comm. Qed. Lemma sin_decreasing_1 : - forall x y:R, - x <= 3 * (PI / 2) -> - PI / 2 <= x -> y <= 3 * (PI / 2) -> PI / 2 <= y -> x < y -> sin y < sin x. -intros; rewrite <- (sin_PI_x x); rewrite <- (sin_PI_x y); - generalize (Rplus_le_compat_l (- PI) x (3 * (PI / 2)) H); - generalize (Rplus_le_compat_l (- PI) (PI / 2) x H0); - generalize (Rplus_le_compat_l (- PI) y (3 * (PI / 2)) H1); - generalize (Rplus_le_compat_l (- PI) (PI / 2) y H2); - generalize (Rplus_lt_compat_l (- PI) x y H3); - replace (- PI + PI / 2) with (- (PI / 2)). -replace (- PI + y) with (y - PI). -replace (- PI + 3 * (PI / 2)) with (PI / 2). -replace (- PI + x) with (x - PI). -intros; apply Ropp_lt_cancel; repeat rewrite <- sin_neg; - replace (- (PI - x)) with (x - PI). -replace (- (PI - y)) with (y - PI). -apply (sin_increasing_1 (x - PI) (y - PI) H7 H8 H5 H6 H4). -unfold Rminus in |- *; rewrite Ropp_plus_distr. -rewrite Ropp_involutive. -apply Rplus_comm. -unfold Rminus in |- *; rewrite Ropp_plus_distr. -rewrite Ropp_involutive. -apply Rplus_comm. -unfold Rminus in |- *; apply Rplus_comm. -pattern PI at 2 in |- *; rewrite double_var; ring. -unfold Rminus in |- *; apply Rplus_comm. -pattern PI at 2 in |- *; rewrite double_var; ring. + forall x y:R, + x <= 3 * (PI / 2) -> + PI / 2 <= x -> y <= 3 * (PI / 2) -> PI / 2 <= y -> x < y -> sin y < sin x. +Proof. + intros; rewrite <- (sin_PI_x x); rewrite <- (sin_PI_x y); + generalize (Rplus_le_compat_l (- PI) x (3 * (PI / 2)) H); + generalize (Rplus_le_compat_l (- PI) (PI / 2) x H0); + generalize (Rplus_le_compat_l (- PI) y (3 * (PI / 2)) H1); + generalize (Rplus_le_compat_l (- PI) (PI / 2) y H2); + generalize (Rplus_lt_compat_l (- PI) x y H3); + replace (- PI + PI / 2) with (- (PI / 2)). + replace (- PI + y) with (y - PI). + replace (- PI + 3 * (PI / 2)) with (PI / 2). + replace (- PI + x) with (x - PI). + intros; apply Ropp_lt_cancel; repeat rewrite <- sin_neg; + replace (- (PI - x)) with (x - PI). + replace (- (PI - y)) with (y - PI). + apply (sin_increasing_1 (x - PI) (y - PI) H7 H8 H5 H6 H4). + unfold Rminus in |- *; rewrite Ropp_plus_distr. + rewrite Ropp_involutive. + apply Rplus_comm. + unfold Rminus in |- *; rewrite Ropp_plus_distr. + rewrite Ropp_involutive. + apply Rplus_comm. + unfold Rminus in |- *; apply Rplus_comm. + pattern PI at 2 in |- *; rewrite double_var; ring. + unfold Rminus in |- *; apply Rplus_comm. + pattern PI at 2 in |- *; rewrite double_var; ring. Qed. Lemma cos_increasing_0 : - forall x y:R, - PI <= x -> x <= 2 * PI -> PI <= y -> y <= 2 * PI -> cos x < cos y -> x < y. -intros x y H1 H2 H3 H4; rewrite <- (cos_neg x); rewrite <- (cos_neg y); - rewrite <- (cos_period (- x) 1); rewrite <- (cos_period (- y) 1); - unfold INR in |- *; - replace (- x + 2 * 1 * PI) with (PI / 2 - (x - 3 * (PI / 2))). -replace (- y + 2 * 1 * PI) with (PI / 2 - (y - 3 * (PI / 2))). -repeat rewrite cos_shift; intro H5; - generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI x H1); - generalize (Rplus_le_compat_l (-3 * (PI / 2)) x (2 * PI) H2); - generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI y H3); - generalize (Rplus_le_compat_l (-3 * (PI / 2)) y (2 * PI) H4). -replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)). -replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)). -replace (-3 * (PI / 2) + 2 * PI) with (PI / 2). -replace (-3 * (PI / 2) + PI) with (- (PI / 2)). -clear H1 H2 H3 H4; intros H1 H2 H3 H4; - apply Rplus_lt_reg_r with (-3 * (PI / 2)); - replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)). -replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)). -apply (sin_increasing_0 (x - 3 * (PI / 2)) (y - 3 * (PI / 2)) H4 H3 H2 H1 H5). -unfold Rminus in |- *. -rewrite Ropp_mult_distr_l_reverse. -apply Rplus_comm. -unfold Rminus in |- *. -rewrite Ropp_mult_distr_l_reverse. -apply Rplus_comm. -pattern PI at 3 in |- *; rewrite double_var. -ring. -rewrite double; pattern PI at 3 4 in |- *; rewrite double_var. -ring. -unfold Rminus in |- *. -rewrite Ropp_mult_distr_l_reverse. -apply Rplus_comm. -unfold Rminus in |- *. -rewrite Ropp_mult_distr_l_reverse. -apply Rplus_comm. -rewrite Rmult_1_r. -rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var. -ring. -rewrite Rmult_1_r. -rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var. -ring. + forall x y:R, + PI <= x -> x <= 2 * PI -> PI <= y -> y <= 2 * PI -> cos x < cos y -> x < y. +Proof. + intros x y H1 H2 H3 H4; rewrite <- (cos_neg x); rewrite <- (cos_neg y); + rewrite <- (cos_period (- x) 1); rewrite <- (cos_period (- y) 1); + unfold INR in |- *; + replace (- x + 2 * 1 * PI) with (PI / 2 - (x - 3 * (PI / 2))). + replace (- y + 2 * 1 * PI) with (PI / 2 - (y - 3 * (PI / 2))). + repeat rewrite cos_shift; intro H5; + generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI x H1); + generalize (Rplus_le_compat_l (-3 * (PI / 2)) x (2 * PI) H2); + generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI y H3); + generalize (Rplus_le_compat_l (-3 * (PI / 2)) y (2 * PI) H4). + replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)). + replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)). + replace (-3 * (PI / 2) + 2 * PI) with (PI / 2). + replace (-3 * (PI / 2) + PI) with (- (PI / 2)). + clear H1 H2 H3 H4; intros H1 H2 H3 H4; + apply Rplus_lt_reg_r with (-3 * (PI / 2)); + replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)). + replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)). + apply (sin_increasing_0 (x - 3 * (PI / 2)) (y - 3 * (PI / 2)) H4 H3 H2 H1 H5). + unfold Rminus in |- *. + rewrite Ropp_mult_distr_l_reverse. + apply Rplus_comm. + unfold Rminus in |- *. + rewrite Ropp_mult_distr_l_reverse. + apply Rplus_comm. + pattern PI at 3 in |- *; rewrite double_var. + ring. + rewrite double; pattern PI at 3 4 in |- *; rewrite double_var. + ring. + unfold Rminus in |- *. + rewrite Ropp_mult_distr_l_reverse. + apply Rplus_comm. + unfold Rminus in |- *. + rewrite Ropp_mult_distr_l_reverse. + apply Rplus_comm. + rewrite Rmult_1_r. + rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var. + ring. + rewrite Rmult_1_r. + rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var. + ring. Qed. Lemma cos_increasing_1 : - forall x y:R, - PI <= x -> x <= 2 * PI -> PI <= y -> y <= 2 * PI -> x < y -> cos x < cos y. -intros x y H1 H2 H3 H4 H5; - generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI x H1); - generalize (Rplus_le_compat_l (-3 * (PI / 2)) x (2 * PI) H2); - generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI y H3); - generalize (Rplus_le_compat_l (-3 * (PI / 2)) y (2 * PI) H4); - generalize (Rplus_lt_compat_l (-3 * (PI / 2)) x y H5); - rewrite <- (cos_neg x); rewrite <- (cos_neg y); - rewrite <- (cos_period (- x) 1); rewrite <- (cos_period (- y) 1); - unfold INR in |- *; replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)). -replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)). -replace (-3 * (PI / 2) + PI) with (- (PI / 2)). -replace (-3 * (PI / 2) + 2 * PI) with (PI / 2). -clear H1 H2 H3 H4 H5; intros H1 H2 H3 H4 H5; - replace (- x + 2 * 1 * PI) with (PI / 2 - (x - 3 * (PI / 2))). -replace (- y + 2 * 1 * PI) with (PI / 2 - (y - 3 * (PI / 2))). -repeat rewrite cos_shift; - apply - (sin_increasing_1 (x - 3 * (PI / 2)) (y - 3 * (PI / 2)) H5 H4 H3 H2 H1). -rewrite Rmult_1_r. -rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var. -ring. -rewrite Rmult_1_r. -rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var. -ring. -rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var. -ring. -pattern PI at 3 in |- *; rewrite double_var; ring. -unfold Rminus in |- *. -rewrite <- Ropp_mult_distr_l_reverse. -apply Rplus_comm. -unfold Rminus in |- *. -rewrite <- Ropp_mult_distr_l_reverse. -apply Rplus_comm. + forall x y:R, + PI <= x -> x <= 2 * PI -> PI <= y -> y <= 2 * PI -> x < y -> cos x < cos y. +Proof. + intros x y H1 H2 H3 H4 H5; + generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI x H1); + generalize (Rplus_le_compat_l (-3 * (PI / 2)) x (2 * PI) H2); + generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI y H3); + generalize (Rplus_le_compat_l (-3 * (PI / 2)) y (2 * PI) H4); + generalize (Rplus_lt_compat_l (-3 * (PI / 2)) x y H5); + rewrite <- (cos_neg x); rewrite <- (cos_neg y); + rewrite <- (cos_period (- x) 1); rewrite <- (cos_period (- y) 1); + unfold INR in |- *; replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)). + replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)). + replace (-3 * (PI / 2) + PI) with (- (PI / 2)). + replace (-3 * (PI / 2) + 2 * PI) with (PI / 2). + clear H1 H2 H3 H4 H5; intros H1 H2 H3 H4 H5; + replace (- x + 2 * 1 * PI) with (PI / 2 - (x - 3 * (PI / 2))). + replace (- y + 2 * 1 * PI) with (PI / 2 - (y - 3 * (PI / 2))). + repeat rewrite cos_shift; + apply + (sin_increasing_1 (x - 3 * (PI / 2)) (y - 3 * (PI / 2)) H5 H4 H3 H2 H1). + rewrite Rmult_1_r. + rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var. + ring. + rewrite Rmult_1_r. + rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var. + ring. + rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var. + ring. + pattern PI at 3 in |- *; rewrite double_var; ring. + unfold Rminus in |- *. + rewrite <- Ropp_mult_distr_l_reverse. + apply Rplus_comm. + unfold Rminus in |- *. + rewrite <- Ropp_mult_distr_l_reverse. + apply Rplus_comm. Qed. Lemma cos_decreasing_0 : - forall x y:R, - 0 <= x -> x <= PI -> 0 <= y -> y <= PI -> cos x < cos y -> y < x. -intros; generalize (Ropp_lt_gt_contravar (cos x) (cos y) H3); - repeat rewrite <- neg_cos; intro H4; - change (cos (y + PI) < cos (x + PI)) in H4; rewrite (Rplus_comm x) in H4; - rewrite (Rplus_comm y) in H4; generalize (Rplus_le_compat_l PI 0 x H); - generalize (Rplus_le_compat_l PI x PI H0); - generalize (Rplus_le_compat_l PI 0 y H1); - generalize (Rplus_le_compat_l PI y PI H2); rewrite Rplus_0_r. -rewrite <- double. -clear H H0 H1 H2 H3; intros; apply Rplus_lt_reg_r with PI; - apply (cos_increasing_0 (PI + y) (PI + x) H0 H H2 H1 H4). + forall x y:R, + 0 <= x -> x <= PI -> 0 <= y -> y <= PI -> cos x < cos y -> y < x. +Proof. + intros; generalize (Ropp_lt_gt_contravar (cos x) (cos y) H3); + repeat rewrite <- neg_cos; intro H4; + change (cos (y + PI) < cos (x + PI)) in H4; rewrite (Rplus_comm x) in H4; + rewrite (Rplus_comm y) in H4; generalize (Rplus_le_compat_l PI 0 x H); + generalize (Rplus_le_compat_l PI x PI H0); + generalize (Rplus_le_compat_l PI 0 y H1); + generalize (Rplus_le_compat_l PI y PI H2); rewrite Rplus_0_r. + rewrite <- double. + clear H H0 H1 H2 H3; intros; apply Rplus_lt_reg_r with PI; + apply (cos_increasing_0 (PI + y) (PI + x) H0 H H2 H1 H4). Qed. Lemma cos_decreasing_1 : - forall x y:R, - 0 <= x -> x <= PI -> 0 <= y -> y <= PI -> x < y -> cos y < cos x. -intros; apply Ropp_lt_cancel; repeat rewrite <- neg_cos; - rewrite (Rplus_comm x); rewrite (Rplus_comm y); - generalize (Rplus_le_compat_l PI 0 x H); - generalize (Rplus_le_compat_l PI x PI H0); - generalize (Rplus_le_compat_l PI 0 y H1); - generalize (Rplus_le_compat_l PI y PI H2); rewrite Rplus_0_r. -rewrite <- double. -generalize (Rplus_lt_compat_l PI x y H3); clear H H0 H1 H2 H3; intros; - apply (cos_increasing_1 (PI + x) (PI + y) H3 H2 H1 H0 H). + forall x y:R, + 0 <= x -> x <= PI -> 0 <= y -> y <= PI -> x < y -> cos y < cos x. +Proof. + intros; apply Ropp_lt_cancel; repeat rewrite <- neg_cos; + rewrite (Rplus_comm x); rewrite (Rplus_comm y); + generalize (Rplus_le_compat_l PI 0 x H); + generalize (Rplus_le_compat_l PI x PI H0); + generalize (Rplus_le_compat_l PI 0 y H1); + generalize (Rplus_le_compat_l PI y PI H2); rewrite Rplus_0_r. + rewrite <- double. + generalize (Rplus_lt_compat_l PI x y H3); clear H H0 H1 H2 H3; intros; + apply (cos_increasing_1 (PI + x) (PI + y) H3 H2 H1 H0 H). Qed. Lemma tan_diff : - forall x y:R, - cos x <> 0 -> cos y <> 0 -> tan x - tan y = sin (x - y) / (cos x * cos y). -intros; unfold tan in |- *; rewrite sin_minus. -unfold Rdiv in |- *. -unfold Rminus in |- *. -rewrite Rmult_plus_distr_r. -rewrite Rinv_mult_distr. -repeat rewrite (Rmult_comm (sin x)). -repeat rewrite Rmult_assoc. -rewrite (Rmult_comm (cos y)). -repeat rewrite Rmult_assoc. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_r. -rewrite (Rmult_comm (sin x)). -apply Rplus_eq_compat_l. -rewrite <- Ropp_mult_distr_l_reverse. -rewrite <- Ropp_mult_distr_r_reverse. -rewrite (Rmult_comm (/ cos x)). -repeat rewrite Rmult_assoc. -rewrite (Rmult_comm (cos x)). -repeat rewrite Rmult_assoc. -rewrite <- Rinv_l_sym. -rewrite Rmult_1_r. -reflexivity. -assumption. -assumption. -assumption. -assumption. + forall x y:R, + cos x <> 0 -> cos y <> 0 -> tan x - tan y = sin (x - y) / (cos x * cos y). +Proof. + intros; unfold tan in |- *; rewrite sin_minus. + unfold Rdiv in |- *. + unfold Rminus in |- *. + rewrite Rmult_plus_distr_r. + rewrite Rinv_mult_distr. + repeat rewrite (Rmult_comm (sin x)). + repeat rewrite Rmult_assoc. + rewrite (Rmult_comm (cos y)). + repeat rewrite Rmult_assoc. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_r. + rewrite (Rmult_comm (sin x)). + apply Rplus_eq_compat_l. + rewrite <- Ropp_mult_distr_l_reverse. + rewrite <- Ropp_mult_distr_r_reverse. + rewrite (Rmult_comm (/ cos x)). + repeat rewrite Rmult_assoc. + rewrite (Rmult_comm (cos x)). + repeat rewrite Rmult_assoc. + rewrite <- Rinv_l_sym. + rewrite Rmult_1_r. + reflexivity. + assumption. + assumption. + assumption. + assumption. Qed. Lemma tan_increasing_0 : - forall x y:R, - - (PI / 4) <= x -> - x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> tan x < tan y -> x < y. -intros; generalize PI4_RLT_PI2; intro H4; - generalize (Ropp_lt_gt_contravar (PI / 4) (PI / 2) H4); - intro H5; change (- (PI / 2) < - (PI / 4)) in H5; - generalize - (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H) - (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)); intro HP1; - generalize - (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1) - (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)); intro HP2; - generalize - (sym_not_eq - (Rlt_not_eq 0 (cos x) - (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H) - (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)))); - intro H6; - generalize - (sym_not_eq - (Rlt_not_eq 0 (cos y) - (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1) - (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)))); - intro H7; generalize (tan_diff x y H6 H7); intro H8; - generalize (Rlt_minus (tan x) (tan y) H3); clear H3; - intro H3; rewrite H8 in H3; cut (sin (x - y) < 0). -intro H9; generalize (Ropp_le_ge_contravar (- (PI / 4)) y H1); - rewrite Ropp_involutive; intro H10; generalize (Rge_le (PI / 4) (- y) H10); - clear H10; intro H10; generalize (Ropp_le_ge_contravar y (PI / 4) H2); - intro H11; generalize (Rge_le (- y) (- (PI / 4)) H11); - clear H11; intro H11; - generalize (Rplus_le_compat (- (PI / 4)) x (- (PI / 4)) (- y) H H11); - generalize (Rplus_le_compat x (PI / 4) (- y) (PI / 4) H0 H10); - replace (x + - y) with (x - y). -replace (PI / 4 + PI / 4) with (PI / 2). -replace (- (PI / 4) + - (PI / 4)) with (- (PI / 2)). -intros; case (Rtotal_order 0 (x - y)); intro H14. -generalize - (sin_gt_0 (x - y) H14 (Rle_lt_trans (x - y) (PI / 2) PI H12 PI2_Rlt_PI)); - intro H15; elim (Rlt_irrefl 0 (Rlt_trans 0 (sin (x - y)) 0 H15 H9)). -elim H14; intro H15. -rewrite <- H15 in H9; rewrite sin_0 in H9; elim (Rlt_irrefl 0 H9). -apply Rminus_lt; assumption. -pattern PI at 1 in |- *; rewrite double_var. -unfold Rdiv in |- *. -rewrite Rmult_plus_distr_r. -repeat rewrite Rmult_assoc. -rewrite <- Rinv_mult_distr. -rewrite Ropp_plus_distr. -replace 4 with 4. -reflexivity. -ring. -discrR. -discrR. -pattern PI at 1 in |- *; rewrite double_var. -unfold Rdiv in |- *. -rewrite Rmult_plus_distr_r. -repeat rewrite Rmult_assoc. -rewrite <- Rinv_mult_distr. -replace 4 with 4. -reflexivity. -ring. -discrR. -discrR. -reflexivity. -case (Rcase_abs (sin (x - y))); intro H9. -assumption. -generalize (Rge_le (sin (x - y)) 0 H9); clear H9; intro H9; - generalize (Rinv_0_lt_compat (cos x) HP1); intro H10; - generalize (Rinv_0_lt_compat (cos y) HP2); intro H11; - generalize (Rmult_lt_0_compat (/ cos x) (/ cos y) H10 H11); - replace (/ cos x * / cos y) with (/ (cos x * cos y)). -intro H12; - generalize - (Rmult_le_pos (sin (x - y)) (/ (cos x * cos y)) H9 - (Rlt_le 0 (/ (cos x * cos y)) H12)); intro H13; - elim - (Rlt_irrefl 0 (Rle_lt_trans 0 (sin (x - y) * / (cos x * cos y)) 0 H13 H3)). -rewrite Rinv_mult_distr. -reflexivity. -assumption. -assumption. + forall x y:R, + - (PI / 4) <= x -> + x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> tan x < tan y -> x < y. +Proof. + intros; generalize PI4_RLT_PI2; intro H4; + generalize (Ropp_lt_gt_contravar (PI / 4) (PI / 2) H4); + intro H5; change (- (PI / 2) < - (PI / 4)) in H5; + generalize + (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H) + (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)); intro HP1; + generalize + (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1) + (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)); intro HP2; + generalize + (sym_not_eq + (Rlt_not_eq 0 (cos x) + (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H) + (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)))); + intro H6; + generalize + (sym_not_eq + (Rlt_not_eq 0 (cos y) + (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1) + (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)))); + intro H7; generalize (tan_diff x y H6 H7); intro H8; + generalize (Rlt_minus (tan x) (tan y) H3); clear H3; + intro H3; rewrite H8 in H3; cut (sin (x - y) < 0). + intro H9; generalize (Ropp_le_ge_contravar (- (PI / 4)) y H1); + rewrite Ropp_involutive; intro H10; generalize (Rge_le (PI / 4) (- y) H10); + clear H10; intro H10; generalize (Ropp_le_ge_contravar y (PI / 4) H2); + intro H11; generalize (Rge_le (- y) (- (PI / 4)) H11); + clear H11; intro H11; + generalize (Rplus_le_compat (- (PI / 4)) x (- (PI / 4)) (- y) H H11); + generalize (Rplus_le_compat x (PI / 4) (- y) (PI / 4) H0 H10); + replace (x + - y) with (x - y). + replace (PI / 4 + PI / 4) with (PI / 2). + replace (- (PI / 4) + - (PI / 4)) with (- (PI / 2)). + intros; case (Rtotal_order 0 (x - y)); intro H14. + generalize + (sin_gt_0 (x - y) H14 (Rle_lt_trans (x - y) (PI / 2) PI H12 PI2_Rlt_PI)); + intro H15; elim (Rlt_irrefl 0 (Rlt_trans 0 (sin (x - y)) 0 H15 H9)). + elim H14; intro H15. + rewrite <- H15 in H9; rewrite sin_0 in H9; elim (Rlt_irrefl 0 H9). + apply Rminus_lt; assumption. + pattern PI at 1 in |- *; rewrite double_var. + unfold Rdiv in |- *. + rewrite Rmult_plus_distr_r. + repeat rewrite Rmult_assoc. + rewrite <- Rinv_mult_distr. + rewrite Ropp_plus_distr. + replace 4 with 4. + reflexivity. + ring. + discrR. + discrR. + pattern PI at 1 in |- *; rewrite double_var. + unfold Rdiv in |- *. + rewrite Rmult_plus_distr_r. + repeat rewrite Rmult_assoc. + rewrite <- Rinv_mult_distr. + replace 4 with 4. + reflexivity. + ring. + discrR. + discrR. + reflexivity. + case (Rcase_abs (sin (x - y))); intro H9. + assumption. + generalize (Rge_le (sin (x - y)) 0 H9); clear H9; intro H9; + generalize (Rinv_0_lt_compat (cos x) HP1); intro H10; + generalize (Rinv_0_lt_compat (cos y) HP2); intro H11; + generalize (Rmult_lt_0_compat (/ cos x) (/ cos y) H10 H11); + replace (/ cos x * / cos y) with (/ (cos x * cos y)). + intro H12; + generalize + (Rmult_le_pos (sin (x - y)) (/ (cos x * cos y)) H9 + (Rlt_le 0 (/ (cos x * cos y)) H12)); intro H13; + elim + (Rlt_irrefl 0 (Rle_lt_trans 0 (sin (x - y) * / (cos x * cos y)) 0 H13 H3)). + rewrite Rinv_mult_distr. + reflexivity. + assumption. + assumption. Qed. Lemma tan_increasing_1 : - forall x y:R, - - (PI / 4) <= x -> - x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> x < y -> tan x < tan y. -intros; apply Rminus_lt; generalize PI4_RLT_PI2; intro H4; - generalize (Ropp_lt_gt_contravar (PI / 4) (PI / 2) H4); - intro H5; change (- (PI / 2) < - (PI / 4)) in H5; - generalize - (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H) - (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)); intro HP1; - generalize - (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1) - (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)); intro HP2; - generalize - (sym_not_eq - (Rlt_not_eq 0 (cos x) - (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H) - (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)))); - intro H6; - generalize - (sym_not_eq - (Rlt_not_eq 0 (cos y) - (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1) - (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)))); - intro H7; rewrite (tan_diff x y H6 H7); - generalize (Rinv_0_lt_compat (cos x) HP1); intro H10; - generalize (Rinv_0_lt_compat (cos y) HP2); intro H11; - generalize (Rmult_lt_0_compat (/ cos x) (/ cos y) H10 H11); - replace (/ cos x * / cos y) with (/ (cos x * cos y)). -clear H10 H11; intro H8; generalize (Ropp_le_ge_contravar y (PI / 4) H2); - intro H11; generalize (Rge_le (- y) (- (PI / 4)) H11); - clear H11; intro H11; - generalize (Rplus_le_compat (- (PI / 4)) x (- (PI / 4)) (- y) H H11); - replace (x + - y) with (x - y). -replace (- (PI / 4) + - (PI / 4)) with (- (PI / 2)). -clear H11; intro H9; generalize (Rlt_minus x y H3); clear H3; intro H3; - clear H H0 H1 H2 H4 H5 HP1 HP2; generalize PI2_Rlt_PI; - intro H1; generalize (Ropp_lt_gt_contravar (PI / 2) PI H1); - clear H1; intro H1; - generalize - (sin_lt_0_var (x - y) (Rlt_le_trans (- PI) (- (PI / 2)) (x - y) H1 H9) H3); - intro H2; - generalize - (Rmult_lt_gt_compat_neg_l (sin (x - y)) 0 (/ (cos x * cos y)) H2 H8); - rewrite Rmult_0_r; intro H4; assumption. -pattern PI at 1 in |- *; rewrite double_var. -unfold Rdiv in |- *. -rewrite Rmult_plus_distr_r. -repeat rewrite Rmult_assoc. -rewrite <- Rinv_mult_distr. -replace 4 with 4. -rewrite Ropp_plus_distr. -reflexivity. -ring. -discrR. -discrR. -reflexivity. -apply Rinv_mult_distr; assumption. + forall x y:R, + - (PI / 4) <= x -> + x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> x < y -> tan x < tan y. +Proof. + intros; apply Rminus_lt; generalize PI4_RLT_PI2; intro H4; + generalize (Ropp_lt_gt_contravar (PI / 4) (PI / 2) H4); + intro H5; change (- (PI / 2) < - (PI / 4)) in H5; + generalize + (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H) + (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)); intro HP1; + generalize + (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1) + (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)); intro HP2; + generalize + (sym_not_eq + (Rlt_not_eq 0 (cos x) + (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H) + (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)))); + intro H6; + generalize + (sym_not_eq + (Rlt_not_eq 0 (cos y) + (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1) + (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)))); + intro H7; rewrite (tan_diff x y H6 H7); + generalize (Rinv_0_lt_compat (cos x) HP1); intro H10; + generalize (Rinv_0_lt_compat (cos y) HP2); intro H11; + generalize (Rmult_lt_0_compat (/ cos x) (/ cos y) H10 H11); + replace (/ cos x * / cos y) with (/ (cos x * cos y)). + clear H10 H11; intro H8; generalize (Ropp_le_ge_contravar y (PI / 4) H2); + intro H11; generalize (Rge_le (- y) (- (PI / 4)) H11); + clear H11; intro H11; + generalize (Rplus_le_compat (- (PI / 4)) x (- (PI / 4)) (- y) H H11); + replace (x + - y) with (x - y). + replace (- (PI / 4) + - (PI / 4)) with (- (PI / 2)). + clear H11; intro H9; generalize (Rlt_minus x y H3); clear H3; intro H3; + clear H H0 H1 H2 H4 H5 HP1 HP2; generalize PI2_Rlt_PI; + intro H1; generalize (Ropp_lt_gt_contravar (PI / 2) PI H1); + clear H1; intro H1; + generalize + (sin_lt_0_var (x - y) (Rlt_le_trans (- PI) (- (PI / 2)) (x - y) H1 H9) H3); + intro H2; + generalize + (Rmult_lt_gt_compat_neg_l (sin (x - y)) 0 (/ (cos x * cos y)) H2 H8); + rewrite Rmult_0_r; intro H4; assumption. + pattern PI at 1 in |- *; rewrite double_var. + unfold Rdiv in |- *. + rewrite Rmult_plus_distr_r. + repeat rewrite Rmult_assoc. + rewrite <- Rinv_mult_distr. + replace 4 with 4. + rewrite Ropp_plus_distr. + reflexivity. + ring. + discrR. + discrR. + reflexivity. + apply Rinv_mult_distr; assumption. Qed. Lemma sin_incr_0 : - forall x y:R, - - (PI / 2) <= x -> - x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> sin x <= sin y -> x <= y. -intros; case (Rtotal_order (sin x) (sin y)); intro H4; - [ left; apply (sin_increasing_0 x y H H0 H1 H2 H4) - | elim H4; intro H5; - [ case (Rtotal_order x y); intro H6; - [ left; assumption - | elim H6; intro H7; - [ right; assumption - | generalize (sin_increasing_1 y x H1 H2 H H0 H7); intro H8; - rewrite H5 in H8; elim (Rlt_irrefl (sin y) H8) ] ] - | elim (Rlt_irrefl (sin x) (Rle_lt_trans (sin x) (sin y) (sin x) H3 H5)) ] ]. + forall x y:R, + - (PI / 2) <= x -> + x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> sin x <= sin y -> x <= y. +Proof. + intros; case (Rtotal_order (sin x) (sin y)); intro H4; + [ left; apply (sin_increasing_0 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order x y); intro H6; + [ left; assumption + | elim H6; intro H7; + [ right; assumption + | generalize (sin_increasing_1 y x H1 H2 H H0 H7); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl (sin y) H8) ] ] + | elim (Rlt_irrefl (sin x) (Rle_lt_trans (sin x) (sin y) (sin x) H3 H5)) ] ]. Qed. Lemma sin_incr_1 : - forall x y:R, - - (PI / 2) <= x -> - x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> x <= y -> sin x <= sin y. -intros; case (Rtotal_order x y); intro H4; - [ left; apply (sin_increasing_1 x y H H0 H1 H2 H4) - | elim H4; intro H5; - [ case (Rtotal_order (sin x) (sin y)); intro H6; - [ left; assumption - | elim H6; intro H7; - [ right; assumption - | generalize (sin_increasing_0 y x H1 H2 H H0 H7); intro H8; - rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ] - | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ]. + forall x y:R, + - (PI / 2) <= x -> + x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> x <= y -> sin x <= sin y. +Proof. + intros; case (Rtotal_order x y); intro H4; + [ left; apply (sin_increasing_1 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order (sin x) (sin y)); intro H6; + [ left; assumption + | elim H6; intro H7; + [ right; assumption + | generalize (sin_increasing_0 y x H1 H2 H H0 H7); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ] + | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ]. Qed. Lemma sin_decr_0 : - forall x y:R, - x <= 3 * (PI / 2) -> - PI / 2 <= x -> - y <= 3 * (PI / 2) -> PI / 2 <= y -> sin x <= sin y -> y <= x. -intros; case (Rtotal_order (sin x) (sin y)); intro H4; - [ left; apply (sin_decreasing_0 x y H H0 H1 H2 H4) - | elim H4; intro H5; - [ case (Rtotal_order x y); intro H6; - [ generalize (sin_decreasing_1 x y H H0 H1 H2 H6); intro H8; - rewrite H5 in H8; elim (Rlt_irrefl (sin y) H8) - | elim H6; intro H7; - [ right; symmetry in |- *; assumption | left; assumption ] ] - | elim (Rlt_irrefl (sin x) (Rle_lt_trans (sin x) (sin y) (sin x) H3 H5)) ] ]. + forall x y:R, + x <= 3 * (PI / 2) -> + PI / 2 <= x -> + y <= 3 * (PI / 2) -> PI / 2 <= y -> sin x <= sin y -> y <= x. +Proof. + intros; case (Rtotal_order (sin x) (sin y)); intro H4; + [ left; apply (sin_decreasing_0 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order x y); intro H6; + [ generalize (sin_decreasing_1 x y H H0 H1 H2 H6); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl (sin y) H8) + | elim H6; intro H7; + [ right; symmetry in |- *; assumption | left; assumption ] ] + | elim (Rlt_irrefl (sin x) (Rle_lt_trans (sin x) (sin y) (sin x) H3 H5)) ] ]. Qed. Lemma sin_decr_1 : - forall x y:R, - x <= 3 * (PI / 2) -> - PI / 2 <= x -> - y <= 3 * (PI / 2) -> PI / 2 <= y -> x <= y -> sin y <= sin x. -intros; case (Rtotal_order x y); intro H4; - [ left; apply (sin_decreasing_1 x y H H0 H1 H2 H4) - | elim H4; intro H5; - [ case (Rtotal_order (sin x) (sin y)); intro H6; - [ generalize (sin_decreasing_0 x y H H0 H1 H2 H6); intro H8; - rewrite H5 in H8; elim (Rlt_irrefl y H8) - | elim H6; intro H7; - [ right; symmetry in |- *; assumption | left; assumption ] ] - | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ]. + forall x y:R, + x <= 3 * (PI / 2) -> + PI / 2 <= x -> + y <= 3 * (PI / 2) -> PI / 2 <= y -> x <= y -> sin y <= sin x. +Proof. + intros; case (Rtotal_order x y); intro H4; + [ left; apply (sin_decreasing_1 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order (sin x) (sin y)); intro H6; + [ generalize (sin_decreasing_0 x y H H0 H1 H2 H6); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl y H8) + | elim H6; intro H7; + [ right; symmetry in |- *; assumption | left; assumption ] ] + | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ]. Qed. Lemma cos_incr_0 : - forall x y:R, - PI <= x -> - x <= 2 * PI -> PI <= y -> y <= 2 * PI -> cos x <= cos y -> x <= y. -intros; case (Rtotal_order (cos x) (cos y)); intro H4; - [ left; apply (cos_increasing_0 x y H H0 H1 H2 H4) - | elim H4; intro H5; - [ case (Rtotal_order x y); intro H6; - [ left; assumption - | elim H6; intro H7; - [ right; assumption - | generalize (cos_increasing_1 y x H1 H2 H H0 H7); intro H8; - rewrite H5 in H8; elim (Rlt_irrefl (cos y) H8) ] ] - | elim (Rlt_irrefl (cos x) (Rle_lt_trans (cos x) (cos y) (cos x) H3 H5)) ] ]. + forall x y:R, + PI <= x -> + x <= 2 * PI -> PI <= y -> y <= 2 * PI -> cos x <= cos y -> x <= y. +Proof. + intros; case (Rtotal_order (cos x) (cos y)); intro H4; + [ left; apply (cos_increasing_0 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order x y); intro H6; + [ left; assumption + | elim H6; intro H7; + [ right; assumption + | generalize (cos_increasing_1 y x H1 H2 H H0 H7); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl (cos y) H8) ] ] + | elim (Rlt_irrefl (cos x) (Rle_lt_trans (cos x) (cos y) (cos x) H3 H5)) ] ]. Qed. Lemma cos_incr_1 : - forall x y:R, - PI <= x -> - x <= 2 * PI -> PI <= y -> y <= 2 * PI -> x <= y -> cos x <= cos y. -intros; case (Rtotal_order x y); intro H4; - [ left; apply (cos_increasing_1 x y H H0 H1 H2 H4) - | elim H4; intro H5; - [ case (Rtotal_order (cos x) (cos y)); intro H6; - [ left; assumption - | elim H6; intro H7; - [ right; assumption - | generalize (cos_increasing_0 y x H1 H2 H H0 H7); intro H8; - rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ] - | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ]. + forall x y:R, + PI <= x -> + x <= 2 * PI -> PI <= y -> y <= 2 * PI -> x <= y -> cos x <= cos y. +Proof. + intros; case (Rtotal_order x y); intro H4; + [ left; apply (cos_increasing_1 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order (cos x) (cos y)); intro H6; + [ left; assumption + | elim H6; intro H7; + [ right; assumption + | generalize (cos_increasing_0 y x H1 H2 H H0 H7); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ] + | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ]. Qed. Lemma cos_decr_0 : - forall x y:R, - 0 <= x -> x <= PI -> 0 <= y -> y <= PI -> cos x <= cos y -> y <= x. -intros; case (Rtotal_order (cos x) (cos y)); intro H4; - [ left; apply (cos_decreasing_0 x y H H0 H1 H2 H4) - | elim H4; intro H5; - [ case (Rtotal_order x y); intro H6; - [ generalize (cos_decreasing_1 x y H H0 H1 H2 H6); intro H8; - rewrite H5 in H8; elim (Rlt_irrefl (cos y) H8) - | elim H6; intro H7; - [ right; symmetry in |- *; assumption | left; assumption ] ] - | elim (Rlt_irrefl (cos x) (Rle_lt_trans (cos x) (cos y) (cos x) H3 H5)) ] ]. + forall x y:R, + 0 <= x -> x <= PI -> 0 <= y -> y <= PI -> cos x <= cos y -> y <= x. +Proof. + intros; case (Rtotal_order (cos x) (cos y)); intro H4; + [ left; apply (cos_decreasing_0 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order x y); intro H6; + [ generalize (cos_decreasing_1 x y H H0 H1 H2 H6); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl (cos y) H8) + | elim H6; intro H7; + [ right; symmetry in |- *; assumption | left; assumption ] ] + | elim (Rlt_irrefl (cos x) (Rle_lt_trans (cos x) (cos y) (cos x) H3 H5)) ] ]. Qed. Lemma cos_decr_1 : - forall x y:R, - 0 <= x -> x <= PI -> 0 <= y -> y <= PI -> x <= y -> cos y <= cos x. -intros; case (Rtotal_order x y); intro H4; - [ left; apply (cos_decreasing_1 x y H H0 H1 H2 H4) - | elim H4; intro H5; - [ case (Rtotal_order (cos x) (cos y)); intro H6; - [ generalize (cos_decreasing_0 x y H H0 H1 H2 H6); intro H8; - rewrite H5 in H8; elim (Rlt_irrefl y H8) - | elim H6; intro H7; - [ right; symmetry in |- *; assumption | left; assumption ] ] - | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ]. + forall x y:R, + 0 <= x -> x <= PI -> 0 <= y -> y <= PI -> x <= y -> cos y <= cos x. +Proof. + intros; case (Rtotal_order x y); intro H4; + [ left; apply (cos_decreasing_1 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order (cos x) (cos y)); intro H6; + [ generalize (cos_decreasing_0 x y H H0 H1 H2 H6); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl y H8) + | elim H6; intro H7; + [ right; symmetry in |- *; assumption | left; assumption ] ] + | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ]. Qed. Lemma tan_incr_0 : - forall x y:R, - - (PI / 4) <= x -> - x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> tan x <= tan y -> x <= y. -intros; case (Rtotal_order (tan x) (tan y)); intro H4; - [ left; apply (tan_increasing_0 x y H H0 H1 H2 H4) - | elim H4; intro H5; - [ case (Rtotal_order x y); intro H6; - [ left; assumption - | elim H6; intro H7; - [ right; assumption - | generalize (tan_increasing_1 y x H1 H2 H H0 H7); intro H8; - rewrite H5 in H8; elim (Rlt_irrefl (tan y) H8) ] ] - | elim (Rlt_irrefl (tan x) (Rle_lt_trans (tan x) (tan y) (tan x) H3 H5)) ] ]. + forall x y:R, + - (PI / 4) <= x -> + x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> tan x <= tan y -> x <= y. +Proof. + intros; case (Rtotal_order (tan x) (tan y)); intro H4; + [ left; apply (tan_increasing_0 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order x y); intro H6; + [ left; assumption + | elim H6; intro H7; + [ right; assumption + | generalize (tan_increasing_1 y x H1 H2 H H0 H7); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl (tan y) H8) ] ] + | elim (Rlt_irrefl (tan x) (Rle_lt_trans (tan x) (tan y) (tan x) H3 H5)) ] ]. Qed. Lemma tan_incr_1 : - forall x y:R, - - (PI / 4) <= x -> - x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> x <= y -> tan x <= tan y. -intros; case (Rtotal_order x y); intro H4; - [ left; apply (tan_increasing_1 x y H H0 H1 H2 H4) - | elim H4; intro H5; - [ case (Rtotal_order (tan x) (tan y)); intro H6; - [ left; assumption - | elim H6; intro H7; - [ right; assumption - | generalize (tan_increasing_0 y x H1 H2 H H0 H7); intro H8; - rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ] - | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ]. + forall x y:R, + - (PI / 4) <= x -> + x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> x <= y -> tan x <= tan y. +Proof. + intros; case (Rtotal_order x y); intro H4; + [ left; apply (tan_increasing_1 x y H H0 H1 H2 H4) + | elim H4; intro H5; + [ case (Rtotal_order (tan x) (tan y)); intro H6; + [ left; assumption + | elim H6; intro H7; + [ right; assumption + | generalize (tan_increasing_0 y x H1 H2 H H0 H7); intro H8; + rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ] + | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ]. Qed. (**********) Lemma sin_eq_0_1 : forall x:R, (exists k : Z, x = IZR k * PI) -> sin x = 0. -intros. -elim H; intros. -apply (Zcase_sign x0). -intro. -rewrite H1 in H0. -simpl in H0. -rewrite H0; rewrite Rmult_0_l; apply sin_0. -intro. -cut (0 <= x0)%Z. -intro. -elim (IZN x0 H2); intros. -rewrite H3 in H0. -rewrite <- INR_IZR_INZ in H0. -rewrite H0. -elim (even_odd_cor x1); intros. -elim H4; intro. -rewrite H5. -rewrite mult_INR. -simpl in |- *. -rewrite <- (Rplus_0_l (2 * INR x2 * PI)). -rewrite sin_period. -apply sin_0. -rewrite H5. -rewrite S_INR; rewrite mult_INR. -simpl in |- *. -rewrite Rmult_plus_distr_r. -rewrite Rmult_1_l; rewrite sin_plus. -rewrite sin_PI. -rewrite Rmult_0_r. -rewrite <- (Rplus_0_l (2 * INR x2 * PI)). -rewrite sin_period. -rewrite sin_0; ring. -apply le_IZR. -left; apply IZR_lt. -assert (H2 := Zorder.Zgt_iff_lt). -elim (H2 x0 0%Z); intros. -apply H3; assumption. -intro. -rewrite H0. -replace (sin (IZR x0 * PI)) with (- sin (- IZR x0 * PI)). -cut (0 <= - x0)%Z. -intro. -rewrite <- Ropp_Ropp_IZR. -elim (IZN (- x0) H2); intros. -rewrite H3. -rewrite <- INR_IZR_INZ. -elim (even_odd_cor x1); intros. -elim H4; intro. -rewrite H5. -rewrite mult_INR. -simpl in |- *. -rewrite <- (Rplus_0_l (2 * INR x2 * PI)). -rewrite sin_period. -rewrite sin_0; ring. -rewrite H5. -rewrite S_INR; rewrite mult_INR. -simpl in |- *. -rewrite Rmult_plus_distr_r. -rewrite Rmult_1_l; rewrite sin_plus. -rewrite sin_PI. -rewrite Rmult_0_r. -rewrite <- (Rplus_0_l (2 * INR x2 * PI)). -rewrite sin_period. -rewrite sin_0; ring. -apply le_IZR. -apply Rplus_le_reg_l with (IZR x0). -rewrite Rplus_0_r. -rewrite Ropp_Ropp_IZR. -rewrite Rplus_opp_r. -left; replace 0 with (IZR 0); [ apply IZR_lt | reflexivity ]. -assumption. -rewrite <- sin_neg. -rewrite Ropp_mult_distr_l_reverse. -rewrite Ropp_involutive. -reflexivity. +Proof. + intros. + elim H; intros. + apply (Zcase_sign x0). + intro. + rewrite H1 in H0. + simpl in H0. + rewrite H0; rewrite Rmult_0_l; apply sin_0. + intro. + cut (0 <= x0)%Z. + intro. + elim (IZN x0 H2); intros. + rewrite H3 in H0. + rewrite <- INR_IZR_INZ in H0. + rewrite H0. + elim (even_odd_cor x1); intros. + elim H4; intro. + rewrite H5. + rewrite mult_INR. + simpl in |- *. + rewrite <- (Rplus_0_l (2 * INR x2 * PI)). + rewrite sin_period. + apply sin_0. + rewrite H5. + rewrite S_INR; rewrite mult_INR. + simpl in |- *. + rewrite Rmult_plus_distr_r. + rewrite Rmult_1_l; rewrite sin_plus. + rewrite sin_PI. + rewrite Rmult_0_r. + rewrite <- (Rplus_0_l (2 * INR x2 * PI)). + rewrite sin_period. + rewrite sin_0; ring. + apply le_IZR. + left; apply IZR_lt. + assert (H2 := Zorder.Zgt_iff_lt). + elim (H2 x0 0%Z); intros. + apply H3; assumption. + intro. + rewrite H0. + replace (sin (IZR x0 * PI)) with (- sin (- IZR x0 * PI)). + cut (0 <= - x0)%Z. + intro. + rewrite <- Ropp_Ropp_IZR. + elim (IZN (- x0) H2); intros. + rewrite H3. + rewrite <- INR_IZR_INZ. + elim (even_odd_cor x1); intros. + elim H4; intro. + rewrite H5. + rewrite mult_INR. + simpl in |- *. + rewrite <- (Rplus_0_l (2 * INR x2 * PI)). + rewrite sin_period. + rewrite sin_0; ring. + rewrite H5. + rewrite S_INR; rewrite mult_INR. + simpl in |- *. + rewrite Rmult_plus_distr_r. + rewrite Rmult_1_l; rewrite sin_plus. + rewrite sin_PI. + rewrite Rmult_0_r. + rewrite <- (Rplus_0_l (2 * INR x2 * PI)). + rewrite sin_period. + rewrite sin_0; ring. + apply le_IZR. + apply Rplus_le_reg_l with (IZR x0). + rewrite Rplus_0_r. + rewrite Ropp_Ropp_IZR. + rewrite Rplus_opp_r. + left; replace 0 with (IZR 0); [ apply IZR_lt | reflexivity ]. + assumption. + rewrite <- sin_neg. + rewrite Ropp_mult_distr_l_reverse. + rewrite Ropp_involutive. + reflexivity. Qed. Lemma sin_eq_0_0 : forall x:R, sin x = 0 -> exists k : Z, x = IZR k * PI. -intros. -assert (H0 := euclidian_division x PI PI_neq0). -elim H0; intros q H1. -elim H1; intros r H2. -exists q. -cut (r = 0). -intro. -elim H2; intros H4 _; rewrite H4; rewrite H3. -apply Rplus_0_r. -elim H2; intros. -rewrite H3 in H. -rewrite sin_plus in H. -cut (sin (IZR q * PI) = 0). -intro. -rewrite H5 in H. -rewrite Rmult_0_l in H. -rewrite Rplus_0_l in H. -assert (H6 := Rmult_integral _ _ H). -elim H6; intro. -assert (H8 := sin2_cos2 (IZR q * PI)). -rewrite H5 in H8; rewrite H7 in H8. -rewrite Rsqr_0 in H8. -rewrite Rplus_0_r in H8. -elim R1_neq_R0; symmetry in |- *; assumption. -cut (r = 0 \/ 0 < r < PI). -intro; elim H8; intro. -assumption. -elim H9; intros. -assert (H12 := sin_gt_0 _ H10 H11). -rewrite H7 in H12; elim (Rlt_irrefl _ H12). -rewrite Rabs_right in H4. -elim H4; intros. -case (Rtotal_order 0 r); intro. -right; split; assumption. -elim H10; intro. -left; symmetry in |- *; assumption. -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H8 H11)). -apply Rle_ge. -left; apply PI_RGT_0. -apply sin_eq_0_1. -exists q; reflexivity. +Proof. + intros. + assert (H0 := euclidian_division x PI PI_neq0). + elim H0; intros q H1. + elim H1; intros r H2. + exists q. + cut (r = 0). + intro. + elim H2; intros H4 _; rewrite H4; rewrite H3. + apply Rplus_0_r. + elim H2; intros. + rewrite H3 in H. + rewrite sin_plus in H. + cut (sin (IZR q * PI) = 0). + intro. + rewrite H5 in H. + rewrite Rmult_0_l in H. + rewrite Rplus_0_l in H. + assert (H6 := Rmult_integral _ _ H). + elim H6; intro. + assert (H8 := sin2_cos2 (IZR q * PI)). + rewrite H5 in H8; rewrite H7 in H8. + rewrite Rsqr_0 in H8. + rewrite Rplus_0_r in H8. + elim R1_neq_R0; symmetry in |- *; assumption. + cut (r = 0 \/ 0 < r < PI). + intro; elim H8; intro. + assumption. + elim H9; intros. + assert (H12 := sin_gt_0 _ H10 H11). + rewrite H7 in H12; elim (Rlt_irrefl _ H12). + rewrite Rabs_right in H4. + elim H4; intros. + case (Rtotal_order 0 r); intro. + right; split; assumption. + elim H10; intro. + left; symmetry in |- *; assumption. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H8 H11)). + apply Rle_ge. + left; apply PI_RGT_0. + apply sin_eq_0_1. + exists q; reflexivity. Qed. Lemma cos_eq_0_0 : - forall x:R, cos x = 0 -> exists k : Z, x = IZR k * PI + PI / 2. -intros x H; rewrite cos_sin in H; generalize (sin_eq_0_0 (PI / INR 2 + x) H); - intro H2; elim H2; intros x0 H3; exists (x0 - Z_of_nat 1)%Z; - rewrite <- Z_R_minus; ring; rewrite Rmult_comm; rewrite <- H3; - unfold INR in |- *. -rewrite (double_var (- PI)); unfold Rdiv in |- *; ring. + forall x:R, cos x = 0 -> exists k : Z, x = IZR k * PI + PI / 2. +Proof. + intros x H; rewrite cos_sin in H; generalize (sin_eq_0_0 (PI / INR 2 + x) H); + intro H2; elim H2; intros x0 H3; exists (x0 - Z_of_nat 1)%Z; + rewrite <- Z_R_minus; simpl; ring_simplify; +(* rewrite (Rmult_comm PI);*) (* old ring compat *) + rewrite <- H3; simpl; + field; repeat split; discrR. Qed. Lemma cos_eq_0_1 : - forall x:R, (exists k : Z, x = IZR k * PI + PI / 2) -> cos x = 0. -intros x H1; rewrite cos_sin; elim H1; intros x0 H2; rewrite H2; - replace (PI / 2 + (IZR x0 * PI + PI / 2)) with (IZR x0 * PI + PI). -rewrite neg_sin; rewrite <- Ropp_0. -apply Ropp_eq_compat; apply sin_eq_0_1; exists x0; reflexivity. -pattern PI at 2 in |- *; rewrite (double_var PI); ring. + forall x:R, (exists k : Z, x = IZR k * PI + PI / 2) -> cos x = 0. +Proof. + intros x H1; rewrite cos_sin; elim H1; intros x0 H2; rewrite H2; + replace (PI / 2 + (IZR x0 * PI + PI / 2)) with (IZR x0 * PI + PI). + rewrite neg_sin; rewrite <- Ropp_0. + apply Ropp_eq_compat; apply sin_eq_0_1; exists x0; reflexivity. + pattern PI at 2 in |- *; rewrite (double_var PI); ring. Qed. Lemma sin_eq_O_2PI_0 : - forall x:R, - 0 <= x -> x <= 2 * PI -> sin x = 0 -> x = 0 \/ x = PI \/ x = 2 * PI. -intros; generalize (sin_eq_0_0 x H1); intro. -elim H2; intros k0 H3. -case (Rtotal_order PI x); intro. -rewrite H3 in H4; rewrite H3 in H0. -right; right. -generalize - (Rmult_lt_compat_r (/ PI) PI (IZR k0 * PI) (Rinv_0_lt_compat PI PI_RGT_0) H4); - rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym. -rewrite Rmult_1_r; intro; - generalize - (Rmult_le_compat_r (/ PI) (IZR k0 * PI) (2 * PI) - (Rlt_le 0 (/ PI) (Rinv_0_lt_compat PI PI_RGT_0)) H0); - repeat rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym. -repeat rewrite Rmult_1_r; intro; - generalize (Rplus_lt_compat_l (IZR (-2)) 1 (IZR k0) H5); - rewrite <- plus_IZR. -replace (IZR (-2) + 1) with (-1). -intro; generalize (Rplus_le_compat_l (IZR (-2)) (IZR k0) 2 H6); - rewrite <- plus_IZR. -replace (IZR (-2) + 2) with 0. -intro; cut (-1 < IZR (-2 + k0) < 1). -intro; generalize (one_IZR_lt1 (-2 + k0) H9); intro. -cut (k0 = 2%Z). -intro; rewrite H11 in H3; rewrite H3; simpl in |- *. -reflexivity. -rewrite <- (Zplus_opp_l 2) in H10; generalize (Zplus_reg_l (-2) k0 2 H10); - intro; assumption. -split. -assumption. -apply Rle_lt_trans with 0. -assumption. -apply Rlt_0_1. -simpl in |- *; ring. -simpl in |- *; ring. -apply PI_neq0. -apply PI_neq0. -elim H4; intro. -right; left. -symmetry in |- *; assumption. -left. -rewrite H3 in H5; rewrite H3 in H; - generalize - (Rmult_lt_compat_r (/ PI) (IZR k0 * PI) PI (Rinv_0_lt_compat PI PI_RGT_0) - H5); rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym. -rewrite Rmult_1_r; intro; - generalize - (Rmult_le_compat_r (/ PI) 0 (IZR k0 * PI) - (Rlt_le 0 (/ PI) (Rinv_0_lt_compat PI PI_RGT_0)) H); - repeat rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym. -rewrite Rmult_1_r; rewrite Rmult_0_l; intro. -cut (-1 < IZR k0 < 1). -intro; generalize (one_IZR_lt1 k0 H8); intro; rewrite H9 in H3; rewrite H3; - simpl in |- *; apply Rmult_0_l. -split. -apply Rlt_le_trans with 0. -rewrite <- Ropp_0; apply Ropp_gt_lt_contravar; apply Rlt_0_1. -assumption. -assumption. -apply PI_neq0. -apply PI_neq0. + forall x:R, + 0 <= x -> x <= 2 * PI -> sin x = 0 -> x = 0 \/ x = PI \/ x = 2 * PI. +Proof. + intros; generalize (sin_eq_0_0 x H1); intro. + elim H2; intros k0 H3. + case (Rtotal_order PI x); intro. + rewrite H3 in H4; rewrite H3 in H0. + right; right. + generalize + (Rmult_lt_compat_r (/ PI) PI (IZR k0 * PI) (Rinv_0_lt_compat PI PI_RGT_0) H4); + rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym. + rewrite Rmult_1_r; intro; + generalize + (Rmult_le_compat_r (/ PI) (IZR k0 * PI) (2 * PI) + (Rlt_le 0 (/ PI) (Rinv_0_lt_compat PI PI_RGT_0)) H0); + repeat rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym. + repeat rewrite Rmult_1_r; intro; + generalize (Rplus_lt_compat_l (IZR (-2)) 1 (IZR k0) H5); + rewrite <- plus_IZR. + replace (IZR (-2) + 1) with (-1). + intro; generalize (Rplus_le_compat_l (IZR (-2)) (IZR k0) 2 H6); + rewrite <- plus_IZR. + replace (IZR (-2) + 2) with 0. + intro; cut (-1 < IZR (-2 + k0) < 1). + intro; generalize (one_IZR_lt1 (-2 + k0) H9); intro. + cut (k0 = 2%Z). + intro; rewrite H11 in H3; rewrite H3; simpl in |- *. + reflexivity. + rewrite <- (Zplus_opp_l 2) in H10; generalize (Zplus_reg_l (-2) k0 2 H10); + intro; assumption. + split. + assumption. + apply Rle_lt_trans with 0. + assumption. + apply Rlt_0_1. + simpl in |- *; ring. + simpl in |- *; ring. + apply PI_neq0. + apply PI_neq0. + elim H4; intro. + right; left. + symmetry in |- *; assumption. + left. + rewrite H3 in H5; rewrite H3 in H; + generalize + (Rmult_lt_compat_r (/ PI) (IZR k0 * PI) PI (Rinv_0_lt_compat PI PI_RGT_0) + H5); rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym. + rewrite Rmult_1_r; intro; + generalize + (Rmult_le_compat_r (/ PI) 0 (IZR k0 * PI) + (Rlt_le 0 (/ PI) (Rinv_0_lt_compat PI PI_RGT_0)) H); + repeat rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym. + rewrite Rmult_1_r; rewrite Rmult_0_l; intro. + cut (-1 < IZR k0 < 1). + intro; generalize (one_IZR_lt1 k0 H8); intro; rewrite H9 in H3; rewrite H3; + simpl in |- *; apply Rmult_0_l. + split. + apply Rlt_le_trans with 0. + rewrite <- Ropp_0; apply Ropp_gt_lt_contravar; apply Rlt_0_1. + assumption. + assumption. + apply PI_neq0. + apply PI_neq0. Qed. Lemma sin_eq_O_2PI_1 : - forall x:R, - 0 <= x -> x <= 2 * PI -> x = 0 \/ x = PI \/ x = 2 * PI -> sin x = 0. -intros x H1 H2 H3; elim H3; intro H4; - [ rewrite H4; rewrite sin_0; reflexivity - | elim H4; intro H5; - [ rewrite H5; rewrite sin_PI; reflexivity - | rewrite H5; rewrite sin_2PI; reflexivity ] ]. + forall x:R, + 0 <= x -> x <= 2 * PI -> x = 0 \/ x = PI \/ x = 2 * PI -> sin x = 0. +Proof. + intros x H1 H2 H3; elim H3; intro H4; + [ rewrite H4; rewrite sin_0; reflexivity + | elim H4; intro H5; + [ rewrite H5; rewrite sin_PI; reflexivity + | rewrite H5; rewrite sin_2PI; reflexivity ] ]. Qed. Lemma cos_eq_0_2PI_0 : - forall x:R, - 0 <= x -> x <= 2 * PI -> cos x = 0 -> x = PI / 2 \/ x = 3 * (PI / 2). -intros; case (Rtotal_order x (3 * (PI / 2))); intro. -rewrite cos_sin in H1. -cut (0 <= PI / 2 + x). -cut (PI / 2 + x <= 2 * PI). -intros; generalize (sin_eq_O_2PI_0 (PI / 2 + x) H4 H3 H1); intros. -decompose [or] H5. -generalize (Rplus_le_compat_l (PI / 2) 0 x H); rewrite Rplus_0_r; rewrite H6; - intro. -elim (Rlt_irrefl 0 (Rlt_le_trans 0 (PI / 2) 0 PI2_RGT_0 H7)). -left. -generalize (Rplus_eq_compat_l (- (PI / 2)) (PI / 2 + x) PI H7). -replace (- (PI / 2) + (PI / 2 + x)) with x. -replace (- (PI / 2) + PI) with (PI / 2). -intro; assumption. -pattern PI at 3 in |- *; rewrite (double_var PI); ring. -ring. -right. -generalize (Rplus_eq_compat_l (- (PI / 2)) (PI / 2 + x) (2 * PI) H7). -replace (- (PI / 2) + (PI / 2 + x)) with x. -replace (- (PI / 2) + 2 * PI) with (3 * (PI / 2)). -intro; assumption. -rewrite double; pattern PI at 3 4 in |- *; rewrite (double_var PI); ring. -ring. -left; replace (2 * PI) with (PI / 2 + 3 * (PI / 2)). -apply Rplus_lt_compat_l; assumption. -rewrite (double PI); pattern PI at 3 4 in |- *; rewrite (double_var PI); ring. -apply Rplus_le_le_0_compat. -left; unfold Rdiv in |- *; apply Rmult_lt_0_compat. -apply PI_RGT_0. -apply Rinv_0_lt_compat; prove_sup0. -assumption. -elim H2; intro. -right; assumption. -generalize (cos_eq_0_0 x H1); intro; elim H4; intros k0 H5. -rewrite H5 in H3; rewrite H5 in H0; - generalize - (Rplus_lt_compat_l (- (PI / 2)) (3 * (PI / 2)) (IZR k0 * PI + PI / 2) H3); - generalize - (Rplus_le_compat_l (- (PI / 2)) (IZR k0 * PI + PI / 2) (2 * PI) H0). -replace (- (PI / 2) + 3 * (PI / 2)) with PI. -replace (- (PI / 2) + (IZR k0 * PI + PI / 2)) with (IZR k0 * PI). -replace (- (PI / 2) + 2 * PI) with (3 * (PI / 2)). -intros; - generalize - (Rmult_lt_compat_l (/ PI) PI (IZR k0 * PI) (Rinv_0_lt_compat PI PI_RGT_0) - H7); - generalize - (Rmult_le_compat_l (/ PI) (IZR k0 * PI) (3 * (PI / 2)) - (Rlt_le 0 (/ PI) (Rinv_0_lt_compat PI PI_RGT_0)) H6). -replace (/ PI * (IZR k0 * PI)) with (IZR k0). -replace (/ PI * (3 * (PI / 2))) with (3 * / 2). -rewrite <- Rinv_l_sym. -intros; generalize (Rplus_lt_compat_l (IZR (-2)) 1 (IZR k0) H9); - rewrite <- plus_IZR. -replace (IZR (-2) + 1) with (-1). -intro; generalize (Rplus_le_compat_l (IZR (-2)) (IZR k0) (3 * / 2) H8); - rewrite <- plus_IZR. -replace (IZR (-2) + 2) with 0. -intro; cut (-1 < IZR (-2 + k0) < 1). -intro; generalize (one_IZR_lt1 (-2 + k0) H12); intro. -cut (k0 = 2%Z). -intro; rewrite H14 in H8. -assert (Hyp : 0 < 2). -prove_sup0. -generalize (Rmult_le_compat_l 2 (IZR 2) (3 * / 2) (Rlt_le 0 2 Hyp) H8); - simpl in |- *. -replace 4 with 4. -replace (2 * (3 * / 2)) with 3. -intro; cut (3 < 4). -intro; elim (Rlt_irrefl 3 (Rlt_le_trans 3 4 3 H16 H15)). -generalize (Rplus_lt_compat_l 3 0 1 Rlt_0_1); rewrite Rplus_0_r. -replace (3 + 1) with 4. -intro; assumption. -ring. -symmetry in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m. -discrR. -ring. -rewrite <- (Zplus_opp_l 2) in H13; generalize (Zplus_reg_l (-2) k0 2 H13); - intro; assumption. -split. -assumption. -apply Rle_lt_trans with (IZR (-2) + 3 * / 2). -assumption. -simpl in |- *; replace (-2 + 3 * / 2) with (- (1 * / 2)). -apply Rlt_trans with 0. -rewrite <- Ropp_0; apply Ropp_lt_gt_contravar. -apply Rmult_lt_0_compat; - [ apply Rlt_0_1 | apply Rinv_0_lt_compat; prove_sup0 ]. -apply Rlt_0_1. -rewrite Rmult_1_l; apply Rmult_eq_reg_l with 2. -rewrite Ropp_mult_distr_r_reverse; rewrite <- Rinv_r_sym. -rewrite Rmult_plus_distr_l; rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m. -ring. -discrR. -discrR. -discrR. -simpl in |- *; ring. -simpl in |- *; ring. -apply PI_neq0. -unfold Rdiv in |- *; pattern 3 at 1 in |- *; rewrite (Rmult_comm 3); - repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_l; apply Rmult_comm. -apply PI_neq0. -symmetry in |- *; rewrite (Rmult_comm (/ PI)); rewrite Rmult_assoc; - rewrite <- Rinv_r_sym. -apply Rmult_1_r. -apply PI_neq0. -rewrite double; pattern PI at 3 4 in |- *; rewrite double_var; ring. -ring. -pattern PI at 1 in |- *; rewrite double_var; ring. + forall x:R, + 0 <= x -> x <= 2 * PI -> cos x = 0 -> x = PI / 2 \/ x = 3 * (PI / 2). +Proof. + intros; case (Rtotal_order x (3 * (PI / 2))); intro. + rewrite cos_sin in H1. + cut (0 <= PI / 2 + x). + cut (PI / 2 + x <= 2 * PI). + intros; generalize (sin_eq_O_2PI_0 (PI / 2 + x) H4 H3 H1); intros. + decompose [or] H5. + generalize (Rplus_le_compat_l (PI / 2) 0 x H); rewrite Rplus_0_r; rewrite H6; + intro. + elim (Rlt_irrefl 0 (Rlt_le_trans 0 (PI / 2) 0 PI2_RGT_0 H7)). + left. + generalize (Rplus_eq_compat_l (- (PI / 2)) (PI / 2 + x) PI H7). + replace (- (PI / 2) + (PI / 2 + x)) with x. + replace (- (PI / 2) + PI) with (PI / 2). + intro; assumption. + pattern PI at 3 in |- *; rewrite (double_var PI); ring. + ring. + right. + generalize (Rplus_eq_compat_l (- (PI / 2)) (PI / 2 + x) (2 * PI) H7). + replace (- (PI / 2) + (PI / 2 + x)) with x. + replace (- (PI / 2) + 2 * PI) with (3 * (PI / 2)). + intro; assumption. + rewrite double; pattern PI at 3 4 in |- *; rewrite (double_var PI); ring. + ring. + left; replace (2 * PI) with (PI / 2 + 3 * (PI / 2)). + apply Rplus_lt_compat_l; assumption. + rewrite (double PI); pattern PI at 3 4 in |- *; rewrite (double_var PI); ring. + apply Rplus_le_le_0_compat. + left; unfold Rdiv in |- *; apply Rmult_lt_0_compat. + apply PI_RGT_0. + apply Rinv_0_lt_compat; prove_sup0. + assumption. + elim H2; intro. + right; assumption. + generalize (cos_eq_0_0 x H1); intro; elim H4; intros k0 H5. + rewrite H5 in H3; rewrite H5 in H0; + generalize + (Rplus_lt_compat_l (- (PI / 2)) (3 * (PI / 2)) (IZR k0 * PI + PI / 2) H3); + generalize + (Rplus_le_compat_l (- (PI / 2)) (IZR k0 * PI + PI / 2) (2 * PI) H0). + replace (- (PI / 2) + 3 * (PI / 2)) with PI. + replace (- (PI / 2) + (IZR k0 * PI + PI / 2)) with (IZR k0 * PI). + replace (- (PI / 2) + 2 * PI) with (3 * (PI / 2)). + intros; + generalize + (Rmult_lt_compat_l (/ PI) PI (IZR k0 * PI) (Rinv_0_lt_compat PI PI_RGT_0) + H7); + generalize + (Rmult_le_compat_l (/ PI) (IZR k0 * PI) (3 * (PI / 2)) + (Rlt_le 0 (/ PI) (Rinv_0_lt_compat PI PI_RGT_0)) H6). + replace (/ PI * (IZR k0 * PI)) with (IZR k0). + replace (/ PI * (3 * (PI / 2))) with (3 * / 2). + rewrite <- Rinv_l_sym. + intros; generalize (Rplus_lt_compat_l (IZR (-2)) 1 (IZR k0) H9); + rewrite <- plus_IZR. + replace (IZR (-2) + 1) with (-1). + intro; generalize (Rplus_le_compat_l (IZR (-2)) (IZR k0) (3 * / 2) H8); + rewrite <- plus_IZR. + replace (IZR (-2) + 2) with 0. + intro; cut (-1 < IZR (-2 + k0) < 1). + intro; generalize (one_IZR_lt1 (-2 + k0) H12); intro. + cut (k0 = 2%Z). + intro; rewrite H14 in H8. + assert (Hyp : 0 < 2). + prove_sup0. + generalize (Rmult_le_compat_l 2 (IZR 2) (3 * / 2) (Rlt_le 0 2 Hyp) H8); + simpl in |- *. + replace 4 with 4. + replace (2 * (3 * / 2)) with 3. + intro; cut (3 < 4). + intro; elim (Rlt_irrefl 3 (Rlt_le_trans 3 4 3 H16 H15)). + generalize (Rplus_lt_compat_l 3 0 1 Rlt_0_1); rewrite Rplus_0_r. + replace (3 + 1) with 4. + intro; assumption. + ring. + symmetry in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m. + discrR. + ring. + rewrite <- (Zplus_opp_l 2) in H13; generalize (Zplus_reg_l (-2) k0 2 H13); + intro; assumption. + split. + assumption. + apply Rle_lt_trans with (IZR (-2) + 3 * / 2). + assumption. + simpl in |- *; replace (-2 + 3 * / 2) with (- (1 * / 2)). + apply Rlt_trans with 0. + rewrite <- Ropp_0; apply Ropp_lt_gt_contravar. + apply Rmult_lt_0_compat; + [ apply Rlt_0_1 | apply Rinv_0_lt_compat; prove_sup0 ]. + apply Rlt_0_1. + rewrite Rmult_1_l; apply Rmult_eq_reg_l with 2. + rewrite Ropp_mult_distr_r_reverse; rewrite <- Rinv_r_sym. + rewrite Rmult_plus_distr_l; rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m. + ring. + discrR. + discrR. + discrR. + simpl in |- *; ring. + simpl in |- *; ring. + apply PI_neq0. + unfold Rdiv in |- *; pattern 3 at 1 in |- *; rewrite (Rmult_comm 3); + repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_l; apply Rmult_comm. + apply PI_neq0. + symmetry in |- *; rewrite (Rmult_comm (/ PI)); rewrite Rmult_assoc; + rewrite <- Rinv_r_sym. + apply Rmult_1_r. + apply PI_neq0. + rewrite double; pattern PI at 3 4 in |- *; rewrite double_var; ring. + ring. + pattern PI at 1 in |- *; rewrite double_var; ring. Qed. Lemma cos_eq_0_2PI_1 : - forall x:R, - 0 <= x -> x <= 2 * PI -> x = PI / 2 \/ x = 3 * (PI / 2) -> cos x = 0. -intros x H1 H2 H3; elim H3; intro H4; - [ rewrite H4; rewrite cos_PI2; reflexivity - | rewrite H4; rewrite cos_3PI2; reflexivity ]. + forall x:R, + 0 <= x -> x <= 2 * PI -> x = PI / 2 \/ x = 3 * (PI / 2) -> cos x = 0. +Proof. + intros x H1 H2 H3; elim H3; intro H4; + [ rewrite H4; rewrite cos_PI2; reflexivity + | rewrite H4; rewrite cos_3PI2; reflexivity ]. Qed. diff --git a/theories/Reals/Rtrigo_alt.v b/theories/Reals/Rtrigo_alt.v index fc465bc4..a95bc54b 100644 --- a/theories/Reals/Rtrigo_alt.v +++ b/theories/Reals/Rtrigo_alt.v @@ -5,8 +5,8 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) - -(*i $Id: Rtrigo_alt.v 6245 2004-10-20 13:50:08Z barras $ i*) + +(*i $Id: Rtrigo_alt.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -14,9 +14,9 @@ Require Import SeqSeries. Require Import Rtrigo_def. Open Local Scope R_scope. -(*****************************************************************) -(* Using series definitions of cos and sin *) -(*****************************************************************) +(***************************************************************) +(** Using series definitions of cos and sin *) +(***************************************************************) Definition sin_term (a:R) (i:nat) : R := (-1) ^ i * (a ^ (2 * i + 1) / INR (fact (2 * i + 1))). @@ -30,397 +30,390 @@ Definition cos_approx (a:R) (n:nat) : R := sum_f_R0 (cos_term a) n. (**********) Lemma PI_4 : PI <= 4. -assert (H0 := PI_ineq 0). -elim H0; clear H0; intros _ H0. -unfold tg_alt, PI_tg in H0; simpl in H0. -rewrite Rinv_1 in H0; rewrite Rmult_1_r in H0; unfold Rdiv in H0. -apply Rmult_le_reg_l with (/ 4). -apply Rinv_0_lt_compat; prove_sup0. -rewrite <- Rinv_l_sym; [ rewrite Rmult_comm; assumption | discrR ]. +Proof. + assert (H0 := PI_ineq 0). + elim H0; clear H0; intros _ H0. + unfold tg_alt, PI_tg in H0; simpl in H0. + rewrite Rinv_1 in H0; rewrite Rmult_1_r in H0; unfold Rdiv in H0. + apply Rmult_le_reg_l with (/ 4). + apply Rinv_0_lt_compat; prove_sup0. + rewrite <- Rinv_l_sym; [ rewrite Rmult_comm; assumption | discrR ]. Qed. (**********) Theorem sin_bound : - forall (a:R) (n:nat), - 0 <= a -> - a <= PI -> sin_approx a (2 * n + 1) <= sin a <= sin_approx a (2 * (n + 1)). -intros; case (Req_dec a 0); intro Hyp_a. -rewrite Hyp_a; rewrite sin_0; split; right; unfold sin_approx in |- *; - apply sum_eq_R0 || (symmetry in |- *; apply sum_eq_R0); - intros; unfold sin_term in |- *; rewrite pow_add; - simpl in |- *; unfold Rdiv in |- *; rewrite Rmult_0_l; - ring. -unfold sin_approx in |- *; cut (0 < a). -intro Hyp_a_pos. -rewrite (decomp_sum (sin_term a) (2 * n + 1)). -rewrite (decomp_sum (sin_term a) (2 * (n + 1))). -replace (sin_term a 0) with a. -cut - (sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * n + 1)) <= sin a - a /\ - sin a - a <= sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * (n + 1))) -> - a + sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * n + 1)) <= sin a /\ - sin a <= a + sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * (n + 1)))). -intro; apply H1. -set (Un := fun n:nat => a ^ (2 * S n + 1) / INR (fact (2 * S n + 1))). -replace (pred (2 * n + 1)) with (2 * n)%nat. -replace (pred (2 * (n + 1))) with (S (2 * n)). -replace (sum_f_R0 (fun i:nat => sin_term a (S i)) (2 * n)) with - (- sum_f_R0 (tg_alt Un) (2 * n)). -replace (sum_f_R0 (fun i:nat => sin_term a (S i)) (S (2 * n))) with - (- sum_f_R0 (tg_alt Un) (S (2 * n))). -cut - (sum_f_R0 (tg_alt Un) (S (2 * n)) <= a - sin a <= - sum_f_R0 (tg_alt Un) (2 * n) -> - - sum_f_R0 (tg_alt Un) (2 * n) <= sin a - a <= - - sum_f_R0 (tg_alt Un) (S (2 * n))). -intro; apply H2. -apply alternated_series_ineq. -unfold Un_decreasing, Un in |- *; intro; - cut ((2 * S (S n0) + 1)%nat = S (S (2 * S n0 + 1))). -intro; rewrite H3. -replace (a ^ S (S (2 * S n0 + 1))) with (a ^ (2 * S n0 + 1) * (a * a)). -unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l. -left; apply pow_lt; assumption. -apply Rmult_le_reg_l with (INR (fact (S (S (2 * S n0 + 1))))). -rewrite <- H3; apply lt_INR_0; apply neq_O_lt; red in |- *; intro; - assert (H5 := sym_eq H4); elim (fact_neq_0 _ H5). -rewrite <- H3; rewrite (Rmult_comm (INR (fact (2 * S (S n0) + 1)))); - rewrite Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_r; rewrite H3; do 2 rewrite fact_simpl; do 2 rewrite mult_INR; - repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym. -rewrite Rmult_1_r. -do 2 rewrite S_INR; rewrite plus_INR; rewrite mult_INR; repeat rewrite S_INR; - simpl in |- *; - replace - (((0 + 1 + 1) * (INR n0 + 1) + (0 + 1) + 1 + 1) * - ((0 + 1 + 1) * (INR n0 + 1) + (0 + 1) + 1)) with - (4 * INR n0 * INR n0 + 18 * INR n0 + 20); [ idtac | ring ]. -apply Rle_trans with 20. -apply Rle_trans with 16. -replace 16 with (Rsqr 4); [ idtac | ring_Rsqr ]. -replace (a * a) with (Rsqr a); [ idtac | reflexivity ]. -apply Rsqr_incr_1. -apply Rle_trans with PI; [ assumption | apply PI_4 ]. -assumption. -left; prove_sup0. -rewrite <- (Rplus_0_r 16); replace 20 with (16 + 4); - [ apply Rplus_le_compat_l; left; prove_sup0 | ring ]. -rewrite <- (Rplus_comm 20); pattern 20 at 1 in |- *; rewrite <- Rplus_0_r; - apply Rplus_le_compat_l. -apply Rplus_le_le_0_compat. -repeat apply Rmult_le_pos. -left; prove_sup0. -left; prove_sup0. -replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ]. -replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ]. -apply Rmult_le_pos. -left; prove_sup0. -replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ]. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -simpl in |- *; ring. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite plus_INR; - do 2 rewrite mult_INR; repeat rewrite S_INR; ring. -assert (H3 := cv_speed_pow_fact a); unfold Un in |- *; unfold Un_cv in H3; - unfold R_dist in H3; unfold Un_cv in |- *; unfold R_dist in |- *; - intros; elim (H3 eps H4); intros N H5. -exists N; intros; apply H5. -replace (2 * S n0 + 1)%nat with (S (2 * S n0)). -unfold ge in |- *; apply le_trans with (2 * S n0)%nat. -apply le_trans with (2 * S N)%nat. -apply le_trans with (2 * N)%nat. -apply le_n_2n. -apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_Sn. -apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_S; assumption. -apply le_n_Sn. -apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; reflexivity. -assert (X := exist_sin (Rsqr a)); elim X; intros. -cut (x = sin a / a). -intro; rewrite H3 in p; unfold sin_in in p; unfold infinit_sum in p; - unfold R_dist in p; unfold Un_cv in |- *; unfold R_dist in |- *; - intros. -cut (0 < eps / Rabs a). -intro; elim (p _ H5); intros N H6. -exists N; intros. -replace (sum_f_R0 (tg_alt Un) n0) with - (a * (1 - sum_f_R0 (fun i:nat => sin_n i * Rsqr a ^ i) (S n0))). -unfold Rminus in |- *; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r; - rewrite Ropp_plus_distr; rewrite Ropp_involutive; - repeat rewrite Rplus_assoc; rewrite (Rplus_comm a); - rewrite (Rplus_comm (- a)); repeat rewrite Rplus_assoc; - rewrite Rplus_opp_l; rewrite Rplus_0_r; apply Rmult_lt_reg_l with (/ Rabs a). -apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. -pattern (/ Rabs a) at 1 in |- *; rewrite <- (Rabs_Rinv a Hyp_a). -rewrite <- Rabs_mult; rewrite Rmult_plus_distr_l; rewrite <- Rmult_assoc; - rewrite <- Rinv_l_sym; [ rewrite Rmult_1_l | assumption ]; - rewrite (Rmult_comm (/ a)); rewrite (Rmult_comm (/ Rabs a)); - rewrite <- Rabs_Ropp; rewrite Ropp_plus_distr; rewrite Ropp_involutive; - unfold Rminus, Rdiv in H6; apply H6; unfold ge in |- *; - apply le_trans with n0; [ exact H7 | apply le_n_Sn ]. -rewrite (decomp_sum (fun i:nat => sin_n i * Rsqr a ^ i) (S n0)). -replace (sin_n 0) with 1. -simpl in |- *; rewrite Rmult_1_r; unfold Rminus in |- *; - rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r; - rewrite Rplus_0_l; rewrite Ropp_mult_distr_r_reverse; - rewrite <- Ropp_mult_distr_l_reverse; rewrite scal_sum; - apply sum_eq. -intros; unfold sin_n, Un, tg_alt in |- *; - replace ((-1) ^ S i) with (- (-1) ^ i). -replace (a ^ (2 * S i + 1)) with (Rsqr a * Rsqr a ^ i * a). -unfold Rdiv in |- *; ring. -rewrite pow_add; rewrite pow_Rsqr; simpl in |- *; ring. -simpl in |- *; ring. -unfold sin_n in |- *; unfold Rdiv in |- *; simpl in |- *; rewrite Rinv_1; - rewrite Rmult_1_r; reflexivity. -apply lt_O_Sn. -unfold Rdiv in |- *; apply Rmult_lt_0_compat. -assumption. -apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. -unfold sin in |- *; case (exist_sin (Rsqr a)). -intros; cut (x = x0). -intro; rewrite H3; unfold Rdiv in |- *. -symmetry in |- *; apply Rinv_r_simpl_m; assumption. -unfold sin_in in p; unfold sin_in in s; eapply uniqueness_sum. -apply p. -apply s. -intros; elim H2; intros. -replace (sin a - a) with (- (a - sin a)); [ idtac | ring ]. -split; apply Ropp_le_contravar; assumption. -replace (- sum_f_R0 (tg_alt Un) (S (2 * n))) with - (-1 * sum_f_R0 (tg_alt Un) (S (2 * n))); [ rewrite scal_sum | ring ]. -apply sum_eq; intros; unfold sin_term, Un, tg_alt in |- *; - replace ((-1) ^ S i) with (-1 * (-1) ^ i). -unfold Rdiv in |- *; ring. -reflexivity. -replace (- sum_f_R0 (tg_alt Un) (2 * n)) with - (-1 * sum_f_R0 (tg_alt Un) (2 * n)); [ rewrite scal_sum | ring ]. -apply sum_eq; intros. -unfold sin_term, Un, tg_alt in |- *; - replace ((-1) ^ S i) with (-1 * (-1) ^ i). -unfold Rdiv in |- *; ring. -reflexivity. -replace (2 * (n + 1))%nat with (S (S (2 * n))). -reflexivity. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; rewrite plus_INR; - repeat rewrite S_INR; ring. -replace (2 * n + 1)%nat with (S (2 * n)). -reflexivity. -apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; - repeat rewrite S_INR; ring. -intro; elim H1; intros. -split. -apply Rplus_le_reg_l with (- a). -rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; - rewrite (Rplus_comm (- a)); apply H2. -apply Rplus_le_reg_l with (- a). -rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; - rewrite (Rplus_comm (- a)); apply H3. -unfold sin_term in |- *; simpl in |- *; unfold Rdiv in |- *; rewrite Rinv_1; - ring. -replace (2 * (n + 1))%nat with (S (S (2 * n))). -apply lt_O_Sn. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; rewrite plus_INR; - repeat rewrite S_INR; ring. -replace (2 * n + 1)%nat with (S (2 * n)). -apply lt_O_Sn. -apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; - repeat rewrite S_INR; ring. -inversion H; [ assumption | elim Hyp_a; symmetry in |- *; assumption ]. + forall (a:R) (n:nat), + 0 <= a -> + a <= PI -> sin_approx a (2 * n + 1) <= sin a <= sin_approx a (2 * (n + 1)). +Proof. + intros; case (Req_dec a 0); intro Hyp_a. + rewrite Hyp_a; rewrite sin_0; split; right; unfold sin_approx in |- *; + apply sum_eq_R0 || (symmetry in |- *; apply sum_eq_R0); + intros; unfold sin_term in |- *; rewrite pow_add; + simpl in |- *; unfold Rdiv in |- *; rewrite Rmult_0_l; + ring. + unfold sin_approx in |- *; cut (0 < a). + intro Hyp_a_pos. + rewrite (decomp_sum (sin_term a) (2 * n + 1)). + rewrite (decomp_sum (sin_term a) (2 * (n + 1))). + replace (sin_term a 0) with a. + cut + (sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * n + 1)) <= sin a - a /\ + sin a - a <= sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * (n + 1))) -> + a + sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * n + 1)) <= sin a /\ + sin a <= a + sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * (n + 1)))). + intro; apply H1. + set (Un := fun n:nat => a ^ (2 * S n + 1) / INR (fact (2 * S n + 1))). + replace (pred (2 * n + 1)) with (2 * n)%nat. + replace (pred (2 * (n + 1))) with (S (2 * n)). + replace (sum_f_R0 (fun i:nat => sin_term a (S i)) (2 * n)) with + (- sum_f_R0 (tg_alt Un) (2 * n)). + replace (sum_f_R0 (fun i:nat => sin_term a (S i)) (S (2 * n))) with + (- sum_f_R0 (tg_alt Un) (S (2 * n))). + cut + (sum_f_R0 (tg_alt Un) (S (2 * n)) <= a - sin a <= + sum_f_R0 (tg_alt Un) (2 * n) -> + - sum_f_R0 (tg_alt Un) (2 * n) <= sin a - a <= + - sum_f_R0 (tg_alt Un) (S (2 * n))). + intro; apply H2. + apply alternated_series_ineq. + unfold Un_decreasing, Un in |- *; intro; + cut ((2 * S (S n0) + 1)%nat = S (S (2 * S n0 + 1))). + intro; rewrite H3. + replace (a ^ S (S (2 * S n0 + 1))) with (a ^ (2 * S n0 + 1) * (a * a)). + unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l. + left; apply pow_lt; assumption. + apply Rmult_le_reg_l with (INR (fact (S (S (2 * S n0 + 1))))). + rewrite <- H3; apply lt_INR_0; apply neq_O_lt; red in |- *; intro; + assert (H5 := sym_eq H4); elim (fact_neq_0 _ H5). + rewrite <- H3; rewrite (Rmult_comm (INR (fact (2 * S (S n0) + 1)))); + rewrite Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_r; rewrite H3; do 2 rewrite fact_simpl; do 2 rewrite mult_INR; + repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym. + rewrite Rmult_1_r. + do 2 rewrite S_INR; rewrite plus_INR; rewrite mult_INR; repeat rewrite S_INR; + simpl in |- *; + replace + (((0 + 1 + 1) * (INR n0 + 1) + (0 + 1) + 1 + 1) * + ((0 + 1 + 1) * (INR n0 + 1) + (0 + 1) + 1)) with + (4 * INR n0 * INR n0 + 18 * INR n0 + 20); [ idtac | ring ]. + apply Rle_trans with 20. + apply Rle_trans with 16. + replace 16 with (Rsqr 4); [ idtac | ring_Rsqr ]. + replace (a * a) with (Rsqr a); [ idtac | reflexivity ]. + apply Rsqr_incr_1. + apply Rle_trans with PI; [ assumption | apply PI_4 ]. + assumption. + left; prove_sup0. + rewrite <- (Rplus_0_r 16); replace 20 with (16 + 4); + [ apply Rplus_le_compat_l; left; prove_sup0 | ring ]. + rewrite <- (Rplus_comm 20); pattern 20 at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l. + apply Rplus_le_le_0_compat. + repeat apply Rmult_le_pos. + left; prove_sup0. + left; prove_sup0. + replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ]. + replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ]. + apply Rmult_le_pos. + left; prove_sup0. + replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ]. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + simpl in |- *; ring. + ring_nat. + assert (H3 := cv_speed_pow_fact a); unfold Un in |- *; unfold Un_cv in H3; + unfold R_dist in H3; unfold Un_cv in |- *; unfold R_dist in |- *; + intros; elim (H3 eps H4); intros N H5. + exists N; intros; apply H5. + replace (2 * S n0 + 1)%nat with (S (2 * S n0)). + unfold ge in |- *; apply le_trans with (2 * S n0)%nat. + apply le_trans with (2 * S N)%nat. + apply le_trans with (2 * N)%nat. + apply le_n_2n. + apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_Sn. + apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_S; assumption. + apply le_n_Sn. + ring. + assert (X := exist_sin (Rsqr a)); elim X; intros. + cut (x = sin a / a). + intro; rewrite H3 in p; unfold sin_in in p; unfold infinit_sum in p; + unfold R_dist in p; unfold Un_cv in |- *; unfold R_dist in |- *; + intros. + cut (0 < eps / Rabs a). + intro; elim (p _ H5); intros N H6. + exists N; intros. + replace (sum_f_R0 (tg_alt Un) n0) with + (a * (1 - sum_f_R0 (fun i:nat => sin_n i * Rsqr a ^ i) (S n0))). + unfold Rminus in |- *; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r; + rewrite Ropp_plus_distr; rewrite Ropp_involutive; + repeat rewrite Rplus_assoc; rewrite (Rplus_comm a); + rewrite (Rplus_comm (- a)); repeat rewrite Rplus_assoc; + rewrite Rplus_opp_l; rewrite Rplus_0_r; apply Rmult_lt_reg_l with (/ Rabs a). + apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. + pattern (/ Rabs a) at 1 in |- *; rewrite <- (Rabs_Rinv a Hyp_a). + rewrite <- Rabs_mult; rewrite Rmult_plus_distr_l; rewrite <- Rmult_assoc; + rewrite <- Rinv_l_sym; [ rewrite Rmult_1_l | assumption ]; + rewrite (Rmult_comm (/ a)); rewrite (Rmult_comm (/ Rabs a)); + rewrite <- Rabs_Ropp; rewrite Ropp_plus_distr; rewrite Ropp_involutive; + unfold Rminus, Rdiv in H6; apply H6; unfold ge in |- *; + apply le_trans with n0; [ exact H7 | apply le_n_Sn ]. + rewrite (decomp_sum (fun i:nat => sin_n i * Rsqr a ^ i) (S n0)). + replace (sin_n 0) with 1. + simpl in |- *; rewrite Rmult_1_r; unfold Rminus in |- *; + rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r; + rewrite Rplus_0_l; rewrite Ropp_mult_distr_r_reverse; + rewrite <- Ropp_mult_distr_l_reverse; rewrite scal_sum; + apply sum_eq. + intros; unfold sin_n, Un, tg_alt in |- *; + replace ((-1) ^ S i) with (- (-1) ^ i). + replace (a ^ (2 * S i + 1)) with (Rsqr a * Rsqr a ^ i * a). + unfold Rdiv in |- *; ring. + rewrite pow_add; rewrite pow_Rsqr; simpl in |- *; ring. + simpl in |- *; ring. + unfold sin_n in |- *; unfold Rdiv in |- *; simpl in |- *; rewrite Rinv_1; + rewrite Rmult_1_r; reflexivity. + apply lt_O_Sn. + unfold Rdiv in |- *; apply Rmult_lt_0_compat. + assumption. + apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. + unfold sin in |- *; case (exist_sin (Rsqr a)). + intros; cut (x = x0). + intro; rewrite H3; unfold Rdiv in |- *. + symmetry in |- *; apply Rinv_r_simpl_m; assumption. + unfold sin_in in p; unfold sin_in in s; eapply uniqueness_sum. + apply p. + apply s. + intros; elim H2; intros. + replace (sin a - a) with (- (a - sin a)); [ idtac | ring ]. + split; apply Ropp_le_contravar; assumption. + replace (- sum_f_R0 (tg_alt Un) (S (2 * n))) with + (-1 * sum_f_R0 (tg_alt Un) (S (2 * n))); [ rewrite scal_sum | ring ]. + apply sum_eq; intros; unfold sin_term, Un, tg_alt in |- *; + replace ((-1) ^ S i) with (-1 * (-1) ^ i). + unfold Rdiv in |- *; ring. + reflexivity. + replace (- sum_f_R0 (tg_alt Un) (2 * n)) with + (-1 * sum_f_R0 (tg_alt Un) (2 * n)); [ rewrite scal_sum | ring ]. + apply sum_eq; intros. + unfold sin_term, Un, tg_alt in |- *; + replace ((-1) ^ S i) with (-1 * (-1) ^ i). + unfold Rdiv in |- *; ring. + reflexivity. + replace (2 * (n + 1))%nat with (S (S (2 * n))). + reflexivity. + ring. + replace (2 * n + 1)%nat with (S (2 * n)). + reflexivity. + ring. + intro; elim H1; intros. + split. + apply Rplus_le_reg_l with (- a). + rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; + rewrite (Rplus_comm (- a)); apply H2. + apply Rplus_le_reg_l with (- a). + rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; + rewrite (Rplus_comm (- a)); apply H3. + unfold sin_term in |- *; simpl in |- *; unfold Rdiv in |- *; rewrite Rinv_1; + ring. + replace (2 * (n + 1))%nat with (S (S (2 * n))). + apply lt_O_Sn. + ring. + replace (2 * n + 1)%nat with (S (2 * n)). + apply lt_O_Sn. + ring. + inversion H; [ assumption | elim Hyp_a; symmetry in |- *; assumption ]. Qed. (**********) Lemma cos_bound : - forall (a:R) (n:nat), - - PI / 2 <= a -> - a <= PI / 2 -> - cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1)). -cut - ((forall (a:R) (n:nat), - 0 <= a -> - a <= PI / 2 -> - cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1))) -> forall (a:R) (n:nat), - PI / 2 <= a -> a <= PI / 2 -> - cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1))). -intros H a n; apply H. -intros; unfold cos_approx in |- *. -rewrite (decomp_sum (cos_term a0) (2 * n0 + 1)). -rewrite (decomp_sum (cos_term a0) (2 * (n0 + 1))). -replace (cos_term a0 0) with 1. -cut - (sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * n0 + 1)) <= cos a0 - 1 /\ - cos a0 - 1 <= - sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * (n0 + 1))) -> - 1 + sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * n0 + 1)) <= cos a0 /\ - cos a0 <= - 1 + sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * (n0 + 1)))). -intro; apply H2. -set (Un := fun n:nat => a0 ^ (2 * S n) / INR (fact (2 * S n))). -replace (pred (2 * n0 + 1)) with (2 * n0)%nat. -replace (pred (2 * (n0 + 1))) with (S (2 * n0)). -replace (sum_f_R0 (fun i:nat => cos_term a0 (S i)) (2 * n0)) with - (- sum_f_R0 (tg_alt Un) (2 * n0)). -replace (sum_f_R0 (fun i:nat => cos_term a0 (S i)) (S (2 * n0))) with - (- sum_f_R0 (tg_alt Un) (S (2 * n0))). -cut - (sum_f_R0 (tg_alt Un) (S (2 * n0)) <= 1 - cos a0 <= - sum_f_R0 (tg_alt Un) (2 * n0) -> - - sum_f_R0 (tg_alt Un) (2 * n0) <= cos a0 - 1 <= - - sum_f_R0 (tg_alt Un) (S (2 * n0))). -intro; apply H3. -apply alternated_series_ineq. -unfold Un_decreasing in |- *; intro; unfold Un in |- *. -cut ((2 * S (S n1))%nat = S (S (2 * S n1))). -intro; rewrite H4; - replace (a0 ^ S (S (2 * S n1))) with (a0 ^ (2 * S n1) * (a0 * a0)). -unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l. -apply pow_le; assumption. -apply Rmult_le_reg_l with (INR (fact (S (S (2 * S n1))))). -rewrite <- H4; apply lt_INR_0; apply neq_O_lt; red in |- *; intro; - assert (H6 := sym_eq H5); elim (fact_neq_0 _ H6). -rewrite <- H4; rewrite (Rmult_comm (INR (fact (2 * S (S n1))))); - rewrite Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_r; rewrite H4; do 2 rewrite fact_simpl; do 2 rewrite mult_INR; - repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym. -rewrite Rmult_1_r; do 2 rewrite S_INR; rewrite mult_INR; repeat rewrite S_INR; - simpl in |- *; - replace - (((0 + 1 + 1) * (INR n1 + 1) + 1 + 1) * ((0 + 1 + 1) * (INR n1 + 1) + 1)) - with (4 * INR n1 * INR n1 + 14 * INR n1 + 12); [ idtac | ring ]. -apply Rle_trans with 12. -apply Rle_trans with 4. -replace 4 with (Rsqr 2); [ idtac | ring_Rsqr ]. -replace (a0 * a0) with (Rsqr a0); [ idtac | reflexivity ]. -apply Rsqr_incr_1. -apply Rle_trans with (PI / 2). -assumption. -unfold Rdiv in |- *; apply Rmult_le_reg_l with 2. -prove_sup0. -rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m. -replace 4 with 4; [ apply PI_4 | ring ]. -discrR. -assumption. -left; prove_sup0. -pattern 4 at 1 in |- *; rewrite <- Rplus_0_r; replace 12 with (4 + 8); - [ apply Rplus_le_compat_l; left; prove_sup0 | ring ]. -rewrite <- (Rplus_comm 12); pattern 12 at 1 in |- *; rewrite <- Rplus_0_r; - apply Rplus_le_compat_l. -apply Rplus_le_le_0_compat. -repeat apply Rmult_le_pos. -left; prove_sup0. -left; prove_sup0. -replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ]. -replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ]. -apply Rmult_le_pos. -left; prove_sup0. -replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ]. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -simpl in |- *; ring. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. -assert (H4 := cv_speed_pow_fact a0); unfold Un in |- *; unfold Un_cv in H4; - unfold R_dist in H4; unfold Un_cv in |- *; unfold R_dist in |- *; - intros; elim (H4 eps H5); intros N H6; exists N; intros. -apply H6; unfold ge in |- *; apply le_trans with (2 * S N)%nat. -apply le_trans with (2 * N)%nat. -apply le_n_2n. -apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_Sn. -apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_S; assumption. -assert (X := exist_cos (Rsqr a0)); elim X; intros. -cut (x = cos a0). -intro; rewrite H4 in p; unfold cos_in in p; unfold infinit_sum in p; - unfold R_dist in p; unfold Un_cv in |- *; unfold R_dist in |- *; - intros. -elim (p _ H5); intros N H6. -exists N; intros. -replace (sum_f_R0 (tg_alt Un) n1) with - (1 - sum_f_R0 (fun i:nat => cos_n i * Rsqr a0 ^ i) (S n1)). -unfold Rminus in |- *; rewrite Ropp_plus_distr; rewrite Ropp_involutive; - repeat rewrite Rplus_assoc; rewrite (Rplus_comm 1); - rewrite (Rplus_comm (-1)); repeat rewrite Rplus_assoc; - rewrite Rplus_opp_l; rewrite Rplus_0_r; rewrite <- Rabs_Ropp; - rewrite Ropp_plus_distr; rewrite Ropp_involutive; - unfold Rminus in H6; apply H6. -unfold ge in |- *; apply le_trans with n1. -exact H7. -apply le_n_Sn. -rewrite (decomp_sum (fun i:nat => cos_n i * Rsqr a0 ^ i) (S n1)). -replace (cos_n 0) with 1. -simpl in |- *; rewrite Rmult_1_r; unfold Rminus in |- *; - rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r; - rewrite Rplus_0_l; - replace (- sum_f_R0 (fun i:nat => cos_n (S i) * (Rsqr a0 * Rsqr a0 ^ i)) n1) - with - (-1 * sum_f_R0 (fun i:nat => cos_n (S i) * (Rsqr a0 * Rsqr a0 ^ i)) n1); - [ idtac | ring ]; rewrite scal_sum; apply sum_eq; - intros; unfold cos_n, Un, tg_alt in |- *. -replace ((-1) ^ S i) with (- (-1) ^ i). -replace (a0 ^ (2 * S i)) with (Rsqr a0 * Rsqr a0 ^ i). -unfold Rdiv in |- *; ring. -rewrite pow_Rsqr; reflexivity. -simpl in |- *; ring. -unfold cos_n in |- *; unfold Rdiv in |- *; simpl in |- *; rewrite Rinv_1; - rewrite Rmult_1_r; reflexivity. -apply lt_O_Sn. -unfold cos in |- *; case (exist_cos (Rsqr a0)); intros; unfold cos_in in p; - unfold cos_in in c; eapply uniqueness_sum. -apply p. -apply c. -intros; elim H3; intros; replace (cos a0 - 1) with (- (1 - cos a0)); - [ idtac | ring ]. -split; apply Ropp_le_contravar; assumption. -replace (- sum_f_R0 (tg_alt Un) (S (2 * n0))) with - (-1 * sum_f_R0 (tg_alt Un) (S (2 * n0))); [ rewrite scal_sum | ring ]. -apply sum_eq; intros; unfold cos_term, Un, tg_alt in |- *; - replace ((-1) ^ S i) with (-1 * (-1) ^ i). -unfold Rdiv in |- *; ring. -reflexivity. -replace (- sum_f_R0 (tg_alt Un) (2 * n0)) with - (-1 * sum_f_R0 (tg_alt Un) (2 * n0)); [ rewrite scal_sum | ring ]; - apply sum_eq; intros; unfold cos_term, Un, tg_alt in |- *; - replace ((-1) ^ S i) with (-1 * (-1) ^ i). -unfold Rdiv in |- *; ring. -reflexivity. -replace (2 * (n0 + 1))%nat with (S (S (2 * n0))). -reflexivity. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; rewrite plus_INR; - repeat rewrite S_INR; ring. -replace (2 * n0 + 1)%nat with (S (2 * n0)). -reflexivity. -apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; - repeat rewrite S_INR; ring. -intro; elim H2; intros; split. -apply Rplus_le_reg_l with (-1). -rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; - rewrite (Rplus_comm (-1)); apply H3. -apply Rplus_le_reg_l with (-1). -rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; - rewrite (Rplus_comm (-1)); apply H4. -unfold cos_term in |- *; simpl in |- *; unfold Rdiv in |- *; rewrite Rinv_1; - ring. -replace (2 * (n0 + 1))%nat with (S (S (2 * n0))). -apply lt_O_Sn. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; rewrite plus_INR; - repeat rewrite S_INR; ring. -replace (2 * n0 + 1)%nat with (S (2 * n0)). -apply lt_O_Sn. -apply INR_eq; rewrite S_INR; rewrite plus_INR; rewrite mult_INR; - repeat rewrite S_INR; ring. -intros; case (total_order_T 0 a); intro. -elim s; intro. -apply H; [ left; assumption | assumption ]. -apply H; [ right; assumption | assumption ]. -cut (0 < - a). -intro; cut (forall (x:R) (n:nat), cos_approx x n = cos_approx (- x) n). -intro; rewrite H3; rewrite (H3 a (2 * (n + 1))%nat); rewrite cos_sym; apply H. -left; assumption. -rewrite <- (Ropp_involutive (PI / 2)); apply Ropp_le_contravar; - unfold Rdiv in |- *; unfold Rdiv in H0; rewrite <- Ropp_mult_distr_l_reverse; - exact H0. -intros; unfold cos_approx in |- *; apply sum_eq; intros; - unfold cos_term in |- *; do 2 rewrite pow_Rsqr; rewrite Rsqr_neg; - unfold Rdiv in |- *; reflexivity. -apply Ropp_0_gt_lt_contravar; assumption. + cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1)). +Proof. + cut + ((forall (a:R) (n:nat), + 0 <= a -> + a <= PI / 2 -> + cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1))) -> + forall (a:R) (n:nat), + - PI / 2 <= a -> + a <= PI / 2 -> + cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1))). + intros H a n; apply H. + intros; unfold cos_approx in |- *. + rewrite (decomp_sum (cos_term a0) (2 * n0 + 1)). + rewrite (decomp_sum (cos_term a0) (2 * (n0 + 1))). + replace (cos_term a0 0) with 1. + cut + (sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * n0 + 1)) <= cos a0 - 1 /\ + cos a0 - 1 <= + sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * (n0 + 1))) -> + 1 + sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * n0 + 1)) <= cos a0 /\ + cos a0 <= + 1 + sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * (n0 + 1)))). + intro; apply H2. + set (Un := fun n:nat => a0 ^ (2 * S n) / INR (fact (2 * S n))). + replace (pred (2 * n0 + 1)) with (2 * n0)%nat. + replace (pred (2 * (n0 + 1))) with (S (2 * n0)). + replace (sum_f_R0 (fun i:nat => cos_term a0 (S i)) (2 * n0)) with + (- sum_f_R0 (tg_alt Un) (2 * n0)). + replace (sum_f_R0 (fun i:nat => cos_term a0 (S i)) (S (2 * n0))) with + (- sum_f_R0 (tg_alt Un) (S (2 * n0))). + cut + (sum_f_R0 (tg_alt Un) (S (2 * n0)) <= 1 - cos a0 <= + sum_f_R0 (tg_alt Un) (2 * n0) -> + - sum_f_R0 (tg_alt Un) (2 * n0) <= cos a0 - 1 <= + - sum_f_R0 (tg_alt Un) (S (2 * n0))). + intro; apply H3. + apply alternated_series_ineq. + unfold Un_decreasing in |- *; intro; unfold Un in |- *. + cut ((2 * S (S n1))%nat = S (S (2 * S n1))). + intro; rewrite H4; + replace (a0 ^ S (S (2 * S n1))) with (a0 ^ (2 * S n1) * (a0 * a0)). + unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l. + apply pow_le; assumption. + apply Rmult_le_reg_l with (INR (fact (S (S (2 * S n1))))). + rewrite <- H4; apply lt_INR_0; apply neq_O_lt; red in |- *; intro; + assert (H6 := sym_eq H5); elim (fact_neq_0 _ H6). + rewrite <- H4; rewrite (Rmult_comm (INR (fact (2 * S (S n1))))); + rewrite Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_r; rewrite H4; do 2 rewrite fact_simpl; do 2 rewrite mult_INR; + repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym. + rewrite Rmult_1_r; do 2 rewrite S_INR; rewrite mult_INR; repeat rewrite S_INR; + simpl in |- *; + replace + (((0 + 1 + 1) * (INR n1 + 1) + 1 + 1) * ((0 + 1 + 1) * (INR n1 + 1) + 1)) + with (4 * INR n1 * INR n1 + 14 * INR n1 + 12); [ idtac | ring ]. + apply Rle_trans with 12. + apply Rle_trans with 4. + replace 4 with (Rsqr 2); [ idtac | ring_Rsqr ]. + replace (a0 * a0) with (Rsqr a0); [ idtac | reflexivity ]. + apply Rsqr_incr_1. + apply Rle_trans with (PI / 2). + assumption. + unfold Rdiv in |- *; apply Rmult_le_reg_l with 2. + prove_sup0. + rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m. + replace 4 with 4; [ apply PI_4 | ring ]. + discrR. + assumption. + left; prove_sup0. + pattern 4 at 1 in |- *; rewrite <- Rplus_0_r; replace 12 with (4 + 8); + [ apply Rplus_le_compat_l; left; prove_sup0 | ring ]. + rewrite <- (Rplus_comm 12); pattern 12 at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_le_compat_l. + apply Rplus_le_le_0_compat. + repeat apply Rmult_le_pos. + left; prove_sup0. + left; prove_sup0. + replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ]. + replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ]. + apply Rmult_le_pos. + left; prove_sup0. + replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ]. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + simpl in |- *; ring. + ring_nat. + assert (H4 := cv_speed_pow_fact a0); unfold Un in |- *; unfold Un_cv in H4; + unfold R_dist in H4; unfold Un_cv in |- *; unfold R_dist in |- *; + intros; elim (H4 eps H5); intros N H6; exists N; intros. + apply H6; unfold ge in |- *; apply le_trans with (2 * S N)%nat. + apply le_trans with (2 * N)%nat. + apply le_n_2n. + apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_Sn. + apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_S; assumption. + assert (X := exist_cos (Rsqr a0)); elim X; intros. + cut (x = cos a0). + intro; rewrite H4 in p; unfold cos_in in p; unfold infinit_sum in p; + unfold R_dist in p; unfold Un_cv in |- *; unfold R_dist in |- *; + intros. + elim (p _ H5); intros N H6. + exists N; intros. + replace (sum_f_R0 (tg_alt Un) n1) with + (1 - sum_f_R0 (fun i:nat => cos_n i * Rsqr a0 ^ i) (S n1)). + unfold Rminus in |- *; rewrite Ropp_plus_distr; rewrite Ropp_involutive; + repeat rewrite Rplus_assoc; rewrite (Rplus_comm 1); + rewrite (Rplus_comm (-1)); repeat rewrite Rplus_assoc; + rewrite Rplus_opp_l; rewrite Rplus_0_r; rewrite <- Rabs_Ropp; + rewrite Ropp_plus_distr; rewrite Ropp_involutive; + unfold Rminus in H6; apply H6. + unfold ge in |- *; apply le_trans with n1. + exact H7. + apply le_n_Sn. + rewrite (decomp_sum (fun i:nat => cos_n i * Rsqr a0 ^ i) (S n1)). + replace (cos_n 0) with 1. + simpl in |- *; rewrite Rmult_1_r; unfold Rminus in |- *; + rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r; + rewrite Rplus_0_l; + replace (- sum_f_R0 (fun i:nat => cos_n (S i) * (Rsqr a0 * Rsqr a0 ^ i)) n1) + with + (-1 * sum_f_R0 (fun i:nat => cos_n (S i) * (Rsqr a0 * Rsqr a0 ^ i)) n1); + [ idtac | ring ]; rewrite scal_sum; apply sum_eq; + intros; unfold cos_n, Un, tg_alt in |- *. + replace ((-1) ^ S i) with (- (-1) ^ i). + replace (a0 ^ (2 * S i)) with (Rsqr a0 * Rsqr a0 ^ i). + unfold Rdiv in |- *; ring. + rewrite pow_Rsqr; reflexivity. + simpl in |- *; ring. + unfold cos_n in |- *; unfold Rdiv in |- *; simpl in |- *; rewrite Rinv_1; + rewrite Rmult_1_r; reflexivity. + apply lt_O_Sn. + unfold cos in |- *; case (exist_cos (Rsqr a0)); intros; unfold cos_in in p; + unfold cos_in in c; eapply uniqueness_sum. + apply p. + apply c. + intros; elim H3; intros; replace (cos a0 - 1) with (- (1 - cos a0)); + [ idtac | ring ]. + split; apply Ropp_le_contravar; assumption. + replace (- sum_f_R0 (tg_alt Un) (S (2 * n0))) with + (-1 * sum_f_R0 (tg_alt Un) (S (2 * n0))); [ rewrite scal_sum | ring ]. + apply sum_eq; intros; unfold cos_term, Un, tg_alt in |- *; + replace ((-1) ^ S i) with (-1 * (-1) ^ i). + unfold Rdiv in |- *; ring. + reflexivity. + replace (- sum_f_R0 (tg_alt Un) (2 * n0)) with + (-1 * sum_f_R0 (tg_alt Un) (2 * n0)); [ rewrite scal_sum | ring ]; + apply sum_eq; intros; unfold cos_term, Un, tg_alt in |- *; + replace ((-1) ^ S i) with (-1 * (-1) ^ i). + unfold Rdiv in |- *; ring. + reflexivity. + replace (2 * (n0 + 1))%nat with (S (S (2 * n0))). + reflexivity. + ring. + replace (2 * n0 + 1)%nat with (S (2 * n0)). + reflexivity. + ring. + intro; elim H2; intros; split. + apply Rplus_le_reg_l with (-1). + rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; + rewrite (Rplus_comm (-1)); apply H3. + apply Rplus_le_reg_l with (-1). + rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; + rewrite (Rplus_comm (-1)); apply H4. + unfold cos_term in |- *; simpl in |- *; unfold Rdiv in |- *; rewrite Rinv_1; + ring. + replace (2 * (n0 + 1))%nat with (S (S (2 * n0))). + apply lt_O_Sn. + ring. + replace (2 * n0 + 1)%nat with (S (2 * n0)). + apply lt_O_Sn. + ring. + intros; case (total_order_T 0 a); intro. + elim s; intro. + apply H; [ left; assumption | assumption ]. + apply H; [ right; assumption | assumption ]. + cut (0 < - a). + intro; cut (forall (x:R) (n:nat), cos_approx x n = cos_approx (- x) n). + intro; rewrite H3; rewrite (H3 a (2 * (n + 1))%nat); rewrite cos_sym; apply H. + left; assumption. + rewrite <- (Ropp_involutive (PI / 2)); apply Ropp_le_contravar; + unfold Rdiv in |- *; unfold Rdiv in H0; rewrite <- Ropp_mult_distr_l_reverse; + exact H0. + intros; unfold cos_approx in |- *; apply sum_eq; intros; + unfold cos_term in |- *; do 2 rewrite pow_Rsqr; rewrite Rsqr_neg; + unfold Rdiv in |- *; reflexivity. + apply Ropp_0_gt_lt_contravar; assumption. Qed. diff --git a/theories/Reals/Rtrigo_calc.v b/theories/Reals/Rtrigo_calc.v index f8c15667..baf0fa4b 100644 --- a/theories/Reals/Rtrigo_calc.v +++ b/theories/Reals/Rtrigo_calc.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Rtrigo_calc.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Rtrigo_calc.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -16,365 +16,388 @@ Require Import R_sqrt. Open Local Scope R_scope. Lemma tan_PI : tan PI = 0. -unfold tan in |- *; rewrite sin_PI; rewrite cos_PI; unfold Rdiv in |- *; - apply Rmult_0_l. +Proof. + unfold tan in |- *; rewrite sin_PI; rewrite cos_PI; unfold Rdiv in |- *; + apply Rmult_0_l. Qed. Lemma sin_3PI2 : sin (3 * (PI / 2)) = -1. -replace (3 * (PI / 2)) with (PI + PI / 2). -rewrite sin_plus; rewrite sin_PI; rewrite cos_PI; rewrite sin_PI2; ring. -pattern PI at 1 in |- *; rewrite (double_var PI); ring. +Proof. + replace (3 * (PI / 2)) with (PI + PI / 2). + rewrite sin_plus; rewrite sin_PI; rewrite cos_PI; rewrite sin_PI2; ring. + pattern PI at 1 in |- *; rewrite (double_var PI); ring. Qed. Lemma tan_2PI : tan (2 * PI) = 0. -unfold tan in |- *; rewrite sin_2PI; unfold Rdiv in |- *; apply Rmult_0_l. +Proof. + unfold tan in |- *; rewrite sin_2PI; unfold Rdiv in |- *; apply Rmult_0_l. Qed. Lemma sin_cos_PI4 : sin (PI / 4) = cos (PI / 4). Proof with trivial. -rewrite cos_sin... -replace (PI / 2 + PI / 4) with (- (PI / 4) + PI)... -rewrite neg_sin; rewrite sin_neg; ring... -cut (PI = PI / 2 + PI / 2); [ intro | apply double_var ]... -pattern PI at 2 3 in |- *; rewrite H; pattern PI at 2 3 in |- *; rewrite H... -assert (H0 : 2 <> 0); - [ discrR | unfold Rdiv in |- *; rewrite Rinv_mult_distr; try ring ]... + rewrite cos_sin... + replace (PI / 2 + PI / 4) with (- (PI / 4) + PI)... + rewrite neg_sin; rewrite sin_neg; ring... + cut (PI = PI / 2 + PI / 2); [ intro | apply double_var ]... + pattern PI at 2 3 in |- *; rewrite H; pattern PI at 2 3 in |- *; rewrite H... + assert (H0 : 2 <> 0); + [ discrR | unfold Rdiv in |- *; rewrite Rinv_mult_distr; try ring ]... Qed. Lemma sin_PI3_cos_PI6 : sin (PI / 3) = cos (PI / 6). Proof with trivial. -replace (PI / 6) with (PI / 2 - PI / 3)... -rewrite cos_shift... -assert (H0 : 6 <> 0); [ discrR | idtac ]... -assert (H1 : 3 <> 0); [ discrR | idtac ]... -assert (H2 : 2 <> 0); [ discrR | idtac ]... -apply Rmult_eq_reg_l with 6... -rewrite Rmult_minus_distr_l; repeat rewrite (Rmult_comm 6)... -unfold Rdiv in |- *; repeat rewrite Rmult_assoc... -rewrite <- Rinv_l_sym... -rewrite (Rmult_comm (/ 3)); repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym... -pattern PI at 2 in |- *; rewrite (Rmult_comm PI); repeat rewrite Rmult_1_r; - repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym... -ring... + replace (PI / 6) with (PI / 2 - PI / 3)... + rewrite cos_shift... + assert (H0 : 6 <> 0); [ discrR | idtac ]... + assert (H1 : 3 <> 0); [ discrR | idtac ]... + assert (H2 : 2 <> 0); [ discrR | idtac ]... + apply Rmult_eq_reg_l with 6... + rewrite Rmult_minus_distr_l; repeat rewrite (Rmult_comm 6)... + unfold Rdiv in |- *; repeat rewrite Rmult_assoc... + rewrite <- Rinv_l_sym... + rewrite (Rmult_comm (/ 3)); repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym... + pattern PI at 2 in |- *; rewrite (Rmult_comm PI); repeat rewrite Rmult_1_r; + repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym... + ring... Qed. Lemma sin_PI6_cos_PI3 : cos (PI / 3) = sin (PI / 6). Proof with trivial. -replace (PI / 6) with (PI / 2 - PI / 3)... -rewrite sin_shift... -assert (H0 : 6 <> 0); [ discrR | idtac ]... -assert (H1 : 3 <> 0); [ discrR | idtac ]... -assert (H2 : 2 <> 0); [ discrR | idtac ]... -apply Rmult_eq_reg_l with 6... -rewrite Rmult_minus_distr_l; repeat rewrite (Rmult_comm 6)... -unfold Rdiv in |- *; repeat rewrite Rmult_assoc... -rewrite <- Rinv_l_sym... -rewrite (Rmult_comm (/ 3)); repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym... -pattern PI at 2 in |- *; rewrite (Rmult_comm PI); repeat rewrite Rmult_1_r; - repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym... -ring... + replace (PI / 6) with (PI / 2 - PI / 3)... + rewrite sin_shift... + assert (H0 : 6 <> 0); [ discrR | idtac ]... + assert (H1 : 3 <> 0); [ discrR | idtac ]... + assert (H2 : 2 <> 0); [ discrR | idtac ]... + apply Rmult_eq_reg_l with 6... + rewrite Rmult_minus_distr_l; repeat rewrite (Rmult_comm 6)... + unfold Rdiv in |- *; repeat rewrite Rmult_assoc... + rewrite <- Rinv_l_sym... + rewrite (Rmult_comm (/ 3)); repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym... + pattern PI at 2 in |- *; rewrite (Rmult_comm PI); repeat rewrite Rmult_1_r; + repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym... + ring... Qed. Lemma PI6_RGT_0 : 0 < PI / 6. -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup0 ]. +Proof. + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup0 ]. Qed. Lemma PI6_RLT_PI2 : PI / 6 < PI / 2. -unfold Rdiv in |- *; apply Rmult_lt_compat_l. -apply PI_RGT_0. -apply Rinv_lt_contravar; prove_sup. +Proof. + unfold Rdiv in |- *; apply Rmult_lt_compat_l. + apply PI_RGT_0. + apply Rinv_lt_contravar; prove_sup. Qed. Lemma sin_PI6 : sin (PI / 6) = 1 / 2. Proof with trivial. -assert (H : 2 <> 0); [ discrR | idtac ]... -apply Rmult_eq_reg_l with (2 * cos (PI / 6))... -replace (2 * cos (PI / 6) * sin (PI / 6)) with - (2 * sin (PI / 6) * cos (PI / 6))... -rewrite <- sin_2a; replace (2 * (PI / 6)) with (PI / 3)... -rewrite sin_PI3_cos_PI6... -unfold Rdiv in |- *; rewrite Rmult_1_l; rewrite Rmult_assoc; - pattern 2 at 2 in |- *; rewrite (Rmult_comm 2); rewrite Rmult_assoc; - rewrite <- Rinv_l_sym... -rewrite Rmult_1_r... -unfold Rdiv in |- *; rewrite Rinv_mult_distr... -rewrite (Rmult_comm (/ 2)); rewrite (Rmult_comm 2); - repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym... -rewrite Rmult_1_r... -discrR... -ring... -apply prod_neq_R0... -cut (0 < cos (PI / 6)); - [ intro H1; auto with real - | apply cos_gt_0; - [ apply (Rlt_trans (- (PI / 2)) 0 (PI / 6) _PI2_RLT_0 PI6_RGT_0) - | apply PI6_RLT_PI2 ] ]... + assert (H : 2 <> 0); [ discrR | idtac ]... + apply Rmult_eq_reg_l with (2 * cos (PI / 6))... + replace (2 * cos (PI / 6) * sin (PI / 6)) with + (2 * sin (PI / 6) * cos (PI / 6))... + rewrite <- sin_2a; replace (2 * (PI / 6)) with (PI / 3)... + rewrite sin_PI3_cos_PI6... + unfold Rdiv in |- *; rewrite Rmult_1_l; rewrite Rmult_assoc; + pattern 2 at 2 in |- *; rewrite (Rmult_comm 2); rewrite Rmult_assoc; + rewrite <- Rinv_l_sym... + rewrite Rmult_1_r... + unfold Rdiv in |- *; rewrite Rinv_mult_distr... + rewrite (Rmult_comm (/ 2)); rewrite (Rmult_comm 2); + repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym... + rewrite Rmult_1_r... + discrR... + ring... + apply prod_neq_R0... + cut (0 < cos (PI / 6)); + [ intro H1; auto with real + | apply cos_gt_0; + [ apply (Rlt_trans (- (PI / 2)) 0 (PI / 6) _PI2_RLT_0 PI6_RGT_0) + | apply PI6_RLT_PI2 ] ]... Qed. Lemma sqrt2_neq_0 : sqrt 2 <> 0. -assert (Hyp : 0 < 2); - [ prove_sup0 - | generalize (Rlt_le 0 2 Hyp); intro H1; red in |- *; intro H2; - generalize (sqrt_eq_0 2 H1 H2); intro H; absurd (2 = 0); - [ discrR | assumption ] ]. +Proof. + assert (Hyp : 0 < 2); + [ prove_sup0 + | generalize (Rlt_le 0 2 Hyp); intro H1; red in |- *; intro H2; + generalize (sqrt_eq_0 2 H1 H2); intro H; absurd (2 = 0); + [ discrR | assumption ] ]. Qed. Lemma R1_sqrt2_neq_0 : 1 / sqrt 2 <> 0. -generalize (Rinv_neq_0_compat (sqrt 2) sqrt2_neq_0); intro H; - generalize (prod_neq_R0 1 (/ sqrt 2) R1_neq_R0 H); - intro H0; assumption. +Proof. + generalize (Rinv_neq_0_compat (sqrt 2) sqrt2_neq_0); intro H; + generalize (prod_neq_R0 1 (/ sqrt 2) R1_neq_R0 H); + intro H0; assumption. Qed. Lemma sqrt3_2_neq_0 : 2 * sqrt 3 <> 0. -apply prod_neq_R0; - [ discrR - | assert (Hyp : 0 < 3); - [ prove_sup0 - | generalize (Rlt_le 0 3 Hyp); intro H1; red in |- *; intro H2; - generalize (sqrt_eq_0 3 H1 H2); intro H; absurd (3 = 0); - [ discrR | assumption ] ] ]. +Proof. + apply prod_neq_R0; + [ discrR + | assert (Hyp : 0 < 3); + [ prove_sup0 + | generalize (Rlt_le 0 3 Hyp); intro H1; red in |- *; intro H2; + generalize (sqrt_eq_0 3 H1 H2); intro H; absurd (3 = 0); + [ discrR | assumption ] ] ]. Qed. Lemma Rlt_sqrt2_0 : 0 < sqrt 2. -assert (Hyp : 0 < 2); - [ prove_sup0 - | generalize (sqrt_positivity 2 (Rlt_le 0 2 Hyp)); intro H1; elim H1; - intro H2; - [ assumption - | absurd (0 = sqrt 2); - [ apply (sym_not_eq (A:=R)); apply sqrt2_neq_0 | assumption ] ] ]. +Proof. + assert (Hyp : 0 < 2); + [ prove_sup0 + | generalize (sqrt_positivity 2 (Rlt_le 0 2 Hyp)); intro H1; elim H1; + intro H2; + [ assumption + | absurd (0 = sqrt 2); + [ apply (sym_not_eq (A:=R)); apply sqrt2_neq_0 | assumption ] ] ]. Qed. Lemma Rlt_sqrt3_0 : 0 < sqrt 3. -cut (0%nat <> 1%nat); - [ intro H0; assert (Hyp : 0 < 2); - [ prove_sup0 - | generalize (Rlt_le 0 2 Hyp); intro H1; assert (Hyp2 : 0 < 3); - [ prove_sup0 - | generalize (Rlt_le 0 3 Hyp2); intro H2; - generalize (lt_INR_0 1 (neq_O_lt 1 H0)); - unfold INR in |- *; intro H3; - generalize (Rplus_lt_compat_l 2 0 1 H3); - rewrite Rplus_comm; rewrite Rplus_0_l; replace (2 + 1) with 3; - [ intro H4; generalize (sqrt_lt_1 2 3 H1 H2 H4); clear H3; intro H3; - apply (Rlt_trans 0 (sqrt 2) (sqrt 3) Rlt_sqrt2_0 H3) - | ring ] ] ] - | discriminate ]. +Proof. + cut (0%nat <> 1%nat); + [ intro H0; assert (Hyp : 0 < 2); + [ prove_sup0 + | generalize (Rlt_le 0 2 Hyp); intro H1; assert (Hyp2 : 0 < 3); + [ prove_sup0 + | generalize (Rlt_le 0 3 Hyp2); intro H2; + generalize (lt_INR_0 1 (neq_O_lt 1 H0)); + unfold INR in |- *; intro H3; + generalize (Rplus_lt_compat_l 2 0 1 H3); + rewrite Rplus_comm; rewrite Rplus_0_l; replace (2 + 1) with 3; + [ intro H4; generalize (sqrt_lt_1 2 3 H1 H2 H4); clear H3; intro H3; + apply (Rlt_trans 0 (sqrt 2) (sqrt 3) Rlt_sqrt2_0 H3) + | ring ] ] ] + | discriminate ]. Qed. Lemma PI4_RGT_0 : 0 < PI / 4. -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup0 ]. +Proof. + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup0 ]. Qed. Lemma cos_PI4 : cos (PI / 4) = 1 / sqrt 2. Proof with trivial. -apply Rsqr_inj... -apply cos_ge_0... -left; apply (Rlt_trans (- (PI / 2)) 0 (PI / 4) _PI2_RLT_0 PI4_RGT_0)... -left; apply PI4_RLT_PI2... -left; apply (Rmult_lt_0_compat 1 (/ sqrt 2))... -prove_sup... -apply Rinv_0_lt_compat; apply Rlt_sqrt2_0... -rewrite Rsqr_div... -rewrite Rsqr_1; rewrite Rsqr_sqrt... -assert (H : 2 <> 0); [ discrR | idtac ]... -unfold Rsqr in |- *; pattern (cos (PI / 4)) at 1 in |- *; - rewrite <- sin_cos_PI4; - replace (sin (PI / 4) * cos (PI / 4)) with - (1 / 2 * (2 * sin (PI / 4) * cos (PI / 4)))... -rewrite <- sin_2a; replace (2 * (PI / 4)) with (PI / 2)... -rewrite sin_PI2... -apply Rmult_1_r... -unfold Rdiv in |- *; rewrite (Rmult_comm 2); rewrite Rinv_mult_distr... -repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym... -rewrite Rmult_1_r... -unfold Rdiv in |- *; rewrite Rmult_1_l; repeat rewrite <- Rmult_assoc... -rewrite <- Rinv_l_sym... -rewrite Rmult_1_l... -left; prove_sup... -apply sqrt2_neq_0... + apply Rsqr_inj... + apply cos_ge_0... + left; apply (Rlt_trans (- (PI / 2)) 0 (PI / 4) _PI2_RLT_0 PI4_RGT_0)... + left; apply PI4_RLT_PI2... + left; apply (Rmult_lt_0_compat 1 (/ sqrt 2))... + prove_sup... + apply Rinv_0_lt_compat; apply Rlt_sqrt2_0... + rewrite Rsqr_div... + rewrite Rsqr_1; rewrite Rsqr_sqrt... + assert (H : 2 <> 0); [ discrR | idtac ]... + unfold Rsqr in |- *; pattern (cos (PI / 4)) at 1 in |- *; + rewrite <- sin_cos_PI4; + replace (sin (PI / 4) * cos (PI / 4)) with + (1 / 2 * (2 * sin (PI / 4) * cos (PI / 4)))... + rewrite <- sin_2a; replace (2 * (PI / 4)) with (PI / 2)... + rewrite sin_PI2... + apply Rmult_1_r... + unfold Rdiv in |- *; rewrite (Rmult_comm 2); rewrite Rinv_mult_distr... + repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym... + rewrite Rmult_1_r... + unfold Rdiv in |- *; rewrite Rmult_1_l; repeat rewrite <- Rmult_assoc... + rewrite <- Rinv_l_sym... + rewrite Rmult_1_l... + left; prove_sup... + apply sqrt2_neq_0... Qed. Lemma sin_PI4 : sin (PI / 4) = 1 / sqrt 2. -rewrite sin_cos_PI4; apply cos_PI4. +Proof. + rewrite sin_cos_PI4; apply cos_PI4. Qed. Lemma tan_PI4 : tan (PI / 4) = 1. -unfold tan in |- *; rewrite sin_cos_PI4. -unfold Rdiv in |- *; apply Rinv_r. -change (cos (PI / 4) <> 0) in |- *; rewrite cos_PI4; apply R1_sqrt2_neq_0. +Proof. + unfold tan in |- *; rewrite sin_cos_PI4. + unfold Rdiv in |- *; apply Rinv_r. + change (cos (PI / 4) <> 0) in |- *; rewrite cos_PI4; apply R1_sqrt2_neq_0. Qed. Lemma cos3PI4 : cos (3 * (PI / 4)) = -1 / sqrt 2. Proof with trivial. -replace (3 * (PI / 4)) with (PI / 2 - - (PI / 4))... -rewrite cos_shift; rewrite sin_neg; rewrite sin_PI4... -unfold Rdiv in |- *; rewrite Ropp_mult_distr_l_reverse... -unfold Rminus in |- *; rewrite Ropp_involutive; pattern PI at 1 in |- *; - rewrite double_var; unfold Rdiv in |- *; rewrite Rmult_plus_distr_r; - repeat rewrite Rmult_assoc; rewrite <- Rinv_mult_distr; - [ ring | discrR | discrR ]... + replace (3 * (PI / 4)) with (PI / 2 - - (PI / 4))... + rewrite cos_shift; rewrite sin_neg; rewrite sin_PI4... + unfold Rdiv in |- *; rewrite Ropp_mult_distr_l_reverse... + unfold Rminus in |- *; rewrite Ropp_involutive; pattern PI at 1 in |- *; + rewrite double_var; unfold Rdiv in |- *; rewrite Rmult_plus_distr_r; + repeat rewrite Rmult_assoc; rewrite <- Rinv_mult_distr; + [ ring | discrR | discrR ]... Qed. Lemma sin3PI4 : sin (3 * (PI / 4)) = 1 / sqrt 2. Proof with trivial. -replace (3 * (PI / 4)) with (PI / 2 - - (PI / 4))... -rewrite sin_shift; rewrite cos_neg; rewrite cos_PI4... -unfold Rminus in |- *; rewrite Ropp_involutive; pattern PI at 1 in |- *; - rewrite double_var; unfold Rdiv in |- *; rewrite Rmult_plus_distr_r; - repeat rewrite Rmult_assoc; rewrite <- Rinv_mult_distr; - [ ring | discrR | discrR ]... + replace (3 * (PI / 4)) with (PI / 2 - - (PI / 4))... + rewrite sin_shift; rewrite cos_neg; rewrite cos_PI4... + unfold Rminus in |- *; rewrite Ropp_involutive; pattern PI at 1 in |- *; + rewrite double_var; unfold Rdiv in |- *; rewrite Rmult_plus_distr_r; + repeat rewrite Rmult_assoc; rewrite <- Rinv_mult_distr; + [ ring | discrR | discrR ]... Qed. Lemma cos_PI6 : cos (PI / 6) = sqrt 3 / 2. Proof with trivial. -apply Rsqr_inj... -apply cos_ge_0... -left; apply (Rlt_trans (- (PI / 2)) 0 (PI / 6) _PI2_RLT_0 PI6_RGT_0)... -left; apply PI6_RLT_PI2... -left; apply (Rmult_lt_0_compat (sqrt 3) (/ 2))... -apply Rlt_sqrt3_0... -apply Rinv_0_lt_compat; prove_sup0... -assert (H : 2 <> 0); [ discrR | idtac ]... -assert (H1 : 4 <> 0); [ apply prod_neq_R0 | idtac ]... -rewrite Rsqr_div... -rewrite cos2; unfold Rsqr in |- *; rewrite sin_PI6; rewrite sqrt_def... -unfold Rdiv in |- *; rewrite Rmult_1_l; apply Rmult_eq_reg_l with 4... -rewrite Rmult_minus_distr_l; rewrite (Rmult_comm 3); - repeat rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym... -rewrite Rmult_1_l; rewrite Rmult_1_r... -rewrite <- (Rmult_comm (/ 2)); repeat rewrite <- Rmult_assoc... -rewrite <- Rinv_l_sym... -rewrite Rmult_1_l; rewrite <- Rinv_r_sym... -ring... -left; prove_sup0... + apply Rsqr_inj... + apply cos_ge_0... + left; apply (Rlt_trans (- (PI / 2)) 0 (PI / 6) _PI2_RLT_0 PI6_RGT_0)... + left; apply PI6_RLT_PI2... + left; apply (Rmult_lt_0_compat (sqrt 3) (/ 2))... + apply Rlt_sqrt3_0... + apply Rinv_0_lt_compat; prove_sup0... + assert (H : 2 <> 0); [ discrR | idtac ]... + assert (H1 : 4 <> 0); [ apply prod_neq_R0 | idtac ]... + rewrite Rsqr_div... + rewrite cos2; unfold Rsqr in |- *; rewrite sin_PI6; rewrite sqrt_def... + unfold Rdiv in |- *; rewrite Rmult_1_l; apply Rmult_eq_reg_l with 4... + rewrite Rmult_minus_distr_l; rewrite (Rmult_comm 3); + repeat rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym... + rewrite Rmult_1_l; rewrite Rmult_1_r... + rewrite <- (Rmult_comm (/ 2)); repeat rewrite <- Rmult_assoc... + rewrite <- Rinv_l_sym... + rewrite Rmult_1_l; rewrite <- Rinv_r_sym... + ring... + left; prove_sup0... Qed. Lemma tan_PI6 : tan (PI / 6) = 1 / sqrt 3. -unfold tan in |- *; rewrite sin_PI6; rewrite cos_PI6; unfold Rdiv in |- *; - repeat rewrite Rmult_1_l; rewrite Rinv_mult_distr. -rewrite Rinv_involutive. -rewrite (Rmult_comm (/ 2)); rewrite Rmult_assoc; rewrite <- Rinv_r_sym. -apply Rmult_1_r. -discrR. -discrR. -red in |- *; intro; assert (H1 := Rlt_sqrt3_0); rewrite H in H1; - elim (Rlt_irrefl 0 H1). -apply Rinv_neq_0_compat; discrR. +Proof. + unfold tan in |- *; rewrite sin_PI6; rewrite cos_PI6; unfold Rdiv in |- *; + repeat rewrite Rmult_1_l; rewrite Rinv_mult_distr. + rewrite Rinv_involutive. + rewrite (Rmult_comm (/ 2)); rewrite Rmult_assoc; rewrite <- Rinv_r_sym. + apply Rmult_1_r. + discrR. + discrR. + red in |- *; intro; assert (H1 := Rlt_sqrt3_0); rewrite H in H1; + elim (Rlt_irrefl 0 H1). + apply Rinv_neq_0_compat; discrR. Qed. Lemma sin_PI3 : sin (PI / 3) = sqrt 3 / 2. -rewrite sin_PI3_cos_PI6; apply cos_PI6. +Proof. + rewrite sin_PI3_cos_PI6; apply cos_PI6. Qed. Lemma cos_PI3 : cos (PI / 3) = 1 / 2. -rewrite sin_PI6_cos_PI3; apply sin_PI6. +Proof. + rewrite sin_PI6_cos_PI3; apply sin_PI6. Qed. Lemma tan_PI3 : tan (PI / 3) = sqrt 3. -unfold tan in |- *; rewrite sin_PI3; rewrite cos_PI3; unfold Rdiv in |- *; - rewrite Rmult_1_l; rewrite Rinv_involutive. -rewrite Rmult_assoc; rewrite <- Rinv_l_sym. -apply Rmult_1_r. -discrR. -discrR. +Proof. + unfold tan in |- *; rewrite sin_PI3; rewrite cos_PI3; unfold Rdiv in |- *; + rewrite Rmult_1_l; rewrite Rinv_involutive. + rewrite Rmult_assoc; rewrite <- Rinv_l_sym. + apply Rmult_1_r. + discrR. + discrR. Qed. Lemma sin_2PI3 : sin (2 * (PI / 3)) = sqrt 3 / 2. -rewrite double; rewrite sin_plus; rewrite sin_PI3; rewrite cos_PI3; - unfold Rdiv in |- *; repeat rewrite Rmult_1_l; rewrite (Rmult_comm (/ 2)); - repeat rewrite <- Rmult_assoc; rewrite double_var; - reflexivity. +Proof. + rewrite double; rewrite sin_plus; rewrite sin_PI3; rewrite cos_PI3; + unfold Rdiv in |- *; repeat rewrite Rmult_1_l; rewrite (Rmult_comm (/ 2)); + repeat rewrite <- Rmult_assoc; rewrite double_var; + reflexivity. Qed. Lemma cos_2PI3 : cos (2 * (PI / 3)) = -1 / 2. Proof with trivial. -assert (H : 2 <> 0); [ discrR | idtac ]... -assert (H0 : 4 <> 0); [ apply prod_neq_R0 | idtac ]... -rewrite double; rewrite cos_plus; rewrite sin_PI3; rewrite cos_PI3; - unfold Rdiv in |- *; rewrite Rmult_1_l; apply Rmult_eq_reg_l with 4... -rewrite Rmult_minus_distr_l; repeat rewrite Rmult_assoc; - rewrite (Rmult_comm 2)... -repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym... -rewrite Rmult_1_r; rewrite <- Rinv_r_sym... -pattern 2 at 4 in |- *; rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; - rewrite <- Rinv_l_sym... -rewrite Rmult_1_r; rewrite Ropp_mult_distr_r_reverse; rewrite Rmult_1_r... -rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym... -rewrite Rmult_1_r; rewrite (Rmult_comm 2); rewrite (Rmult_comm (/ 2))... -repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym... -rewrite Rmult_1_r; rewrite sqrt_def... -ring... -left; prove_sup... + assert (H : 2 <> 0); [ discrR | idtac ]... + assert (H0 : 4 <> 0); [ apply prod_neq_R0 | idtac ]... + rewrite double; rewrite cos_plus; rewrite sin_PI3; rewrite cos_PI3; + unfold Rdiv in |- *; rewrite Rmult_1_l; apply Rmult_eq_reg_l with 4... + rewrite Rmult_minus_distr_l; repeat rewrite Rmult_assoc; + rewrite (Rmult_comm 2)... + repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym... + rewrite Rmult_1_r; rewrite <- Rinv_r_sym... + pattern 2 at 4 in |- *; rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym... + rewrite Rmult_1_r; rewrite Ropp_mult_distr_r_reverse; rewrite Rmult_1_r... + rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym... + rewrite Rmult_1_r; rewrite (Rmult_comm 2); rewrite (Rmult_comm (/ 2))... + repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym... + rewrite Rmult_1_r; rewrite sqrt_def... + ring... + left; prove_sup... Qed. Lemma tan_2PI3 : tan (2 * (PI / 3)) = - sqrt 3. Proof with trivial. -assert (H : 2 <> 0); [ discrR | idtac ]... -unfold tan in |- *; rewrite sin_2PI3; rewrite cos_2PI3; unfold Rdiv in |- *; - rewrite Ropp_mult_distr_l_reverse; rewrite Rmult_1_l; - rewrite <- Ropp_inv_permute... -rewrite Rinv_involutive... -rewrite Rmult_assoc; rewrite Ropp_mult_distr_r_reverse; rewrite <- Rinv_l_sym... -ring... -apply Rinv_neq_0_compat... + assert (H : 2 <> 0); [ discrR | idtac ]... + unfold tan in |- *; rewrite sin_2PI3; rewrite cos_2PI3; unfold Rdiv in |- *; + rewrite Ropp_mult_distr_l_reverse; rewrite Rmult_1_l; + rewrite <- Ropp_inv_permute... + rewrite Rinv_involutive... + rewrite Rmult_assoc; rewrite Ropp_mult_distr_r_reverse; rewrite <- Rinv_l_sym... + ring... + apply Rinv_neq_0_compat... Qed. Lemma cos_5PI4 : cos (5 * (PI / 4)) = -1 / sqrt 2. Proof with trivial. -replace (5 * (PI / 4)) with (PI / 4 + PI)... -rewrite neg_cos; rewrite cos_PI4; unfold Rdiv in |- *; - rewrite Ropp_mult_distr_l_reverse... -pattern PI at 2 in |- *; rewrite double_var; pattern PI at 2 3 in |- *; - rewrite double_var; assert (H : 2 <> 0); - [ discrR | unfold Rdiv in |- *; repeat rewrite Rinv_mult_distr; try ring ]... + replace (5 * (PI / 4)) with (PI / 4 + PI)... + rewrite neg_cos; rewrite cos_PI4; unfold Rdiv in |- *; + rewrite Ropp_mult_distr_l_reverse... + pattern PI at 2 in |- *; rewrite double_var; pattern PI at 2 3 in |- *; + rewrite double_var; assert (H : 2 <> 0); + [ discrR | unfold Rdiv in |- *; repeat rewrite Rinv_mult_distr; try ring ]... Qed. Lemma sin_5PI4 : sin (5 * (PI / 4)) = -1 / sqrt 2. Proof with trivial. -replace (5 * (PI / 4)) with (PI / 4 + PI)... -rewrite neg_sin; rewrite sin_PI4; unfold Rdiv in |- *; - rewrite Ropp_mult_distr_l_reverse... -pattern PI at 2 in |- *; rewrite double_var; pattern PI at 2 3 in |- *; - rewrite double_var; assert (H : 2 <> 0); - [ discrR | unfold Rdiv in |- *; repeat rewrite Rinv_mult_distr; try ring ]... + replace (5 * (PI / 4)) with (PI / 4 + PI)... + rewrite neg_sin; rewrite sin_PI4; unfold Rdiv in |- *; + rewrite Ropp_mult_distr_l_reverse... + pattern PI at 2 in |- *; rewrite double_var; pattern PI at 2 3 in |- *; + rewrite double_var; assert (H : 2 <> 0); + [ discrR | unfold Rdiv in |- *; repeat rewrite Rinv_mult_distr; try ring ]... Qed. Lemma sin_cos5PI4 : cos (5 * (PI / 4)) = sin (5 * (PI / 4)). -rewrite cos_5PI4; rewrite sin_5PI4; reflexivity. +Proof. + rewrite cos_5PI4; rewrite sin_5PI4; reflexivity. Qed. Lemma Rgt_3PI2_0 : 0 < 3 * (PI / 2). -apply Rmult_lt_0_compat; - [ prove_sup0 - | unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup0 ] ]. +Proof. + apply Rmult_lt_0_compat; + [ prove_sup0 + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup0 ] ]. Qed. Lemma Rgt_2PI_0 : 0 < 2 * PI. -apply Rmult_lt_0_compat; [ prove_sup0 | apply PI_RGT_0 ]. +Proof. + apply Rmult_lt_0_compat; [ prove_sup0 | apply PI_RGT_0 ]. Qed. Lemma Rlt_PI_3PI2 : PI < 3 * (PI / 2). -generalize PI2_RGT_0; intro H1; - generalize (Rplus_lt_compat_l PI 0 (PI / 2) H1); - replace (PI + PI / 2) with (3 * (PI / 2)). -rewrite Rplus_0_r; intro H2; assumption. -pattern PI at 2 in |- *; rewrite double_var; ring. +Proof. + generalize PI2_RGT_0; intro H1; + generalize (Rplus_lt_compat_l PI 0 (PI / 2) H1); + replace (PI + PI / 2) with (3 * (PI / 2)). + rewrite Rplus_0_r; intro H2; assumption. + pattern PI at 2 in |- *; rewrite double_var; ring. Qed. - + Lemma Rlt_3PI2_2PI : 3 * (PI / 2) < 2 * PI. -generalize PI2_RGT_0; intro H1; - generalize (Rplus_lt_compat_l (3 * (PI / 2)) 0 (PI / 2) H1); - replace (3 * (PI / 2) + PI / 2) with (2 * PI). -rewrite Rplus_0_r; intro H2; assumption. -rewrite double; pattern PI at 1 2 in |- *; rewrite double_var; ring. +Proof. + generalize PI2_RGT_0; intro H1; + generalize (Rplus_lt_compat_l (3 * (PI / 2)) 0 (PI / 2) H1); + replace (3 * (PI / 2) + PI / 2) with (2 * PI). + rewrite Rplus_0_r; intro H2; assumption. + rewrite double; pattern PI at 1 2 in |- *; rewrite double_var; ring. Qed. (***************************************************************) -(* Radian -> Degree | Degree -> Radian *) +(** Radian -> Degree | Degree -> Radian *) (***************************************************************) Definition plat : R := 180. @@ -382,27 +405,30 @@ Definition toRad (x:R) : R := x * PI * / plat. Definition toDeg (x:R) : R := x * plat * / PI. Lemma rad_deg : forall x:R, toRad (toDeg x) = x. -intro; unfold toRad, toDeg in |- *; - replace (x * plat * / PI * PI * / plat) with - (x * (plat * / plat) * (PI * / PI)); [ idtac | ring ]. -repeat rewrite <- Rinv_r_sym. -ring. -apply PI_neq0. -unfold plat in |- *; discrR. +Proof. + intro; unfold toRad, toDeg in |- *; + replace (x * plat * / PI * PI * / plat) with + (x * (plat * / plat) * (PI * / PI)); [ idtac | ring ]. + repeat rewrite <- Rinv_r_sym. + ring. + apply PI_neq0. + unfold plat in |- *; discrR. Qed. Lemma toRad_inj : forall x y:R, toRad x = toRad y -> x = y. -intros; unfold toRad in H; apply Rmult_eq_reg_l with PI. -rewrite <- (Rmult_comm x); rewrite <- (Rmult_comm y). -apply Rmult_eq_reg_l with (/ plat). -rewrite <- (Rmult_comm (x * PI)); rewrite <- (Rmult_comm (y * PI)); - assumption. -apply Rinv_neq_0_compat; unfold plat in |- *; discrR. -apply PI_neq0. +Proof. + intros; unfold toRad in H; apply Rmult_eq_reg_l with PI. + rewrite <- (Rmult_comm x); rewrite <- (Rmult_comm y). + apply Rmult_eq_reg_l with (/ plat). + rewrite <- (Rmult_comm (x * PI)); rewrite <- (Rmult_comm (y * PI)); + assumption. + apply Rinv_neq_0_compat; unfold plat in |- *; discrR. + apply PI_neq0. Qed. Lemma deg_rad : forall x:R, toDeg (toRad x) = x. -intro x; apply toRad_inj; rewrite (rad_deg (toRad x)); reflexivity. +Proof. + intro x; apply toRad_inj; rewrite (rad_deg (toRad x)); reflexivity. Qed. Definition sind (x:R) : R := sin (toRad x). @@ -410,25 +436,27 @@ Definition cosd (x:R) : R := cos (toRad x). Definition tand (x:R) : R := tan (toRad x). Lemma Rsqr_sin_cos_d_one : forall x:R, Rsqr (sind x) + Rsqr (cosd x) = 1. -intro x; unfold sind in |- *; unfold cosd in |- *; apply sin2_cos2. +Proof. + intro x; unfold sind in |- *; unfold cosd in |- *; apply sin2_cos2. Qed. (***************************************************) -(* Other properties *) +(** Other properties *) (***************************************************) Lemma sin_lb_ge_0 : forall a:R, 0 <= a -> a <= PI / 2 -> 0 <= sin_lb a. -intros; case (Rtotal_order 0 a); intro. -left; apply sin_lb_gt_0; assumption. -elim H1; intro. -rewrite <- H2; unfold sin_lb in |- *; unfold sin_approx in |- *; - unfold sum_f_R0 in |- *; unfold sin_term in |- *; - repeat rewrite pow_ne_zero. -unfold Rdiv in |- *; repeat rewrite Rmult_0_l; repeat rewrite Rmult_0_r; - repeat rewrite Rplus_0_r; right; reflexivity. -discriminate. -discriminate. -discriminate. -discriminate. -elim (Rlt_irrefl 0 (Rle_lt_trans 0 a 0 H H2)). -Qed.
\ No newline at end of file +Proof. + intros; case (Rtotal_order 0 a); intro. + left; apply sin_lb_gt_0; assumption. + elim H1; intro. + rewrite <- H2; unfold sin_lb in |- *; unfold sin_approx in |- *; + unfold sum_f_R0 in |- *; unfold sin_term in |- *; + repeat rewrite pow_ne_zero. + unfold Rdiv in |- *; repeat rewrite Rmult_0_l; repeat rewrite Rmult_0_r; + repeat rewrite Rplus_0_r; right; reflexivity. + discriminate. + discriminate. + discriminate. + discriminate. + elim (Rlt_irrefl 0 (Rle_lt_trans 0 a 0 H H2)). +Qed. diff --git a/theories/Reals/Rtrigo_def.v b/theories/Reals/Rtrigo_def.v index 94f5ec97..b2aeb766 100644 --- a/theories/Reals/Rtrigo_def.v +++ b/theories/Reals/Rtrigo_def.v @@ -5,8 +5,8 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) - -(*i $Id: Rtrigo_def.v 6295 2004-11-12 16:40:39Z gregoire $ i*) + +(*i $Id: Rtrigo_def.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -15,212 +15,222 @@ Require Import Rtrigo_fun. Require Import Max. Open Local Scope R_scope. -(*****************************) -(* Definition of exponential *) -(*****************************) +(********************************) +(** * Definition of exponential *) +(********************************) Definition exp_in (x l:R) : Prop := infinit_sum (fun i:nat => / INR (fact i) * x ^ i) l. Lemma exp_cof_no_R0 : forall n:nat, / INR (fact n) <> 0. -intro. -apply Rinv_neq_0_compat. -apply INR_fact_neq_0. +Proof. + intro. + apply Rinv_neq_0_compat. + apply INR_fact_neq_0. Qed. Lemma exist_exp : forall x:R, sigT (fun l:R => exp_in x l). -intro; - generalize - (Alembert_C3 (fun n:nat => / INR (fact n)) x exp_cof_no_R0 Alembert_exp). -unfold Pser, exp_in in |- *. -trivial. +Proof. + intro; + generalize + (Alembert_C3 (fun n:nat => / INR (fact n)) x exp_cof_no_R0 Alembert_exp). + unfold Pser, exp_in in |- *. + trivial. Defined. Definition exp (x:R) : R := projT1 (exist_exp x). Lemma pow_i : forall i:nat, (0 < i)%nat -> 0 ^ i = 0. -intros; apply pow_ne_zero. -red in |- *; intro; rewrite H0 in H; elim (lt_irrefl _ H). +Proof. + intros; apply pow_ne_zero. + red in |- *; intro; rewrite H0 in H; elim (lt_irrefl _ H). Qed. (*i Calculus of $e^0$ *) Lemma exist_exp0 : sigT (fun l:R => exp_in 0 l). -apply existT with 1. -unfold exp_in in |- *; unfold infinit_sum in |- *; intros. -exists 0%nat. -intros; replace (sum_f_R0 (fun i:nat => / INR (fact i) * 0 ^ i) n) with 1. -unfold R_dist in |- *; replace (1 - 1) with 0; - [ rewrite Rabs_R0; assumption | ring ]. -induction n as [| n Hrecn]. -simpl in |- *; rewrite Rinv_1; ring. -rewrite tech5. -rewrite <- Hrecn. -simpl in |- *. -ring. -unfold ge in |- *; apply le_O_n. +Proof. + apply existT with 1. + unfold exp_in in |- *; unfold infinit_sum in |- *; intros. + exists 0%nat. + intros; replace (sum_f_R0 (fun i:nat => / INR (fact i) * 0 ^ i) n) with 1. + unfold R_dist in |- *; replace (1 - 1) with 0; + [ rewrite Rabs_R0; assumption | ring ]. + induction n as [| n Hrecn]. + simpl in |- *; rewrite Rinv_1; ring. + rewrite tech5. + rewrite <- Hrecn. + simpl in |- *. + ring. + unfold ge in |- *; apply le_O_n. Defined. Lemma exp_0 : exp 0 = 1. -cut (exp_in 0 (exp 0)). -cut (exp_in 0 1). -unfold exp_in in |- *; intros; eapply uniqueness_sum. -apply H0. -apply H. -exact (projT2 exist_exp0). -exact (projT2 (exist_exp 0)). +Proof. + cut (exp_in 0 (exp 0)). + cut (exp_in 0 1). + unfold exp_in in |- *; intros; eapply uniqueness_sum. + apply H0. + apply H. + exact (projT2 exist_exp0). + exact (projT2 (exist_exp 0)). Qed. -(**************************************) -(* Definition of hyperbolic functions *) -(**************************************) +(*****************************************) +(** * Definition of hyperbolic functions *) +(*****************************************) Definition cosh (x:R) : R := (exp x + exp (- x)) / 2. Definition sinh (x:R) : R := (exp x - exp (- x)) / 2. Definition tanh (x:R) : R := sinh x / cosh x. Lemma cosh_0 : cosh 0 = 1. -unfold cosh in |- *; rewrite Ropp_0; rewrite exp_0. -unfold Rdiv in |- *; rewrite <- Rinv_r_sym; [ reflexivity | discrR ]. +Proof. + unfold cosh in |- *; rewrite Ropp_0; rewrite exp_0. + unfold Rdiv in |- *; rewrite <- Rinv_r_sym; [ reflexivity | discrR ]. Qed. Lemma sinh_0 : sinh 0 = 0. -unfold sinh in |- *; rewrite Ropp_0; rewrite exp_0. -unfold Rminus, Rdiv in |- *; rewrite Rplus_opp_r; apply Rmult_0_l. +Proof. + unfold sinh in |- *; rewrite Ropp_0; rewrite exp_0. + unfold Rminus, Rdiv in |- *; rewrite Rplus_opp_r; apply Rmult_0_l. Qed. Definition cos_n (n:nat) : R := (-1) ^ n / INR (fact (2 * n)). Lemma simpl_cos_n : - forall n:nat, cos_n (S n) / cos_n n = - / INR (2 * S n * (2 * n + 1)). -intro; unfold cos_n in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ]. -rewrite pow_add; unfold Rdiv in |- *; rewrite Rinv_mult_distr. -rewrite Rinv_involutive. -replace - ((-1) ^ n * (-1) ^ 1 * / INR (fact (2 * (n + 1))) * - (/ (-1) ^ n * INR (fact (2 * n)))) with - ((-1) ^ n * / (-1) ^ n * / INR (fact (2 * (n + 1))) * INR (fact (2 * n)) * - (-1) ^ 1); [ idtac | ring ]. -rewrite <- Rinv_r_sym. -rewrite Rmult_1_l; unfold pow in |- *; rewrite Rmult_1_r. -replace (2 * (n + 1))%nat with (S (S (2 * n))); [ idtac | ring ]. -do 2 rewrite fact_simpl; do 2 rewrite mult_INR; - repeat rewrite Rinv_mult_distr; try (apply not_O_INR; discriminate). -rewrite <- (Rmult_comm (-1)). -repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_r. -replace (S (2 * n)) with (2 * n + 1)%nat; [ idtac | ring ]. -rewrite mult_INR; rewrite Rinv_mult_distr. -ring. -apply not_O_INR; discriminate. -replace (2 * n + 1)%nat with (S (2 * n)); - [ apply not_O_INR; discriminate | ring ]. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -apply prod_neq_R0; [ apply not_O_INR; discriminate | apply INR_fact_neq_0 ]. -apply pow_nonzero; discrR. -apply INR_fact_neq_0. -apply pow_nonzero; discrR. -apply Rinv_neq_0_compat; apply INR_fact_neq_0. + forall n:nat, cos_n (S n) / cos_n n = - / INR (2 * S n * (2 * n + 1)). +Proof. + intro; unfold cos_n in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ]. + rewrite pow_add; unfold Rdiv in |- *; rewrite Rinv_mult_distr. + rewrite Rinv_involutive. + replace + ((-1) ^ n * (-1) ^ 1 * / INR (fact (2 * (n + 1))) * + (/ (-1) ^ n * INR (fact (2 * n)))) with + ((-1) ^ n * / (-1) ^ n * / INR (fact (2 * (n + 1))) * INR (fact (2 * n)) * + (-1) ^ 1); [ idtac | ring ]. + rewrite <- Rinv_r_sym. + rewrite Rmult_1_l; unfold pow in |- *; rewrite Rmult_1_r. + replace (2 * (n + 1))%nat with (S (S (2 * n))); [ idtac | ring ]. + do 2 rewrite fact_simpl; do 2 rewrite mult_INR; + repeat rewrite Rinv_mult_distr; try (apply not_O_INR; discriminate). + rewrite <- (Rmult_comm (-1)). + repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_r. + replace (S (2 * n)) with (2 * n + 1)%nat; [ idtac | ring ]. + rewrite mult_INR; rewrite Rinv_mult_distr. + ring. + apply not_O_INR; discriminate. + replace (2 * n + 1)%nat with (S (2 * n)); + [ apply not_O_INR; discriminate | ring ]. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + apply prod_neq_R0; [ apply not_O_INR; discriminate | apply INR_fact_neq_0 ]. + apply pow_nonzero; discrR. + apply INR_fact_neq_0. + apply pow_nonzero; discrR. + apply Rinv_neq_0_compat; apply INR_fact_neq_0. Qed. Lemma archimed_cor1 : - forall eps:R, 0 < eps -> exists N : nat, / INR N < eps /\ (0 < N)%nat. -intros; cut (/ eps < IZR (up (/ eps))). -intro; cut (0 <= up (/ eps))%Z. -intro; assert (H2 := IZN _ H1); elim H2; intros; exists (max x 1). -split. -cut (0 < IZR (Z_of_nat x)). -intro; rewrite INR_IZR_INZ; apply Rle_lt_trans with (/ IZR (Z_of_nat x)). -apply Rmult_le_reg_l with (IZR (Z_of_nat x)). -assumption. -rewrite <- Rinv_r_sym; - [ idtac | red in |- *; intro; rewrite H5 in H4; elim (Rlt_irrefl _ H4) ]. -apply Rmult_le_reg_l with (IZR (Z_of_nat (max x 1))). -apply Rlt_le_trans with (IZR (Z_of_nat x)). -assumption. -repeat rewrite <- INR_IZR_INZ; apply le_INR; apply le_max_l. -rewrite Rmult_1_r; rewrite (Rmult_comm (IZR (Z_of_nat (max x 1)))); - rewrite Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_r; repeat rewrite <- INR_IZR_INZ; apply le_INR; - apply le_max_l. -rewrite <- INR_IZR_INZ; apply not_O_INR. -red in |- *; intro; assert (H6 := le_max_r x 1); cut (0 < 1)%nat; - [ intro | apply lt_O_Sn ]; assert (H8 := lt_le_trans _ _ _ H7 H6); - rewrite H5 in H8; elim (lt_irrefl _ H8). -pattern eps at 1 in |- *; rewrite <- Rinv_involutive. -apply Rinv_lt_contravar. -apply Rmult_lt_0_compat; [ apply Rinv_0_lt_compat; assumption | assumption ]. -rewrite H3 in H0; assumption. -red in |- *; intro; rewrite H5 in H; elim (Rlt_irrefl _ H). -apply Rlt_trans with (/ eps). -apply Rinv_0_lt_compat; assumption. -rewrite H3 in H0; assumption. -apply lt_le_trans with 1%nat; [ apply lt_O_Sn | apply le_max_r ]. -apply le_IZR; replace (IZR 0) with 0; [ idtac | reflexivity ]; left; - apply Rlt_trans with (/ eps); - [ apply Rinv_0_lt_compat; assumption | assumption ]. -assert (H0 := archimed (/ eps)). -elim H0; intros; assumption. + forall eps:R, 0 < eps -> exists N : nat, / INR N < eps /\ (0 < N)%nat. +Proof. + intros; cut (/ eps < IZR (up (/ eps))). + intro; cut (0 <= up (/ eps))%Z. + intro; assert (H2 := IZN _ H1); elim H2; intros; exists (max x 1). + split. + cut (0 < IZR (Z_of_nat x)). + intro; rewrite INR_IZR_INZ; apply Rle_lt_trans with (/ IZR (Z_of_nat x)). + apply Rmult_le_reg_l with (IZR (Z_of_nat x)). + assumption. + rewrite <- Rinv_r_sym; + [ idtac | red in |- *; intro; rewrite H5 in H4; elim (Rlt_irrefl _ H4) ]. + apply Rmult_le_reg_l with (IZR (Z_of_nat (max x 1))). + apply Rlt_le_trans with (IZR (Z_of_nat x)). + assumption. + repeat rewrite <- INR_IZR_INZ; apply le_INR; apply le_max_l. + rewrite Rmult_1_r; rewrite (Rmult_comm (IZR (Z_of_nat (max x 1)))); + rewrite Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_r; repeat rewrite <- INR_IZR_INZ; apply le_INR; + apply le_max_l. + rewrite <- INR_IZR_INZ; apply not_O_INR. + red in |- *; intro; assert (H6 := le_max_r x 1); cut (0 < 1)%nat; + [ intro | apply lt_O_Sn ]; assert (H8 := lt_le_trans _ _ _ H7 H6); + rewrite H5 in H8; elim (lt_irrefl _ H8). + pattern eps at 1 in |- *; rewrite <- Rinv_involutive. + apply Rinv_lt_contravar. + apply Rmult_lt_0_compat; [ apply Rinv_0_lt_compat; assumption | assumption ]. + rewrite H3 in H0; assumption. + red in |- *; intro; rewrite H5 in H; elim (Rlt_irrefl _ H). + apply Rlt_trans with (/ eps). + apply Rinv_0_lt_compat; assumption. + rewrite H3 in H0; assumption. + apply lt_le_trans with 1%nat; [ apply lt_O_Sn | apply le_max_r ]. + apply le_IZR; replace (IZR 0) with 0; [ idtac | reflexivity ]; left; + apply Rlt_trans with (/ eps); + [ apply Rinv_0_lt_compat; assumption | assumption ]. + assert (H0 := archimed (/ eps)). + elim H0; intros; assumption. Qed. Lemma Alembert_cos : Un_cv (fun n:nat => Rabs (cos_n (S n) / cos_n n)) 0. -unfold Un_cv in |- *; intros. -assert (H0 := archimed_cor1 eps H). -elim H0; intros; exists x. -intros; rewrite simpl_cos_n; unfold R_dist in |- *; unfold Rminus in |- *; - rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; - rewrite Rabs_Ropp; rewrite Rabs_right. -rewrite mult_INR; rewrite Rinv_mult_distr. -cut (/ INR (2 * S n) < 1). -intro; cut (/ INR (2 * n + 1) < eps). -intro; rewrite <- (Rmult_1_l eps). -apply Rmult_gt_0_lt_compat; try assumption. -change (0 < / INR (2 * n + 1)) in |- *; apply Rinv_0_lt_compat; - apply lt_INR_0. -replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ]. -apply Rlt_0_1. -cut (x < 2 * n + 1)%nat. -intro; assert (H5 := lt_INR _ _ H4). -apply Rlt_trans with (/ INR x). -apply Rinv_lt_contravar. -apply Rmult_lt_0_compat. -apply lt_INR_0. -elim H1; intros; assumption. -apply lt_INR_0; replace (2 * n + 1)%nat with (S (2 * n)); - [ apply lt_O_Sn | ring ]. -assumption. -elim H1; intros; assumption. -apply lt_le_trans with (S n). -unfold ge in H2; apply le_lt_n_Sm; assumption. -replace (2 * n + 1)%nat with (S (2 * n)); [ idtac | ring ]. -apply le_n_S; apply le_n_2n. -apply Rmult_lt_reg_l with (INR (2 * S n)). -apply lt_INR_0; replace (2 * S n)%nat with (S (S (2 * n))). -apply lt_O_Sn. -replace (S n) with (n + 1)%nat; [ idtac | ring ]. -ring. -rewrite <- Rinv_r_sym. -rewrite Rmult_1_r; replace 1 with (INR 1); [ apply lt_INR | reflexivity ]. -replace (2 * S n)%nat with (S (S (2 * n))). -apply lt_n_S; apply lt_O_Sn. -replace (S n) with (n + 1)%nat; [ ring | ring ]. -apply not_O_INR; discriminate. -apply not_O_INR; discriminate. -replace (2 * n + 1)%nat with (S (2 * n)); - [ apply not_O_INR; discriminate | ring ]. -apply Rle_ge; left; apply Rinv_0_lt_compat. -apply lt_INR_0. -replace (2 * S n * (2 * n + 1))%nat with (S (S (4 * (n * n) + 6 * n))). -apply lt_O_Sn. -apply INR_eq. -repeat rewrite S_INR; rewrite plus_INR; repeat rewrite mult_INR; - rewrite plus_INR; rewrite mult_INR; repeat rewrite S_INR; - replace (INR 0) with 0; [ ring | reflexivity ]. +Proof. + unfold Un_cv in |- *; intros. + assert (H0 := archimed_cor1 eps H). + elim H0; intros; exists x. + intros; rewrite simpl_cos_n; unfold R_dist in |- *; unfold Rminus in |- *; + rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; + rewrite Rabs_Ropp; rewrite Rabs_right. + rewrite mult_INR; rewrite Rinv_mult_distr. + cut (/ INR (2 * S n) < 1). + intro; cut (/ INR (2 * n + 1) < eps). + intro; rewrite <- (Rmult_1_l eps). + apply Rmult_gt_0_lt_compat; try assumption. + change (0 < / INR (2 * n + 1)) in |- *; apply Rinv_0_lt_compat; + apply lt_INR_0. + replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ]. + apply Rlt_0_1. + cut (x < 2 * n + 1)%nat. + intro; assert (H5 := lt_INR _ _ H4). + apply Rlt_trans with (/ INR x). + apply Rinv_lt_contravar. + apply Rmult_lt_0_compat. + apply lt_INR_0. + elim H1; intros; assumption. + apply lt_INR_0; replace (2 * n + 1)%nat with (S (2 * n)); + [ apply lt_O_Sn | ring ]. + assumption. + elim H1; intros; assumption. + apply lt_le_trans with (S n). + unfold ge in H2; apply le_lt_n_Sm; assumption. + replace (2 * n + 1)%nat with (S (2 * n)); [ idtac | ring ]. + apply le_n_S; apply le_n_2n. + apply Rmult_lt_reg_l with (INR (2 * S n)). + apply lt_INR_0; replace (2 * S n)%nat with (S (S (2 * n))). + apply lt_O_Sn. + replace (S n) with (n + 1)%nat; [ idtac | ring ]. + ring. + rewrite <- Rinv_r_sym. + rewrite Rmult_1_r; replace 1 with (INR 1); [ apply lt_INR | reflexivity ]. + replace (2 * S n)%nat with (S (S (2 * n))). + apply lt_n_S; apply lt_O_Sn. + replace (S n) with (n + 1)%nat; [ ring | ring ]. + apply not_O_INR; discriminate. + apply not_O_INR; discriminate. + replace (2 * n + 1)%nat with (S (2 * n)); + [ apply not_O_INR; discriminate | ring ]. + apply Rle_ge; left; apply Rinv_0_lt_compat. + apply lt_INR_0. + replace (2 * S n * (2 * n + 1))%nat with (S (S (4 * (n * n) + 6 * n))). + apply lt_O_Sn. + apply INR_eq. + repeat rewrite S_INR; rewrite plus_INR; repeat rewrite mult_INR; + rewrite plus_INR; rewrite mult_INR; repeat rewrite S_INR; + replace (INR 0) with 0; [ ring | reflexivity ]. Qed. Lemma cosn_no_R0 : forall n:nat, cos_n n <> 0. -intro; unfold cos_n in |- *; unfold Rdiv in |- *; apply prod_neq_R0. -apply pow_nonzero; discrR. -apply Rinv_neq_0_compat. -apply INR_fact_neq_0. + intro; unfold cos_n in |- *; unfold Rdiv in |- *; apply prod_neq_R0. + apply pow_nonzero; discrR. + apply Rinv_neq_0_compat. + apply INR_fact_neq_0. Qed. (**********) @@ -229,119 +239,122 @@ Definition cos_in (x l:R) : Prop := (**********) Lemma exist_cos : forall x:R, sigT (fun l:R => cos_in x l). -intro; generalize (Alembert_C3 cos_n x cosn_no_R0 Alembert_cos). -unfold Pser, cos_in in |- *; trivial. + intro; generalize (Alembert_C3 cos_n x cosn_no_R0 Alembert_cos). + unfold Pser, cos_in in |- *; trivial. Qed. -(* Definition of cosinus *) -(*************************) + +(** Definition of cosinus *) Definition cos (x:R) : R := match exist_cos (Rsqr x) with - | existT a b => a + | existT a b => a end. Definition sin_n (n:nat) : R := (-1) ^ n / INR (fact (2 * n + 1)). Lemma simpl_sin_n : - forall n:nat, sin_n (S n) / sin_n n = - / INR ((2 * S n + 1) * (2 * S n)). -intro; unfold sin_n in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ]. -rewrite pow_add; unfold Rdiv in |- *; rewrite Rinv_mult_distr. -rewrite Rinv_involutive. -replace - ((-1) ^ n * (-1) ^ 1 * / INR (fact (2 * (n + 1) + 1)) * - (/ (-1) ^ n * INR (fact (2 * n + 1)))) with - ((-1) ^ n * / (-1) ^ n * / INR (fact (2 * (n + 1) + 1)) * - INR (fact (2 * n + 1)) * (-1) ^ 1); [ idtac | ring ]. -rewrite <- Rinv_r_sym. -rewrite Rmult_1_l; unfold pow in |- *; rewrite Rmult_1_r; - replace (2 * (n + 1) + 1)%nat with (S (S (2 * n + 1))). -do 2 rewrite fact_simpl; do 2 rewrite mult_INR; - repeat rewrite Rinv_mult_distr. -rewrite <- (Rmult_comm (-1)); repeat rewrite Rmult_assoc; - rewrite <- Rinv_l_sym. -rewrite Rmult_1_r; replace (S (2 * n + 1)) with (2 * (n + 1))%nat. -repeat rewrite mult_INR; repeat rewrite Rinv_mult_distr. -ring. -apply not_O_INR; discriminate. -replace (n + 1)%nat with (S n); [ apply not_O_INR; discriminate | ring ]. -apply not_O_INR; discriminate. -apply prod_neq_R0. -apply not_O_INR; discriminate. -replace (n + 1)%nat with (S n); [ apply not_O_INR; discriminate | ring ]. -apply not_O_INR; discriminate. -replace (n + 1)%nat with (S n); [ apply not_O_INR; discriminate | ring ]. -rewrite mult_plus_distr_l; cut (forall n:nat, S n = (n + 1)%nat). -intros; rewrite (H (2 * n + 1)%nat). -ring. -intros; ring. -apply INR_fact_neq_0. -apply not_O_INR; discriminate. -apply INR_fact_neq_0. -apply not_O_INR; discriminate. -apply prod_neq_R0; [ apply not_O_INR; discriminate | apply INR_fact_neq_0 ]. -cut (forall n:nat, S (S n) = (n + 2)%nat); - [ intros; rewrite (H (2 * n + 1)%nat); ring | intros; ring ]. -apply pow_nonzero; discrR. -apply INR_fact_neq_0. -apply pow_nonzero; discrR. -apply Rinv_neq_0_compat; apply INR_fact_neq_0. + forall n:nat, sin_n (S n) / sin_n n = - / INR ((2 * S n + 1) * (2 * S n)). +Proof. + intro; unfold sin_n in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ]. + rewrite pow_add; unfold Rdiv in |- *; rewrite Rinv_mult_distr. + rewrite Rinv_involutive. + replace + ((-1) ^ n * (-1) ^ 1 * / INR (fact (2 * (n + 1) + 1)) * + (/ (-1) ^ n * INR (fact (2 * n + 1)))) with + ((-1) ^ n * / (-1) ^ n * / INR (fact (2 * (n + 1) + 1)) * + INR (fact (2 * n + 1)) * (-1) ^ 1); [ idtac | ring ]. + rewrite <- Rinv_r_sym. + rewrite Rmult_1_l; unfold pow in |- *; rewrite Rmult_1_r; + replace (2 * (n + 1) + 1)%nat with (S (S (2 * n + 1))). + do 2 rewrite fact_simpl; do 2 rewrite mult_INR; + repeat rewrite Rinv_mult_distr. + rewrite <- (Rmult_comm (-1)); repeat rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. + rewrite Rmult_1_r; replace (S (2 * n + 1)) with (2 * (n + 1))%nat. + repeat rewrite mult_INR; repeat rewrite Rinv_mult_distr. + ring. + apply not_O_INR; discriminate. + replace (n + 1)%nat with (S n); [ apply not_O_INR; discriminate | ring ]. + apply not_O_INR; discriminate. + apply prod_neq_R0. + apply not_O_INR; discriminate. + replace (n + 1)%nat with (S n); [ apply not_O_INR; discriminate | ring ]. + apply not_O_INR; discriminate. + replace (n + 1)%nat with (S n); [ apply not_O_INR; discriminate | ring ]. + rewrite mult_plus_distr_l; cut (forall n:nat, S n = (n + 1)%nat). + intros; rewrite (H (2 * n + 1)%nat). + ring. + intros; ring. + apply INR_fact_neq_0. + apply not_O_INR; discriminate. + apply INR_fact_neq_0. + apply not_O_INR; discriminate. + apply prod_neq_R0; [ apply not_O_INR; discriminate | apply INR_fact_neq_0 ]. + cut (forall n:nat, S (S n) = (n + 2)%nat); + [ intros; rewrite (H (2 * n + 1)%nat); ring | intros; ring ]. + apply pow_nonzero; discrR. + apply INR_fact_neq_0. + apply pow_nonzero; discrR. + apply Rinv_neq_0_compat; apply INR_fact_neq_0. Qed. Lemma Alembert_sin : Un_cv (fun n:nat => Rabs (sin_n (S n) / sin_n n)) 0. -unfold Un_cv in |- *; intros; assert (H0 := archimed_cor1 eps H). -elim H0; intros; exists x. -intros; rewrite simpl_sin_n; unfold R_dist in |- *; unfold Rminus in |- *; - rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; - rewrite Rabs_Ropp; rewrite Rabs_right. -rewrite mult_INR; rewrite Rinv_mult_distr. -cut (/ INR (2 * S n) < 1). -intro; cut (/ INR (2 * S n + 1) < eps). -intro; rewrite <- (Rmult_1_l eps); rewrite (Rmult_comm (/ INR (2 * S n + 1))); - apply Rmult_gt_0_lt_compat; try assumption. -change (0 < / INR (2 * S n + 1)) in |- *; apply Rinv_0_lt_compat; - apply lt_INR_0; replace (2 * S n + 1)%nat with (S (2 * S n)); - [ apply lt_O_Sn | ring ]. -apply Rlt_0_1. -cut (x < 2 * S n + 1)%nat. -intro; assert (H5 := lt_INR _ _ H4); apply Rlt_trans with (/ INR x). -apply Rinv_lt_contravar. -apply Rmult_lt_0_compat. -apply lt_INR_0; elim H1; intros; assumption. -apply lt_INR_0; replace (2 * S n + 1)%nat with (S (2 * S n)); - [ apply lt_O_Sn | ring ]. -assumption. -elim H1; intros; assumption. -apply lt_le_trans with (S n). -unfold ge in H2; apply le_lt_n_Sm; assumption. -replace (2 * S n + 1)%nat with (S (2 * S n)); [ idtac | ring ]. -apply le_S; apply le_n_2n. -apply Rmult_lt_reg_l with (INR (2 * S n)). -apply lt_INR_0; replace (2 * S n)%nat with (S (S (2 * n))); - [ apply lt_O_Sn | replace (S n) with (n + 1)%nat; [ idtac | ring ]; ring ]. -rewrite <- Rinv_r_sym. -rewrite Rmult_1_r; replace 1 with (INR 1); [ apply lt_INR | reflexivity ]. -replace (2 * S n)%nat with (S (S (2 * n))). -apply lt_n_S; apply lt_O_Sn. -replace (S n) with (n + 1)%nat; [ ring | ring ]. -apply not_O_INR; discriminate. -apply not_O_INR; discriminate. -apply not_O_INR; discriminate. -left; change (0 < / INR ((2 * S n + 1) * (2 * S n))) in |- *; - apply Rinv_0_lt_compat. -apply lt_INR_0. -replace ((2 * S n + 1) * (2 * S n))%nat with - (S (S (S (S (S (S (4 * (n * n) + 10 * n))))))). -apply lt_O_Sn. -apply INR_eq; repeat rewrite S_INR; rewrite plus_INR; repeat rewrite mult_INR; - rewrite plus_INR; rewrite mult_INR; repeat rewrite S_INR; - replace (INR 0) with 0; [ ring | reflexivity ]. +Proof. + unfold Un_cv in |- *; intros; assert (H0 := archimed_cor1 eps H). + elim H0; intros; exists x. + intros; rewrite simpl_sin_n; unfold R_dist in |- *; unfold Rminus in |- *; + rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; + rewrite Rabs_Ropp; rewrite Rabs_right. + rewrite mult_INR; rewrite Rinv_mult_distr. + cut (/ INR (2 * S n) < 1). + intro; cut (/ INR (2 * S n + 1) < eps). + intro; rewrite <- (Rmult_1_l eps); rewrite (Rmult_comm (/ INR (2 * S n + 1))); + apply Rmult_gt_0_lt_compat; try assumption. + change (0 < / INR (2 * S n + 1)) in |- *; apply Rinv_0_lt_compat; + apply lt_INR_0; replace (2 * S n + 1)%nat with (S (2 * S n)); + [ apply lt_O_Sn | ring ]. + apply Rlt_0_1. + cut (x < 2 * S n + 1)%nat. + intro; assert (H5 := lt_INR _ _ H4); apply Rlt_trans with (/ INR x). + apply Rinv_lt_contravar. + apply Rmult_lt_0_compat. + apply lt_INR_0; elim H1; intros; assumption. + apply lt_INR_0; replace (2 * S n + 1)%nat with (S (2 * S n)); + [ apply lt_O_Sn | ring ]. + assumption. + elim H1; intros; assumption. + apply lt_le_trans with (S n). + unfold ge in H2; apply le_lt_n_Sm; assumption. + replace (2 * S n + 1)%nat with (S (2 * S n)); [ idtac | ring ]. + apply le_S; apply le_n_2n. + apply Rmult_lt_reg_l with (INR (2 * S n)). + apply lt_INR_0; replace (2 * S n)%nat with (S (S (2 * n))); + [ apply lt_O_Sn | replace (S n) with (n + 1)%nat; [ idtac | ring ]; ring ]. + rewrite <- Rinv_r_sym. + rewrite Rmult_1_r; replace 1 with (INR 1); [ apply lt_INR | reflexivity ]. + replace (2 * S n)%nat with (S (S (2 * n))). + apply lt_n_S; apply lt_O_Sn. + replace (S n) with (n + 1)%nat; [ ring | ring ]. + apply not_O_INR; discriminate. + apply not_O_INR; discriminate. + apply not_O_INR; discriminate. + left; change (0 < / INR ((2 * S n + 1) * (2 * S n))) in |- *; + apply Rinv_0_lt_compat. + apply lt_INR_0. + replace ((2 * S n + 1) * (2 * S n))%nat with + (S (S (S (S (S (S (4 * (n * n) + 10 * n))))))). + apply lt_O_Sn. + apply INR_eq; repeat rewrite S_INR; rewrite plus_INR; repeat rewrite mult_INR; + rewrite plus_INR; rewrite mult_INR; repeat rewrite S_INR; + replace (INR 0) with 0; [ ring | reflexivity ]. Qed. Lemma sin_no_R0 : forall n:nat, sin_n n <> 0. -intro; unfold sin_n in |- *; unfold Rdiv in |- *; apply prod_neq_R0. -apply pow_nonzero; discrR. -apply Rinv_neq_0_compat; apply INR_fact_neq_0. +Proof. + intro; unfold sin_n in |- *; unfold Rdiv in |- *; apply prod_neq_R0. + apply pow_nonzero; discrR. + apply Rinv_neq_0_compat; apply INR_fact_neq_0. Qed. (**********) @@ -350,63 +363,69 @@ Definition sin_in (x l:R) : Prop := (**********) Lemma exist_sin : forall x:R, sigT (fun l:R => sin_in x l). -intro; generalize (Alembert_C3 sin_n x sin_no_R0 Alembert_sin). -unfold Pser, sin_n in |- *; trivial. +Proof. + intro; generalize (Alembert_C3 sin_n x sin_no_R0 Alembert_sin). + unfold Pser, sin_n in |- *; trivial. Qed. (***********************) (* Definition of sinus *) Definition sin (x:R) : R := match exist_sin (Rsqr x) with - | existT a b => x * a + | existT a b => x * a end. (*********************************************) -(* PROPERTIES *) +(** * Properties *) (*********************************************) Lemma cos_sym : forall x:R, cos x = cos (- x). -intros; unfold cos in |- *; replace (Rsqr (- x)) with (Rsqr x). -reflexivity. -apply Rsqr_neg. +Proof. + intros; unfold cos in |- *; replace (Rsqr (- x)) with (Rsqr x). + reflexivity. + apply Rsqr_neg. Qed. Lemma sin_antisym : forall x:R, sin (- x) = - sin x. -intro; unfold sin in |- *; replace (Rsqr (- x)) with (Rsqr x); - [ idtac | apply Rsqr_neg ]. -case (exist_sin (Rsqr x)); intros; ring. +Proof. + intro; unfold sin in |- *; replace (Rsqr (- x)) with (Rsqr x); + [ idtac | apply Rsqr_neg ]. + case (exist_sin (Rsqr x)); intros; ring. Qed. Lemma sin_0 : sin 0 = 0. -unfold sin in |- *; case (exist_sin (Rsqr 0)). -intros; ring. +Proof. + unfold sin in |- *; case (exist_sin (Rsqr 0)). + intros; ring. Qed. Lemma exist_cos0 : sigT (fun l:R => cos_in 0 l). -apply existT with 1. -unfold cos_in in |- *; unfold infinit_sum in |- *; intros; exists 0%nat. -intros. -unfold R_dist in |- *. -induction n as [| n Hrecn]. -unfold cos_n in |- *; simpl in |- *. -unfold Rdiv in |- *; rewrite Rinv_1. -do 2 rewrite Rmult_1_r. -unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. -rewrite tech5. -replace (cos_n (S n) * 0 ^ S n) with 0. -rewrite Rplus_0_r. -apply Hrecn; unfold ge in |- *; apply le_O_n. -simpl in |- *; ring. +Proof. + apply existT with 1. + unfold cos_in in |- *; unfold infinit_sum in |- *; intros; exists 0%nat. + intros. + unfold R_dist in |- *. + induction n as [| n Hrecn]. + unfold cos_n in |- *; simpl in |- *. + unfold Rdiv in |- *; rewrite Rinv_1. + do 2 rewrite Rmult_1_r. + unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. + rewrite tech5. + replace (cos_n (S n) * 0 ^ S n) with 0. + rewrite Rplus_0_r. + apply Hrecn; unfold ge in |- *; apply le_O_n. + simpl in |- *; ring. Defined. (* Calculus of (cos 0) *) Lemma cos_0 : cos 0 = 1. -cut (cos_in 0 (cos 0)). -cut (cos_in 0 1). -unfold cos_in in |- *; intros; eapply uniqueness_sum. -apply H0. -apply H. -exact (projT2 exist_cos0). -assert (H := projT2 (exist_cos (Rsqr 0))); unfold cos in |- *; - pattern 0 at 1 in |- *; replace 0 with (Rsqr 0); [ exact H | apply Rsqr_0 ]. +Proof. + cut (cos_in 0 (cos 0)). + cut (cos_in 0 1). + unfold cos_in in |- *; intros; eapply uniqueness_sum. + apply H0. + apply H. + exact (projT2 exist_cos0). + assert (H := projT2 (exist_cos (Rsqr 0))); unfold cos in |- *; + pattern 0 at 1 in |- *; replace 0 with (Rsqr 0); [ exact H | apply Rsqr_0 ]. Qed. diff --git a/theories/Reals/Rtrigo_fun.v b/theories/Reals/Rtrigo_fun.v index eaf2121e..78ef847f 100644 --- a/theories/Reals/Rtrigo_fun.v +++ b/theories/Reals/Rtrigo_fun.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Rtrigo_fun.v 8691 2006-04-10 09:23:37Z msozeau $ i*) +(*i $Id: Rtrigo_fun.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -14,96 +14,89 @@ Require Import SeqSeries. Open Local Scope R_scope. (*****************************************************************) -(* To define transcendental functions *) -(* *) -(*****************************************************************) -(*****************************************************************) -(* For exponential function *) +(** To define transcendental functions *) +(** for exponential function *) (* *) (*****************************************************************) (*********) Lemma Alembert_exp : - Un_cv (fun n:nat => Rabs (/ INR (fact (S n)) * / / INR (fact n))) 0. -unfold Un_cv in |- *; intros; elim (Rgt_dec eps 1); intro. -split with 0%nat; intros; rewrite (simpl_fact n); unfold R_dist in |- *; - rewrite (Rminus_0_r (Rabs (/ INR (S n)))); - rewrite (Rabs_Rabsolu (/ INR (S n))); cut (/ INR (S n) > 0). -intro; rewrite (Rabs_pos_eq (/ INR (S n))). -cut (/ eps - 1 < 0). -intro; generalize (Rlt_le_trans (/ eps - 1) 0 (INR n) H2 (pos_INR n)); - clear H2; intro; unfold Rminus in H2; - generalize (Rplus_lt_compat_l 1 (/ eps + -1) (INR n) H2); - replace (1 + (/ eps + -1)) with (/ eps); [ clear H2; intro | ring ]. -rewrite (Rplus_comm 1 (INR n)) in H2; rewrite <- (S_INR n) in H2; - generalize (Rmult_gt_0_compat (/ INR (S n)) eps H1 H); - intro; unfold Rgt in H3; - generalize (Rmult_lt_compat_l (/ INR (S n) * eps) (/ eps) (INR (S n)) H3 H2); - intro; rewrite (Rmult_assoc (/ INR (S n)) eps (/ eps)) in H4; - rewrite (Rinv_r eps (Rlt_dichotomy_converse eps 0 (or_intror (eps < 0) H))) - in H4; rewrite (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1) in H4; - rewrite (Rmult_comm (/ INR (S n))) in H4; - rewrite (Rmult_assoc eps (/ INR (S n)) (INR (S n))) in H4; - rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) (sym_not_equal (O_S n)))) in H4; - rewrite (let (H1, H2) := Rmult_ne eps in H1) in H4; - assumption. -apply Rlt_minus; unfold Rgt in a; rewrite <- Rinv_1; - apply (Rinv_lt_contravar 1 eps); auto; - rewrite (let (H1, H2) := Rmult_ne eps in H2); unfold Rgt in H; - assumption. -unfold Rgt in H1; apply Rlt_le; assumption. -unfold Rgt in |- *; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn. + Un_cv (fun n:nat => Rabs (/ INR (fact (S n)) * / / INR (fact n))) 0. +Proof. + unfold Un_cv in |- *; intros; elim (Rgt_dec eps 1); intro. + split with 0%nat; intros; rewrite (simpl_fact n); unfold R_dist in |- *; + rewrite (Rminus_0_r (Rabs (/ INR (S n)))); + rewrite (Rabs_Rabsolu (/ INR (S n))); cut (/ INR (S n) > 0). + intro; rewrite (Rabs_pos_eq (/ INR (S n))). + cut (/ eps - 1 < 0). + intro; generalize (Rlt_le_trans (/ eps - 1) 0 (INR n) H2 (pos_INR n)); + clear H2; intro; unfold Rminus in H2; + generalize (Rplus_lt_compat_l 1 (/ eps + -1) (INR n) H2); + replace (1 + (/ eps + -1)) with (/ eps); [ clear H2; intro | ring ]. + rewrite (Rplus_comm 1 (INR n)) in H2; rewrite <- (S_INR n) in H2; + generalize (Rmult_gt_0_compat (/ INR (S n)) eps H1 H); + intro; unfold Rgt in H3; + generalize (Rmult_lt_compat_l (/ INR (S n) * eps) (/ eps) (INR (S n)) H3 H2); + intro; rewrite (Rmult_assoc (/ INR (S n)) eps (/ eps)) in H4; + rewrite (Rinv_r eps (Rlt_dichotomy_converse eps 0 (or_intror (eps < 0) H))) + in H4; rewrite (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1) in H4; + rewrite (Rmult_comm (/ INR (S n))) in H4; + rewrite (Rmult_assoc eps (/ INR (S n)) (INR (S n))) in H4; + rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) (sym_not_equal (O_S n)))) in H4; + rewrite (let (H1, H2) := Rmult_ne eps in H1) in H4; + assumption. + apply Rlt_minus; unfold Rgt in a; rewrite <- Rinv_1; + apply (Rinv_lt_contravar 1 eps); auto; + rewrite (let (H1, H2) := Rmult_ne eps in H2); unfold Rgt in H; + assumption. + unfold Rgt in H1; apply Rlt_le; assumption. + unfold Rgt in |- *; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn. (**) -cut (0 <= up (/ eps - 1))%Z. -intro; elim (IZN (up (/ eps - 1)) H0); intros; split with x; intros; - rewrite (simpl_fact n); unfold R_dist in |- *; - rewrite (Rminus_0_r (Rabs (/ INR (S n)))); - rewrite (Rabs_Rabsolu (/ INR (S n))); cut (/ INR (S n) > 0). -intro; rewrite (Rabs_pos_eq (/ INR (S n))). -cut (/ eps - 1 < INR x). -intro ; - generalize - (Rlt_le_trans (/ eps - 1) (INR x) (INR n) H4 - (le_INR x n H2)); - clear H4; intro; unfold Rminus in H4; - generalize (Rplus_lt_compat_l 1 (/ eps + -1) (INR n) H4); - replace (1 + (/ eps + -1)) with (/ eps); [ clear H4; intro | ring ]. -rewrite (Rplus_comm 1 (INR n)) in H4; rewrite <- (S_INR n) in H4; - generalize (Rmult_gt_0_compat (/ INR (S n)) eps H3 H); - intro; unfold Rgt in H5; - generalize (Rmult_lt_compat_l (/ INR (S n) * eps) (/ eps) (INR (S n)) H5 H4); - intro; rewrite (Rmult_assoc (/ INR (S n)) eps (/ eps)) in H6; - rewrite (Rinv_r eps (Rlt_dichotomy_converse eps 0 (or_intror (eps < 0) H))) - in H6; rewrite (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1) in H6; - rewrite (Rmult_comm (/ INR (S n))) in H6; - rewrite (Rmult_assoc eps (/ INR (S n)) (INR (S n))) in H6; - rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) (sym_not_equal (O_S n)))) in H6; - rewrite (let (H1, H2) := Rmult_ne eps in H1) in H6; - assumption. -cut (IZR (up (/ eps - 1)) = IZR (Z_of_nat x)); - [ intro | rewrite H1; trivial ]. -elim (archimed (/ eps - 1)); intros; clear H6; unfold Rgt in H5; - rewrite H4 in H5; rewrite INR_IZR_INZ; assumption. -unfold Rgt in H1; apply Rlt_le; assumption. -unfold Rgt in |- *; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn. -apply (le_O_IZR (up (/ eps - 1))); - apply (Rle_trans 0 (/ eps - 1) (IZR (up (/ eps - 1)))). -generalize (Rnot_gt_le eps 1 b); clear b; unfold Rle in |- *; intro; elim H0; - clear H0; intro. -left; unfold Rgt in H; - generalize (Rmult_lt_compat_l (/ eps) eps 1 (Rinv_0_lt_compat eps H) H0); - rewrite - (Rinv_l eps - (sym_not_eq (Rlt_dichotomy_converse 0 eps (or_introl (0 > eps) H)))) - ; rewrite (let (H1, H2) := Rmult_ne (/ eps) in H1); - intro; fold (/ eps - 1 > 0) in |- *; apply Rgt_minus; - unfold Rgt in |- *; assumption. -right; rewrite H0; rewrite Rinv_1; apply sym_eq; apply Rminus_diag_eq; auto. -elim (archimed (/ eps - 1)); intros; clear H1; unfold Rgt in H0; apply Rlt_le; - assumption. + cut (0 <= up (/ eps - 1))%Z. + intro; elim (IZN (up (/ eps - 1)) H0); intros; split with x; intros; + rewrite (simpl_fact n); unfold R_dist in |- *; + rewrite (Rminus_0_r (Rabs (/ INR (S n)))); + rewrite (Rabs_Rabsolu (/ INR (S n))); cut (/ INR (S n) > 0). + intro; rewrite (Rabs_pos_eq (/ INR (S n))). + cut (/ eps - 1 < INR x). + intro ; + generalize + (Rlt_le_trans (/ eps - 1) (INR x) (INR n) H4 + (le_INR x n H2)); + clear H4; intro; unfold Rminus in H4; + generalize (Rplus_lt_compat_l 1 (/ eps + -1) (INR n) H4); + replace (1 + (/ eps + -1)) with (/ eps); [ clear H4; intro | ring ]. + rewrite (Rplus_comm 1 (INR n)) in H4; rewrite <- (S_INR n) in H4; + generalize (Rmult_gt_0_compat (/ INR (S n)) eps H3 H); + intro; unfold Rgt in H5; + generalize (Rmult_lt_compat_l (/ INR (S n) * eps) (/ eps) (INR (S n)) H5 H4); + intro; rewrite (Rmult_assoc (/ INR (S n)) eps (/ eps)) in H6; + rewrite (Rinv_r eps (Rlt_dichotomy_converse eps 0 (or_intror (eps < 0) H))) + in H6; rewrite (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1) in H6; + rewrite (Rmult_comm (/ INR (S n))) in H6; + rewrite (Rmult_assoc eps (/ INR (S n)) (INR (S n))) in H6; + rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) (sym_not_equal (O_S n)))) in H6; + rewrite (let (H1, H2) := Rmult_ne eps in H1) in H6; + assumption. + cut (IZR (up (/ eps - 1)) = IZR (Z_of_nat x)); + [ intro | rewrite H1; trivial ]. + elim (archimed (/ eps - 1)); intros; clear H6; unfold Rgt in H5; + rewrite H4 in H5; rewrite INR_IZR_INZ; assumption. + unfold Rgt in H1; apply Rlt_le; assumption. + unfold Rgt in |- *; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn. + apply (le_O_IZR (up (/ eps - 1))); + apply (Rle_trans 0 (/ eps - 1) (IZR (up (/ eps - 1)))). + generalize (Rnot_gt_le eps 1 b); clear b; unfold Rle in |- *; intro; elim H0; + clear H0; intro. + left; unfold Rgt in H; + generalize (Rmult_lt_compat_l (/ eps) eps 1 (Rinv_0_lt_compat eps H) H0); + rewrite + (Rinv_l eps + (sym_not_eq (Rlt_dichotomy_converse 0 eps (or_introl (0 > eps) H)))) + ; rewrite (let (H1, H2) := Rmult_ne (/ eps) in H1); + intro; fold (/ eps - 1 > 0) in |- *; apply Rgt_minus; + unfold Rgt in |- *; assumption. + right; rewrite H0; rewrite Rinv_1; apply sym_eq; apply Rminus_diag_eq; auto. + elim (archimed (/ eps - 1)); intros; clear H1; unfold Rgt in H0; apply Rlt_le; + assumption. Qed. - - - - - diff --git a/theories/Reals/Rtrigo_reg.v b/theories/Reals/Rtrigo_reg.v index 1c9a9445..854c0b4a 100644 --- a/theories/Reals/Rtrigo_reg.v +++ b/theories/Reals/Rtrigo_reg.v @@ -5,8 +5,8 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) - -(*i $Id: Rtrigo_reg.v 8670 2006-03-28 22:16:14Z herbelin $ i*) + +(*i $Id: Rtrigo_reg.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -18,591 +18,603 @@ Open Local Scope nat_scope. Open Local Scope R_scope. Lemma CVN_R_cos : - forall fn:nat -> R -> R, - fn = (fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N)) * x ^ (2 * N)) -> - CVN_R fn. -unfold CVN_R in |- *; intros. -cut ((r:R) <> 0). -intro hyp_r; unfold CVN_r in |- *. -apply existT with (fun n:nat => / INR (fact (2 * n)) * r ^ (2 * n)). -cut - (sigT - (fun l:R => - Un_cv - (fun n:nat => - sum_f_R0 (fun k:nat => Rabs (/ INR (fact (2 * k)) * r ^ (2 * k))) - n) l)). -intro X; elim X; intros. -apply existT with x. -split. -apply p. -intros; rewrite H; unfold Rdiv in |- *; do 2 rewrite Rabs_mult. -rewrite pow_1_abs; rewrite Rmult_1_l. -cut (0 < / INR (fact (2 * n))). -intro; rewrite (Rabs_right _ (Rle_ge _ _ (Rlt_le _ _ H1))). -apply Rmult_le_compat_l. -left; apply H1. -rewrite <- RPow_abs; apply pow_maj_Rabs. -rewrite Rabs_Rabsolu. -unfold Boule in H0; rewrite Rminus_0_r in H0. -left; apply H0. -apply Rinv_0_lt_compat; apply INR_fact_lt_0. -apply Alembert_C2. -intro; apply Rabs_no_R0. -apply prod_neq_R0. -apply Rinv_neq_0_compat. -apply INR_fact_neq_0. -apply pow_nonzero; assumption. -assert (H0 := Alembert_cos). -unfold cos_n in H0; unfold Un_cv in H0; unfold Un_cv in |- *; intros. -cut (0 < eps / Rsqr r). -intro; elim (H0 _ H2); intros N0 H3. -exists N0; intros. -unfold R_dist in |- *; assert (H5 := H3 _ H4). -unfold R_dist in H5; - replace - (Rabs - (Rabs (/ INR (fact (2 * S n)) * r ^ (2 * S n)) / - Rabs (/ INR (fact (2 * n)) * r ^ (2 * n)))) with - (Rsqr r * - Rabs ((-1) ^ S n / INR (fact (2 * S n)) / ((-1) ^ n / INR (fact (2 * n))))). -apply Rmult_lt_reg_l with (/ Rsqr r). -apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption. -pattern (/ Rsqr r) at 1 in |- *; replace (/ Rsqr r) with (Rabs (/ Rsqr r)). -rewrite <- Rabs_mult; rewrite Rmult_minus_distr_l; rewrite Rmult_0_r; - rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); apply H5. -unfold Rsqr in |- *; apply prod_neq_R0; assumption. -rewrite Rabs_Rinv. -rewrite Rabs_right. -reflexivity. -apply Rle_ge; apply Rle_0_sqr. -unfold Rsqr in |- *; apply prod_neq_R0; assumption. -rewrite (Rmult_comm (Rsqr r)); unfold Rdiv in |- *; repeat rewrite Rabs_mult; - rewrite Rabs_Rabsolu; rewrite pow_1_abs; rewrite Rmult_1_l; - repeat rewrite Rmult_assoc; apply Rmult_eq_compat_l. -rewrite Rabs_Rinv. -rewrite Rabs_mult; rewrite (pow_1_abs n); rewrite Rmult_1_l; - rewrite <- Rabs_Rinv. -rewrite Rinv_involutive. -rewrite Rinv_mult_distr. -rewrite Rabs_Rinv. -rewrite Rinv_involutive. -rewrite (Rmult_comm (Rabs (Rabs (r ^ (2 * S n))))); rewrite Rabs_mult; - rewrite Rabs_Rabsolu; rewrite Rmult_assoc; apply Rmult_eq_compat_l. -rewrite Rabs_Rinv. -do 2 rewrite Rabs_Rabsolu; repeat rewrite Rabs_right. -replace (r ^ (2 * S n)) with (r ^ (2 * n) * r * r). -repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. -unfold Rsqr in |- *; ring. -apply pow_nonzero; assumption. -replace (2 * S n)%nat with (S (S (2 * n))). -simpl in |- *; ring. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. -apply Rle_ge; apply pow_le; left; apply (cond_pos r). -apply Rle_ge; apply pow_le; left; apply (cond_pos r). -apply Rabs_no_R0; apply pow_nonzero; assumption. -apply Rabs_no_R0; apply INR_fact_neq_0. -apply INR_fact_neq_0. -apply Rabs_no_R0; apply Rinv_neq_0_compat; apply INR_fact_neq_0. -apply Rabs_no_R0; apply pow_nonzero; assumption. -apply INR_fact_neq_0. -apply Rinv_neq_0_compat; apply INR_fact_neq_0. -apply prod_neq_R0. -apply pow_nonzero; discrR. -apply Rinv_neq_0_compat; apply INR_fact_neq_0. -unfold Rdiv in |- *; apply Rmult_lt_0_compat. -apply H1. -apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption. -assert (H0 := cond_pos r); red in |- *; intro; rewrite H1 in H0; - elim (Rlt_irrefl _ H0). + forall fn:nat -> R -> R, + fn = (fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N)) * x ^ (2 * N)) -> + CVN_R fn. +Proof. + unfold CVN_R in |- *; intros. + cut ((r:R) <> 0). + intro hyp_r; unfold CVN_r in |- *. + apply existT with (fun n:nat => / INR (fact (2 * n)) * r ^ (2 * n)). + cut + (sigT + (fun l:R => + Un_cv + (fun n:nat => + sum_f_R0 (fun k:nat => Rabs (/ INR (fact (2 * k)) * r ^ (2 * k))) + n) l)). + intro X; elim X; intros. + apply existT with x. + split. + apply p. + intros; rewrite H; unfold Rdiv in |- *; do 2 rewrite Rabs_mult. + rewrite pow_1_abs; rewrite Rmult_1_l. + cut (0 < / INR (fact (2 * n))). + intro; rewrite (Rabs_right _ (Rle_ge _ _ (Rlt_le _ _ H1))). + apply Rmult_le_compat_l. + left; apply H1. + rewrite <- RPow_abs; apply pow_maj_Rabs. + rewrite Rabs_Rabsolu. + unfold Boule in H0; rewrite Rminus_0_r in H0. + left; apply H0. + apply Rinv_0_lt_compat; apply INR_fact_lt_0. + apply Alembert_C2. + intro; apply Rabs_no_R0. + apply prod_neq_R0. + apply Rinv_neq_0_compat. + apply INR_fact_neq_0. + apply pow_nonzero; assumption. + assert (H0 := Alembert_cos). + unfold cos_n in H0; unfold Un_cv in H0; unfold Un_cv in |- *; intros. + cut (0 < eps / Rsqr r). + intro; elim (H0 _ H2); intros N0 H3. + exists N0; intros. + unfold R_dist in |- *; assert (H5 := H3 _ H4). + unfold R_dist in H5; + replace + (Rabs + (Rabs (/ INR (fact (2 * S n)) * r ^ (2 * S n)) / + Rabs (/ INR (fact (2 * n)) * r ^ (2 * n)))) with + (Rsqr r * + Rabs ((-1) ^ S n / INR (fact (2 * S n)) / ((-1) ^ n / INR (fact (2 * n))))). + apply Rmult_lt_reg_l with (/ Rsqr r). + apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption. + pattern (/ Rsqr r) at 1 in |- *; replace (/ Rsqr r) with (Rabs (/ Rsqr r)). + rewrite <- Rabs_mult; rewrite Rmult_minus_distr_l; rewrite Rmult_0_r; + rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); apply H5. + unfold Rsqr in |- *; apply prod_neq_R0; assumption. + rewrite Rabs_Rinv. + rewrite Rabs_right. + reflexivity. + apply Rle_ge; apply Rle_0_sqr. + unfold Rsqr in |- *; apply prod_neq_R0; assumption. + rewrite (Rmult_comm (Rsqr r)); unfold Rdiv in |- *; repeat rewrite Rabs_mult; + rewrite Rabs_Rabsolu; rewrite pow_1_abs; rewrite Rmult_1_l; + repeat rewrite Rmult_assoc; apply Rmult_eq_compat_l. + rewrite Rabs_Rinv. + rewrite Rabs_mult; rewrite (pow_1_abs n); rewrite Rmult_1_l; + rewrite <- Rabs_Rinv. + rewrite Rinv_involutive. + rewrite Rinv_mult_distr. + rewrite Rabs_Rinv. + rewrite Rinv_involutive. + rewrite (Rmult_comm (Rabs (Rabs (r ^ (2 * S n))))); rewrite Rabs_mult; + rewrite Rabs_Rabsolu; rewrite Rmult_assoc; apply Rmult_eq_compat_l. + rewrite Rabs_Rinv. + do 2 rewrite Rabs_Rabsolu; repeat rewrite Rabs_right. + replace (r ^ (2 * S n)) with (r ^ (2 * n) * r * r). + repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. + unfold Rsqr in |- *; ring. + apply pow_nonzero; assumption. + replace (2 * S n)%nat with (S (S (2 * n))). + simpl in |- *; ring. + ring_nat. + apply Rle_ge; apply pow_le; left; apply (cond_pos r). + apply Rle_ge; apply pow_le; left; apply (cond_pos r). + apply Rabs_no_R0; apply pow_nonzero; assumption. + apply Rabs_no_R0; apply INR_fact_neq_0. + apply INR_fact_neq_0. + apply Rabs_no_R0; apply Rinv_neq_0_compat; apply INR_fact_neq_0. + apply Rabs_no_R0; apply pow_nonzero; assumption. + apply INR_fact_neq_0. + apply Rinv_neq_0_compat; apply INR_fact_neq_0. + apply prod_neq_R0. + apply pow_nonzero; discrR. + apply Rinv_neq_0_compat; apply INR_fact_neq_0. + unfold Rdiv in |- *; apply Rmult_lt_0_compat. + apply H1. + apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption. + assert (H0 := cond_pos r); red in |- *; intro; rewrite H1 in H0; + elim (Rlt_irrefl _ H0). Qed. (**********) Lemma continuity_cos : continuity cos. -set (fn := fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N)) * x ^ (2 * N)). -cut (CVN_R fn). -intro; cut (forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)). -intro cv; cut (forall n:nat, continuity (fn n)). -intro; cut (forall x:R, cos x = SFL fn cv x). -intro; cut (continuity (SFL fn cv) -> continuity cos). -intro; apply H1. -apply SFL_continuity; assumption. -unfold continuity in |- *; unfold continuity_pt in |- *; - unfold continue_in in |- *; unfold limit1_in in |- *; - unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; - intros. -elim (H1 x _ H2); intros. -exists x0; intros. -elim H3; intros. -split. -apply H4. -intros; rewrite (H0 x); rewrite (H0 x1); apply H5; apply H6. -intro; unfold cos, SFL in |- *. -case (cv x); case (exist_cos (Rsqr x)); intros. -symmetry in |- *; eapply UL_sequence. -apply u. -unfold cos_in in c; unfold infinit_sum in c; unfold Un_cv in |- *; intros. -elim (c _ H0); intros N0 H1. -exists N0; intros. -unfold R_dist in H1; unfold R_dist, SP in |- *. -replace (sum_f_R0 (fun k:nat => fn k x) n) with - (sum_f_R0 (fun i:nat => cos_n i * Rsqr x ^ i) n). -apply H1; assumption. -apply sum_eq; intros. -unfold cos_n, fn in |- *; apply Rmult_eq_compat_l. -unfold Rsqr in |- *; rewrite pow_sqr; reflexivity. -intro; unfold fn in |- *; - replace (fun x:R => (-1) ^ n / INR (fact (2 * n)) * x ^ (2 * n)) with - (fct_cte ((-1) ^ n / INR (fact (2 * n))) * pow_fct (2 * n))%F; - [ idtac | reflexivity ]. -apply continuity_mult. -apply derivable_continuous; apply derivable_const. -apply derivable_continuous; apply (derivable_pow (2 * n)). -apply CVN_R_CVS; apply X. -apply CVN_R_cos; unfold fn in |- *; reflexivity. +Proof. + set (fn := fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N)) * x ^ (2 * N)). + cut (CVN_R fn). + intro; cut (forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)). + intro cv; cut (forall n:nat, continuity (fn n)). + intro; cut (forall x:R, cos x = SFL fn cv x). + intro; cut (continuity (SFL fn cv) -> continuity cos). + intro; apply H1. + apply SFL_continuity; assumption. + unfold continuity in |- *; unfold continuity_pt in |- *; + unfold continue_in in |- *; unfold limit1_in in |- *; + unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; + intros. + elim (H1 x _ H2); intros. + exists x0; intros. + elim H3; intros. + split. + apply H4. + intros; rewrite (H0 x); rewrite (H0 x1); apply H5; apply H6. + intro; unfold cos, SFL in |- *. + case (cv x); case (exist_cos (Rsqr x)); intros. + symmetry in |- *; eapply UL_sequence. + apply u. + unfold cos_in in c; unfold infinit_sum in c; unfold Un_cv in |- *; intros. + elim (c _ H0); intros N0 H1. + exists N0; intros. + unfold R_dist in H1; unfold R_dist, SP in |- *. + replace (sum_f_R0 (fun k:nat => fn k x) n) with + (sum_f_R0 (fun i:nat => cos_n i * Rsqr x ^ i) n). + apply H1; assumption. + apply sum_eq; intros. + unfold cos_n, fn in |- *; apply Rmult_eq_compat_l. + unfold Rsqr in |- *; rewrite pow_sqr; reflexivity. + intro; unfold fn in |- *; + replace (fun x:R => (-1) ^ n / INR (fact (2 * n)) * x ^ (2 * n)) with + (fct_cte ((-1) ^ n / INR (fact (2 * n))) * pow_fct (2 * n))%F; + [ idtac | reflexivity ]. + apply continuity_mult. + apply derivable_continuous; apply derivable_const. + apply derivable_continuous; apply (derivable_pow (2 * n)). + apply CVN_R_CVS; apply X. + apply CVN_R_cos; unfold fn in |- *; reflexivity. Qed. (**********) Lemma continuity_sin : continuity sin. -unfold continuity in |- *; intro. -assert (H0 := continuity_cos (PI / 2 - x)). -unfold continuity_pt in H0; unfold continue_in in H0; unfold limit1_in in H0; - unfold limit_in in H0; simpl in H0; unfold R_dist in H0; - unfold continuity_pt in |- *; unfold continue_in in |- *; - unfold limit1_in in |- *; unfold limit_in in |- *; - simpl in |- *; unfold R_dist in |- *; intros. -elim (H0 _ H); intros. -exists x0; intros. -elim H1; intros. -split. -assumption. -intros; rewrite <- (cos_shift x); rewrite <- (cos_shift x1); apply H3. -elim H4; intros. -split. -unfold D_x, no_cond in |- *; split. -trivial. -red in |- *; intro; unfold D_x, no_cond in H5; elim H5; intros _ H8; elim H8; - rewrite <- (Ropp_involutive x); rewrite <- (Ropp_involutive x1); - apply Ropp_eq_compat; apply Rplus_eq_reg_l with (PI / 2); - apply H7. -replace (PI / 2 - x1 - (PI / 2 - x)) with (x - x1); [ idtac | ring ]; - rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr'; apply H6. +Proof. + unfold continuity in |- *; intro. + assert (H0 := continuity_cos (PI / 2 - x)). + unfold continuity_pt in H0; unfold continue_in in H0; unfold limit1_in in H0; + unfold limit_in in H0; simpl in H0; unfold R_dist in H0; + unfold continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros. + elim (H0 _ H); intros. + exists x0; intros. + elim H1; intros. + split. + assumption. + intros; rewrite <- (cos_shift x); rewrite <- (cos_shift x1); apply H3. + elim H4; intros. + split. + unfold D_x, no_cond in |- *; split. + trivial. + red in |- *; intro; unfold D_x, no_cond in H5; elim H5; intros _ H8; elim H8; + rewrite <- (Ropp_involutive x); rewrite <- (Ropp_involutive x1); + apply Ropp_eq_compat; apply Rplus_eq_reg_l with (PI / 2); + apply H7. + replace (PI / 2 - x1 - (PI / 2 - x)) with (x - x1); [ idtac | ring ]; + rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr'; apply H6. Qed. Lemma CVN_R_sin : - forall fn:nat -> R -> R, - fn = - (fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N + 1)) * x ^ (2 * N)) -> - CVN_R fn. -unfold CVN_R in |- *; unfold CVN_r in |- *; intros fn H r. -apply existT with (fun n:nat => / INR (fact (2 * n + 1)) * r ^ (2 * n)). -cut - (sigT - (fun l:R => - Un_cv - (fun n:nat => - sum_f_R0 - (fun k:nat => Rabs (/ INR (fact (2 * k + 1)) * r ^ (2 * k))) n) - l)). -intro X; elim X; intros. -apply existT with x. -split. -apply p. -intros; rewrite H; unfold Rdiv in |- *; do 2 rewrite Rabs_mult; - rewrite pow_1_abs; rewrite Rmult_1_l. -cut (0 < / INR (fact (2 * n + 1))). -intro; rewrite (Rabs_right _ (Rle_ge _ _ (Rlt_le _ _ H1))). -apply Rmult_le_compat_l. -left; apply H1. -rewrite <- RPow_abs; apply pow_maj_Rabs. -rewrite Rabs_Rabsolu; unfold Boule in H0; rewrite Rminus_0_r in H0; left; - apply H0. -apply Rinv_0_lt_compat; apply INR_fact_lt_0. -cut ((r:R) <> 0). -intro; apply Alembert_C2. -intro; apply Rabs_no_R0. -apply prod_neq_R0. -apply Rinv_neq_0_compat; apply INR_fact_neq_0. -apply pow_nonzero; assumption. -assert (H1 := Alembert_sin). -unfold sin_n in H1; unfold Un_cv in H1; unfold Un_cv in |- *; intros. -cut (0 < eps / Rsqr r). -intro; elim (H1 _ H3); intros N0 H4. -exists N0; intros. -unfold R_dist in |- *; assert (H6 := H4 _ H5). -unfold R_dist in H5; - replace - (Rabs - (Rabs (/ INR (fact (2 * S n + 1)) * r ^ (2 * S n)) / - Rabs (/ INR (fact (2 * n + 1)) * r ^ (2 * n)))) with - (Rsqr r * - Rabs - ((-1) ^ S n / INR (fact (2 * S n + 1)) / - ((-1) ^ n / INR (fact (2 * n + 1))))). -apply Rmult_lt_reg_l with (/ Rsqr r). -apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption. -pattern (/ Rsqr r) at 1 in |- *; rewrite <- (Rabs_right (/ Rsqr r)). -rewrite <- Rabs_mult. -rewrite Rmult_minus_distr_l. -rewrite Rmult_0_r; rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_l; rewrite <- (Rmult_comm eps). -apply H6. -unfold Rsqr in |- *; apply prod_neq_R0; assumption. -apply Rle_ge; left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption. -unfold Rdiv in |- *; rewrite (Rmult_comm (Rsqr r)); repeat rewrite Rabs_mult; - rewrite Rabs_Rabsolu; rewrite pow_1_abs. -rewrite Rmult_1_l. -repeat rewrite Rmult_assoc; apply Rmult_eq_compat_l. -rewrite Rinv_mult_distr. -rewrite Rinv_involutive. -rewrite Rabs_mult. -rewrite Rabs_Rinv. -rewrite pow_1_abs; rewrite Rinv_1; rewrite Rmult_1_l. -rewrite Rinv_mult_distr. -rewrite <- Rabs_Rinv. -rewrite Rinv_involutive. -rewrite Rabs_mult. -do 2 rewrite Rabs_Rabsolu. -rewrite (Rmult_comm (Rabs (r ^ (2 * S n)))). -rewrite Rmult_assoc; apply Rmult_eq_compat_l. -rewrite Rabs_Rinv. -rewrite Rabs_Rabsolu. -repeat rewrite Rabs_right. -replace (r ^ (2 * S n)) with (r ^ (2 * n) * r * r). -do 2 rewrite <- Rmult_assoc. -rewrite <- Rinv_l_sym. -unfold Rsqr in |- *; ring. -apply pow_nonzero; assumption. -replace (2 * S n)%nat with (S (S (2 * n))). -simpl in |- *; ring. -apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR; - ring. -apply Rle_ge; apply pow_le; left; apply (cond_pos r). -apply Rle_ge; apply pow_le; left; apply (cond_pos r). -apply Rabs_no_R0; apply pow_nonzero; assumption. -apply INR_fact_neq_0. -apply Rinv_neq_0_compat; apply INR_fact_neq_0. -apply Rabs_no_R0; apply Rinv_neq_0_compat; apply INR_fact_neq_0. -apply Rabs_no_R0; apply pow_nonzero; assumption. -apply pow_nonzero; discrR. -apply INR_fact_neq_0. -apply pow_nonzero; discrR. -apply Rinv_neq_0_compat; apply INR_fact_neq_0. -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption ]. -assert (H0 := cond_pos r); red in |- *; intro; rewrite H1 in H0; - elim (Rlt_irrefl _ H0). + forall fn:nat -> R -> R, + fn = + (fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N + 1)) * x ^ (2 * N)) -> + CVN_R fn. +Proof. + unfold CVN_R in |- *; unfold CVN_r in |- *; intros fn H r. + apply existT with (fun n:nat => / INR (fact (2 * n + 1)) * r ^ (2 * n)). + cut + (sigT + (fun l:R => + Un_cv + (fun n:nat => + sum_f_R0 + (fun k:nat => Rabs (/ INR (fact (2 * k + 1)) * r ^ (2 * k))) n) + l)). + intro X; elim X; intros. + apply existT with x. + split. + apply p. + intros; rewrite H; unfold Rdiv in |- *; do 2 rewrite Rabs_mult; + rewrite pow_1_abs; rewrite Rmult_1_l. + cut (0 < / INR (fact (2 * n + 1))). + intro; rewrite (Rabs_right _ (Rle_ge _ _ (Rlt_le _ _ H1))). + apply Rmult_le_compat_l. + left; apply H1. + rewrite <- RPow_abs; apply pow_maj_Rabs. + rewrite Rabs_Rabsolu; unfold Boule in H0; rewrite Rminus_0_r in H0; left; + apply H0. + apply Rinv_0_lt_compat; apply INR_fact_lt_0. + cut ((r:R) <> 0). + intro; apply Alembert_C2. + intro; apply Rabs_no_R0. + apply prod_neq_R0. + apply Rinv_neq_0_compat; apply INR_fact_neq_0. + apply pow_nonzero; assumption. + assert (H1 := Alembert_sin). + unfold sin_n in H1; unfold Un_cv in H1; unfold Un_cv in |- *; intros. + cut (0 < eps / Rsqr r). + intro; elim (H1 _ H3); intros N0 H4. + exists N0; intros. + unfold R_dist in |- *; assert (H6 := H4 _ H5). + unfold R_dist in H5; + replace + (Rabs + (Rabs (/ INR (fact (2 * S n + 1)) * r ^ (2 * S n)) / + Rabs (/ INR (fact (2 * n + 1)) * r ^ (2 * n)))) with + (Rsqr r * + Rabs + ((-1) ^ S n / INR (fact (2 * S n + 1)) / + ((-1) ^ n / INR (fact (2 * n + 1))))). + apply Rmult_lt_reg_l with (/ Rsqr r). + apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption. + pattern (/ Rsqr r) at 1 in |- *; rewrite <- (Rabs_right (/ Rsqr r)). + rewrite <- Rabs_mult. + rewrite Rmult_minus_distr_l. + rewrite Rmult_0_r; rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_l; rewrite <- (Rmult_comm eps). + apply H6. + unfold Rsqr in |- *; apply prod_neq_R0; assumption. + apply Rle_ge; left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption. + unfold Rdiv in |- *; rewrite (Rmult_comm (Rsqr r)); repeat rewrite Rabs_mult; + rewrite Rabs_Rabsolu; rewrite pow_1_abs. + rewrite Rmult_1_l. + repeat rewrite Rmult_assoc; apply Rmult_eq_compat_l. + rewrite Rinv_mult_distr. + rewrite Rinv_involutive. + rewrite Rabs_mult. + rewrite Rabs_Rinv. + rewrite pow_1_abs; rewrite Rinv_1; rewrite Rmult_1_l. + rewrite Rinv_mult_distr. + rewrite <- Rabs_Rinv. + rewrite Rinv_involutive. + rewrite Rabs_mult. + do 2 rewrite Rabs_Rabsolu. + rewrite (Rmult_comm (Rabs (r ^ (2 * S n)))). + rewrite Rmult_assoc; apply Rmult_eq_compat_l. + rewrite Rabs_Rinv. + rewrite Rabs_Rabsolu. + repeat rewrite Rabs_right. + replace (r ^ (2 * S n)) with (r ^ (2 * n) * r * r). + do 2 rewrite <- Rmult_assoc. + rewrite <- Rinv_l_sym. + unfold Rsqr in |- *; ring. + apply pow_nonzero; assumption. + replace (2 * S n)%nat with (S (S (2 * n))). + simpl in |- *; ring. + ring_nat. + apply Rle_ge; apply pow_le; left; apply (cond_pos r). + apply Rle_ge; apply pow_le; left; apply (cond_pos r). + apply Rabs_no_R0; apply pow_nonzero; assumption. + apply INR_fact_neq_0. + apply Rinv_neq_0_compat; apply INR_fact_neq_0. + apply Rabs_no_R0; apply Rinv_neq_0_compat; apply INR_fact_neq_0. + apply Rabs_no_R0; apply pow_nonzero; assumption. + apply pow_nonzero; discrR. + apply INR_fact_neq_0. + apply pow_nonzero; discrR. + apply Rinv_neq_0_compat; apply INR_fact_neq_0. + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption ]. + assert (H0 := cond_pos r); red in |- *; intro; rewrite H1 in H0; + elim (Rlt_irrefl _ H0). Qed. -(* (sin h)/h -> 1 when h -> 0 *) +(** (sin h)/h -> 1 when h -> 0 *) Lemma derivable_pt_lim_sin_0 : derivable_pt_lim sin 0 1. -unfold derivable_pt_lim in |- *; intros. -set - (fn := fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N + 1)) * x ^ (2 * N)). -cut (CVN_R fn). -intro; cut (forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)). -intro cv. -set (r := mkposreal _ Rlt_0_1). -cut (CVN_r fn r). -intro; cut (forall (n:nat) (y:R), Boule 0 r y -> continuity_pt (fn n) y). -intro; cut (Boule 0 r 0). -intro; assert (H2 := SFL_continuity_pt _ cv _ X0 H0 _ H1). -unfold continuity_pt in H2; unfold continue_in in H2; unfold limit1_in in H2; - unfold limit_in in H2; simpl in H2; unfold R_dist in H2. -elim (H2 _ H); intros alp H3. -elim H3; intros. -exists (mkposreal _ H4). -simpl in |- *; intros. -rewrite sin_0; rewrite Rplus_0_l; unfold Rminus in |- *; rewrite Ropp_0; - rewrite Rplus_0_r. -cut (Rabs (SFL fn cv h - SFL fn cv 0) < eps). -intro; cut (SFL fn cv 0 = 1). -intro; cut (SFL fn cv h = sin h / h). -intro; rewrite H9 in H8; rewrite H10 in H8. -apply H8. -unfold SFL, sin in |- *. -case (cv h); intros. -case (exist_sin (Rsqr h)); intros. -unfold Rdiv in |- *; rewrite (Rinv_r_simpl_m h x0 H6). -eapply UL_sequence. -apply u. -unfold sin_in in s; unfold sin_n, infinit_sum in s; - unfold SP, fn, Un_cv in |- *; intros. -elim (s _ H10); intros N0 H11. -exists N0; intros. -unfold R_dist in |- *; unfold R_dist in H11. -replace - (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * h ^ (2 * k)) n) - with - (sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i + 1)) * Rsqr h ^ i) n). -apply H11; assumption. -apply sum_eq; intros; apply Rmult_eq_compat_l; unfold Rsqr in |- *; - rewrite pow_sqr; reflexivity. -unfold SFL, sin in |- *. -case (cv 0); intros. -eapply UL_sequence. -apply u. -unfold SP, fn in |- *; unfold Un_cv in |- *; intros; exists 1%nat; intros. -unfold R_dist in |- *; - replace - (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * 0 ^ (2 * k)) n) - with 1. -unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. -rewrite decomp_sum. -simpl in |- *; rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite Rinv_1; - rewrite Rmult_1_r; pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; - apply Rplus_eq_compat_l. -symmetry in |- *; apply sum_eq_R0; intros. -rewrite Rmult_0_l; rewrite Rmult_0_r; reflexivity. -unfold ge in H10; apply lt_le_trans with 1%nat; [ apply lt_n_Sn | apply H10 ]. -apply H5. -split. -unfold D_x, no_cond in |- *; split. -trivial. -apply (sym_not_eq (A:=R)); apply H6. -unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply H7. -unfold Boule in |- *; unfold Rminus in |- *; rewrite Ropp_0; - rewrite Rplus_0_r; rewrite Rabs_R0; apply (cond_pos r). -intros; unfold fn in |- *; - replace (fun x:R => (-1) ^ n / INR (fact (2 * n + 1)) * x ^ (2 * n)) with - (fct_cte ((-1) ^ n / INR (fact (2 * n + 1))) * pow_fct (2 * n))%F; - [ idtac | reflexivity ]. -apply continuity_pt_mult. -apply derivable_continuous_pt. -apply derivable_pt_const. -apply derivable_continuous_pt. -apply (derivable_pt_pow (2 * n) y). -apply (X r). -apply (CVN_R_CVS _ X). -apply CVN_R_sin; unfold fn in |- *; reflexivity. +Proof. + unfold derivable_pt_lim in |- *; intros. + set + (fn := fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N + 1)) * x ^ (2 * N)). + cut (CVN_R fn). + intro; cut (forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)). + intro cv. + set (r := mkposreal _ Rlt_0_1). + cut (CVN_r fn r). + intro; cut (forall (n:nat) (y:R), Boule 0 r y -> continuity_pt (fn n) y). + intro; cut (Boule 0 r 0). + intro; assert (H2 := SFL_continuity_pt _ cv _ X0 H0 _ H1). + unfold continuity_pt in H2; unfold continue_in in H2; unfold limit1_in in H2; + unfold limit_in in H2; simpl in H2; unfold R_dist in H2. + elim (H2 _ H); intros alp H3. + elim H3; intros. + exists (mkposreal _ H4). + simpl in |- *; intros. + rewrite sin_0; rewrite Rplus_0_l; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r. + cut (Rabs (SFL fn cv h - SFL fn cv 0) < eps). + intro; cut (SFL fn cv 0 = 1). + intro; cut (SFL fn cv h = sin h / h). + intro; rewrite H9 in H8; rewrite H10 in H8. + apply H8. + unfold SFL, sin in |- *. + case (cv h); intros. + case (exist_sin (Rsqr h)); intros. + unfold Rdiv in |- *; rewrite (Rinv_r_simpl_m h x0 H6). + eapply UL_sequence. + apply u. + unfold sin_in in s; unfold sin_n, infinit_sum in s; + unfold SP, fn, Un_cv in |- *; intros. + elim (s _ H10); intros N0 H11. + exists N0; intros. + unfold R_dist in |- *; unfold R_dist in H11. + replace + (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * h ^ (2 * k)) n) + with + (sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i + 1)) * Rsqr h ^ i) n). + apply H11; assumption. + apply sum_eq; intros; apply Rmult_eq_compat_l; unfold Rsqr in |- *; + rewrite pow_sqr; reflexivity. + unfold SFL, sin in |- *. + case (cv 0); intros. + eapply UL_sequence. + apply u. + unfold SP, fn in |- *; unfold Un_cv in |- *; intros; exists 1%nat; intros. + unfold R_dist in |- *; + replace + (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * 0 ^ (2 * k)) n) + with 1. + unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. + rewrite decomp_sum. + simpl in |- *; rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite Rinv_1; + rewrite Rmult_1_r; pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; + apply Rplus_eq_compat_l. + symmetry in |- *; apply sum_eq_R0; intros. + rewrite Rmult_0_l; rewrite Rmult_0_r; reflexivity. + unfold ge in H10; apply lt_le_trans with 1%nat; [ apply lt_n_Sn | apply H10 ]. + apply H5. + split. + unfold D_x, no_cond in |- *; split. + trivial. + apply (sym_not_eq (A:=R)); apply H6. + unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply H7. + unfold Boule in |- *; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; rewrite Rabs_R0; apply (cond_pos r). + intros; unfold fn in |- *; + replace (fun x:R => (-1) ^ n / INR (fact (2 * n + 1)) * x ^ (2 * n)) with + (fct_cte ((-1) ^ n / INR (fact (2 * n + 1))) * pow_fct (2 * n))%F; + [ idtac | reflexivity ]. + apply continuity_pt_mult. + apply derivable_continuous_pt. + apply derivable_pt_const. + apply derivable_continuous_pt. + apply (derivable_pt_pow (2 * n) y). + apply (X r). + apply (CVN_R_CVS _ X). + apply CVN_R_sin; unfold fn in |- *; reflexivity. Qed. -(* ((cos h)-1)/h -> 0 when h -> 0 *) +(** ((cos h)-1)/h -> 0 when h -> 0 *) Lemma derivable_pt_lim_cos_0 : derivable_pt_lim cos 0 0. -unfold derivable_pt_lim in |- *; intros. -assert (H0 := derivable_pt_lim_sin_0). -unfold derivable_pt_lim in H0. -cut (0 < eps / 2). -intro; elim (H0 _ H1); intros del H2. -cut (continuity_pt sin 0). -intro; unfold continuity_pt in H3; unfold continue_in in H3; - unfold limit1_in in H3; unfold limit_in in H3; simpl in H3; - unfold R_dist in H3. -cut (0 < eps / 2); [ intro | assumption ]. -elim (H3 _ H4); intros del_c H5. -cut (0 < Rmin del del_c). -intro; set (delta := mkposreal _ H6). -exists delta; intros. -rewrite Rplus_0_l; replace (cos h - cos 0) with (-2 * Rsqr (sin (h / 2))). -unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r. -unfold Rdiv in |- *; do 2 rewrite Ropp_mult_distr_l_reverse. -rewrite Rabs_Ropp. -replace (2 * Rsqr (sin (h * / 2)) * / h) with - (sin (h / 2) * (sin (h / 2) / (h / 2) - 1) + sin (h / 2)). -apply Rle_lt_trans with - (Rabs (sin (h / 2) * (sin (h / 2) / (h / 2) - 1)) + Rabs (sin (h / 2))). -apply Rabs_triang. -rewrite (double_var eps); apply Rplus_lt_compat. -apply Rle_lt_trans with (Rabs (sin (h / 2) / (h / 2) - 1)). -rewrite Rabs_mult; rewrite Rmult_comm; - pattern (Rabs (sin (h / 2) / (h / 2) - 1)) at 2 in |- *; - rewrite <- Rmult_1_r; apply Rmult_le_compat_l. -apply Rabs_pos. -assert (H9 := SIN_bound (h / 2)). -unfold Rabs in |- *; case (Rcase_abs (sin (h / 2))); intro. -pattern 1 at 3 in |- *; rewrite <- (Ropp_involutive 1). -apply Ropp_le_contravar. -elim H9; intros; assumption. -elim H9; intros; assumption. -cut (Rabs (h / 2) < del). -intro; cut (h / 2 <> 0). -intro; assert (H11 := H2 _ H10 H9). -rewrite Rplus_0_l in H11; rewrite sin_0 in H11. -rewrite Rminus_0_r in H11; apply H11. -unfold Rdiv in |- *; apply prod_neq_R0. -apply H7. -apply Rinv_neq_0_compat; discrR. -apply Rlt_trans with (del / 2). -unfold Rdiv in |- *; rewrite Rabs_mult. -rewrite (Rabs_right (/ 2)). -do 2 rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l. -apply Rinv_0_lt_compat; prove_sup0. -apply Rlt_le_trans with (pos delta). -apply H8. -unfold delta in |- *; simpl in |- *; apply Rmin_l. -apply Rle_ge; left; apply Rinv_0_lt_compat; prove_sup0. -rewrite <- (Rplus_0_r (del / 2)); pattern del at 1 in |- *; - rewrite (double_var del); apply Rplus_lt_compat_l; - unfold Rdiv in |- *; apply Rmult_lt_0_compat. -apply (cond_pos del). -apply Rinv_0_lt_compat; prove_sup0. -elim H5; intros; assert (H11 := H10 (h / 2)). -rewrite sin_0 in H11; do 2 rewrite Rminus_0_r in H11. -apply H11. -split. -unfold D_x, no_cond in |- *; split. -trivial. -apply (sym_not_eq (A:=R)); unfold Rdiv in |- *; apply prod_neq_R0. -apply H7. -apply Rinv_neq_0_compat; discrR. -apply Rlt_trans with (del_c / 2). -unfold Rdiv in |- *; rewrite Rabs_mult. -rewrite (Rabs_right (/ 2)). -do 2 rewrite <- (Rmult_comm (/ 2)). -apply Rmult_lt_compat_l. -apply Rinv_0_lt_compat; prove_sup0. -apply Rlt_le_trans with (pos delta). -apply H8. -unfold delta in |- *; simpl in |- *; apply Rmin_r. -apply Rle_ge; left; apply Rinv_0_lt_compat; prove_sup0. -rewrite <- (Rplus_0_r (del_c / 2)); pattern del_c at 2 in |- *; - rewrite (double_var del_c); apply Rplus_lt_compat_l. -unfold Rdiv in |- *; apply Rmult_lt_0_compat. -apply H9. -apply Rinv_0_lt_compat; prove_sup0. -rewrite Rmult_minus_distr_l; rewrite Rmult_1_r; unfold Rminus in |- *; - rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; - rewrite (Rmult_comm 2); unfold Rdiv, Rsqr in |- *. -repeat rewrite Rmult_assoc. -repeat apply Rmult_eq_compat_l. -rewrite Rinv_mult_distr. -rewrite Rinv_involutive. -apply Rmult_comm. -discrR. -apply H7. -apply Rinv_neq_0_compat; discrR. -pattern h at 2 in |- *; replace h with (2 * (h / 2)). -rewrite (cos_2a_sin (h / 2)). -rewrite cos_0; unfold Rsqr in |- *; ring. -unfold Rdiv in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m. -discrR. -unfold Rmin in |- *; case (Rle_dec del del_c); intro. -apply (cond_pos del). -elim H5; intros; assumption. -apply continuity_sin. -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. +Proof. + unfold derivable_pt_lim in |- *; intros. + assert (H0 := derivable_pt_lim_sin_0). + unfold derivable_pt_lim in H0. + cut (0 < eps / 2). + intro; elim (H0 _ H1); intros del H2. + cut (continuity_pt sin 0). + intro; unfold continuity_pt in H3; unfold continue_in in H3; + unfold limit1_in in H3; unfold limit_in in H3; simpl in H3; + unfold R_dist in H3. + cut (0 < eps / 2); [ intro | assumption ]. + elim (H3 _ H4); intros del_c H5. + cut (0 < Rmin del del_c). + intro; set (delta := mkposreal _ H6). + exists delta; intros. + rewrite Rplus_0_l; replace (cos h - cos 0) with (-2 * Rsqr (sin (h / 2))). + unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r. + unfold Rdiv in |- *; do 2 rewrite Ropp_mult_distr_l_reverse. + rewrite Rabs_Ropp. + replace (2 * Rsqr (sin (h * / 2)) * / h) with + (sin (h / 2) * (sin (h / 2) / (h / 2) - 1) + sin (h / 2)). + apply Rle_lt_trans with + (Rabs (sin (h / 2) * (sin (h / 2) / (h / 2) - 1)) + Rabs (sin (h / 2))). + apply Rabs_triang. + rewrite (double_var eps); apply Rplus_lt_compat. + apply Rle_lt_trans with (Rabs (sin (h / 2) / (h / 2) - 1)). + rewrite Rabs_mult; rewrite Rmult_comm; + pattern (Rabs (sin (h / 2) / (h / 2) - 1)) at 2 in |- *; + rewrite <- Rmult_1_r; apply Rmult_le_compat_l. + apply Rabs_pos. + assert (H9 := SIN_bound (h / 2)). + unfold Rabs in |- *; case (Rcase_abs (sin (h / 2))); intro. + pattern 1 at 3 in |- *; rewrite <- (Ropp_involutive 1). + apply Ropp_le_contravar. + elim H9; intros; assumption. + elim H9; intros; assumption. + cut (Rabs (h / 2) < del). + intro; cut (h / 2 <> 0). + intro; assert (H11 := H2 _ H10 H9). + rewrite Rplus_0_l in H11; rewrite sin_0 in H11. + rewrite Rminus_0_r in H11; apply H11. + unfold Rdiv in |- *; apply prod_neq_R0. + apply H7. + apply Rinv_neq_0_compat; discrR. + apply Rlt_trans with (del / 2). + unfold Rdiv in |- *; rewrite Rabs_mult. + rewrite (Rabs_right (/ 2)). + do 2 rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l. + apply Rinv_0_lt_compat; prove_sup0. + apply Rlt_le_trans with (pos delta). + apply H8. + unfold delta in |- *; simpl in |- *; apply Rmin_l. + apply Rle_ge; left; apply Rinv_0_lt_compat; prove_sup0. + rewrite <- (Rplus_0_r (del / 2)); pattern del at 1 in |- *; + rewrite (double_var del); apply Rplus_lt_compat_l; + unfold Rdiv in |- *; apply Rmult_lt_0_compat. + apply (cond_pos del). + apply Rinv_0_lt_compat; prove_sup0. + elim H5; intros; assert (H11 := H10 (h / 2)). + rewrite sin_0 in H11; do 2 rewrite Rminus_0_r in H11. + apply H11. + split. + unfold D_x, no_cond in |- *; split. + trivial. + apply (sym_not_eq (A:=R)); unfold Rdiv in |- *; apply prod_neq_R0. + apply H7. + apply Rinv_neq_0_compat; discrR. + apply Rlt_trans with (del_c / 2). + unfold Rdiv in |- *; rewrite Rabs_mult. + rewrite (Rabs_right (/ 2)). + do 2 rewrite <- (Rmult_comm (/ 2)). + apply Rmult_lt_compat_l. + apply Rinv_0_lt_compat; prove_sup0. + apply Rlt_le_trans with (pos delta). + apply H8. + unfold delta in |- *; simpl in |- *; apply Rmin_r. + apply Rle_ge; left; apply Rinv_0_lt_compat; prove_sup0. + rewrite <- (Rplus_0_r (del_c / 2)); pattern del_c at 2 in |- *; + rewrite (double_var del_c); apply Rplus_lt_compat_l. + unfold Rdiv in |- *; apply Rmult_lt_0_compat. + apply H9. + apply Rinv_0_lt_compat; prove_sup0. + rewrite Rmult_minus_distr_l; rewrite Rmult_1_r; unfold Rminus in |- *; + rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; + rewrite (Rmult_comm 2); unfold Rdiv, Rsqr in |- *. + repeat rewrite Rmult_assoc. + repeat apply Rmult_eq_compat_l. + rewrite Rinv_mult_distr. + rewrite Rinv_involutive. + apply Rmult_comm. + discrR. + apply H7. + apply Rinv_neq_0_compat; discrR. + pattern h at 2 in |- *; replace h with (2 * (h / 2)). + rewrite (cos_2a_sin (h / 2)). + rewrite cos_0; unfold Rsqr in |- *; ring. + unfold Rdiv in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m. + discrR. + unfold Rmin in |- *; case (Rle_dec del del_c); intro. + apply (cond_pos del). + elim H5; intros; assumption. + apply continuity_sin. + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. Qed. (**********) Theorem derivable_pt_lim_sin : forall x:R, derivable_pt_lim sin x (cos x). -intro; assert (H0 := derivable_pt_lim_sin_0). -assert (H := derivable_pt_lim_cos_0). -unfold derivable_pt_lim in H0, H. -unfold derivable_pt_lim in |- *; intros. -cut (0 < eps / 2); - [ intro - | unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ apply H1 | apply Rinv_0_lt_compat; prove_sup0 ] ]. -elim (H0 _ H2); intros alp1 H3. -elim (H _ H2); intros alp2 H4. -set (alp := Rmin alp1 alp2). -cut (0 < alp). -intro; exists (mkposreal _ H5); intros. -replace ((sin (x + h) - sin x) / h - cos x) with - (sin x * ((cos h - 1) / h) + cos x * (sin h / h - 1)). -apply Rle_lt_trans with - (Rabs (sin x * ((cos h - 1) / h)) + Rabs (cos x * (sin h / h - 1))). -apply Rabs_triang. -rewrite (double_var eps); apply Rplus_lt_compat. -apply Rle_lt_trans with (Rabs ((cos h - 1) / h)). -rewrite Rabs_mult; rewrite Rmult_comm; - pattern (Rabs ((cos h - 1) / h)) at 2 in |- *; rewrite <- Rmult_1_r; - apply Rmult_le_compat_l. -apply Rabs_pos. -assert (H8 := SIN_bound x); elim H8; intros. -unfold Rabs in |- *; case (Rcase_abs (sin x)); intro. -rewrite <- (Ropp_involutive 1). -apply Ropp_le_contravar; assumption. -assumption. -cut (Rabs h < alp2). -intro; assert (H9 := H4 _ H6 H8). -rewrite cos_0 in H9; rewrite Rplus_0_l in H9; rewrite Rminus_0_r in H9; - apply H9. -apply Rlt_le_trans with alp. -apply H7. -unfold alp in |- *; apply Rmin_r. -apply Rle_lt_trans with (Rabs (sin h / h - 1)). -rewrite Rabs_mult; rewrite Rmult_comm; - pattern (Rabs (sin h / h - 1)) at 2 in |- *; rewrite <- Rmult_1_r; - apply Rmult_le_compat_l. -apply Rabs_pos. -assert (H8 := COS_bound x); elim H8; intros. -unfold Rabs in |- *; case (Rcase_abs (cos x)); intro. -rewrite <- (Ropp_involutive 1); apply Ropp_le_contravar; assumption. -assumption. -cut (Rabs h < alp1). -intro; assert (H9 := H3 _ H6 H8). -rewrite sin_0 in H9; rewrite Rplus_0_l in H9; rewrite Rminus_0_r in H9; - apply H9. -apply Rlt_le_trans with alp. -apply H7. -unfold alp in |- *; apply Rmin_l. -rewrite sin_plus; unfold Rminus, Rdiv in |- *; - repeat rewrite Rmult_plus_distr_r; repeat rewrite Rmult_plus_distr_l; - repeat rewrite Rmult_assoc; repeat rewrite Rplus_assoc; - apply Rplus_eq_compat_l. -rewrite (Rplus_comm (sin x * (-1 * / h))); repeat rewrite Rplus_assoc; - apply Rplus_eq_compat_l. -rewrite Ropp_mult_distr_r_reverse; rewrite Ropp_mult_distr_l_reverse; - rewrite Rmult_1_r; rewrite Rmult_1_l; rewrite Ropp_mult_distr_r_reverse; - rewrite <- Ropp_mult_distr_l_reverse; apply Rplus_comm. -unfold alp in |- *; unfold Rmin in |- *; case (Rle_dec alp1 alp2); intro. -apply (cond_pos alp1). -apply (cond_pos alp2). +Proof. + intro; assert (H0 := derivable_pt_lim_sin_0). + assert (H := derivable_pt_lim_cos_0). + unfold derivable_pt_lim in H0, H. + unfold derivable_pt_lim in |- *; intros. + cut (0 < eps / 2); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ apply H1 | apply Rinv_0_lt_compat; prove_sup0 ] ]. + elim (H0 _ H2); intros alp1 H3. + elim (H _ H2); intros alp2 H4. + set (alp := Rmin alp1 alp2). + cut (0 < alp). + intro; exists (mkposreal _ H5); intros. + replace ((sin (x + h) - sin x) / h - cos x) with + (sin x * ((cos h - 1) / h) + cos x * (sin h / h - 1)). + apply Rle_lt_trans with + (Rabs (sin x * ((cos h - 1) / h)) + Rabs (cos x * (sin h / h - 1))). + apply Rabs_triang. + rewrite (double_var eps); apply Rplus_lt_compat. + apply Rle_lt_trans with (Rabs ((cos h - 1) / h)). + rewrite Rabs_mult; rewrite Rmult_comm; + pattern (Rabs ((cos h - 1) / h)) at 2 in |- *; rewrite <- Rmult_1_r; + apply Rmult_le_compat_l. + apply Rabs_pos. + assert (H8 := SIN_bound x); elim H8; intros. + unfold Rabs in |- *; case (Rcase_abs (sin x)); intro. + rewrite <- (Ropp_involutive 1). + apply Ropp_le_contravar; assumption. + assumption. + cut (Rabs h < alp2). + intro; assert (H9 := H4 _ H6 H8). + rewrite cos_0 in H9; rewrite Rplus_0_l in H9; rewrite Rminus_0_r in H9; + apply H9. + apply Rlt_le_trans with alp. + apply H7. + unfold alp in |- *; apply Rmin_r. + apply Rle_lt_trans with (Rabs (sin h / h - 1)). + rewrite Rabs_mult; rewrite Rmult_comm; + pattern (Rabs (sin h / h - 1)) at 2 in |- *; rewrite <- Rmult_1_r; + apply Rmult_le_compat_l. + apply Rabs_pos. + assert (H8 := COS_bound x); elim H8; intros. + unfold Rabs in |- *; case (Rcase_abs (cos x)); intro. + rewrite <- (Ropp_involutive 1); apply Ropp_le_contravar; assumption. + assumption. + cut (Rabs h < alp1). + intro; assert (H9 := H3 _ H6 H8). + rewrite sin_0 in H9; rewrite Rplus_0_l in H9; rewrite Rminus_0_r in H9; + apply H9. + apply Rlt_le_trans with alp. + apply H7. + unfold alp in |- *; apply Rmin_l. + rewrite sin_plus; unfold Rminus, Rdiv in |- *; + repeat rewrite Rmult_plus_distr_r; repeat rewrite Rmult_plus_distr_l; + repeat rewrite Rmult_assoc; repeat rewrite Rplus_assoc; + apply Rplus_eq_compat_l. + rewrite (Rplus_comm (sin x * (-1 * / h))); repeat rewrite Rplus_assoc; + apply Rplus_eq_compat_l. + rewrite Ropp_mult_distr_r_reverse; rewrite Ropp_mult_distr_l_reverse; + rewrite Rmult_1_r; rewrite Rmult_1_l; rewrite Ropp_mult_distr_r_reverse; + rewrite <- Ropp_mult_distr_l_reverse; apply Rplus_comm. + unfold alp in |- *; unfold Rmin in |- *; case (Rle_dec alp1 alp2); intro. + apply (cond_pos alp1). + apply (cond_pos alp2). Qed. Lemma derivable_pt_lim_cos : forall x:R, derivable_pt_lim cos x (- sin x). -intro; cut (forall h:R, sin (h + PI / 2) = cos h). -intro; replace (- sin x) with (cos (x + PI / 2) * (1 + 0)). -generalize (derivable_pt_lim_comp (id + fct_cte (PI / 2))%F sin); intros. -cut (derivable_pt_lim (id + fct_cte (PI / 2)) x (1 + 0)). -cut (derivable_pt_lim sin ((id + fct_cte (PI / 2))%F x) (cos (x + PI / 2))). -intros; generalize (H0 _ _ _ H2 H1); - replace (comp sin (id + fct_cte (PI / 2))%F) with - (fun x:R => sin (x + PI / 2)); [ idtac | reflexivity ]. -unfold derivable_pt_lim in |- *; intros. -elim (H3 eps H4); intros. -exists x0. -intros; rewrite <- (H (x + h)); rewrite <- (H x); apply H5; assumption. -apply derivable_pt_lim_sin. -apply derivable_pt_lim_plus. -apply derivable_pt_lim_id. -apply derivable_pt_lim_const. -rewrite sin_cos; rewrite <- (Rplus_comm x); ring. -intro; rewrite cos_sin; rewrite Rplus_comm; reflexivity. +Proof. + intro; cut (forall h:R, sin (h + PI / 2) = cos h). + intro; replace (- sin x) with (cos (x + PI / 2) * (1 + 0)). + generalize (derivable_pt_lim_comp (id + fct_cte (PI / 2))%F sin); intros. + cut (derivable_pt_lim (id + fct_cte (PI / 2)) x (1 + 0)). + cut (derivable_pt_lim sin ((id + fct_cte (PI / 2))%F x) (cos (x + PI / 2))). + intros; generalize (H0 _ _ _ H2 H1); + replace (comp sin (id + fct_cte (PI / 2))%F) with + (fun x:R => sin (x + PI / 2)); [ idtac | reflexivity ]. + unfold derivable_pt_lim in |- *; intros. + elim (H3 eps H4); intros. + exists x0. + intros; rewrite <- (H (x + h)); rewrite <- (H x); apply H5; assumption. + apply derivable_pt_lim_sin. + apply derivable_pt_lim_plus. + apply derivable_pt_lim_id. + apply derivable_pt_lim_const. + rewrite sin_cos; rewrite <- (Rplus_comm x); ring. + intro; rewrite cos_sin; rewrite Rplus_comm; reflexivity. Qed. Lemma derivable_pt_sin : forall x:R, derivable_pt sin x. -unfold derivable_pt in |- *; intro. -apply existT with (cos x). -apply derivable_pt_lim_sin. +Proof. + unfold derivable_pt in |- *; intro. + apply existT with (cos x). + apply derivable_pt_lim_sin. Qed. Lemma derivable_pt_cos : forall x:R, derivable_pt cos x. -unfold derivable_pt in |- *; intro. -apply existT with (- sin x). -apply derivable_pt_lim_cos. +Proof. + unfold derivable_pt in |- *; intro. + apply existT with (- sin x). + apply derivable_pt_lim_cos. Qed. Lemma derivable_sin : derivable sin. -unfold derivable in |- *; intro; apply derivable_pt_sin. +Proof. + unfold derivable in |- *; intro; apply derivable_pt_sin. Qed. Lemma derivable_cos : derivable cos. -unfold derivable in |- *; intro; apply derivable_pt_cos. +Proof. + unfold derivable in |- *; intro; apply derivable_pt_cos. Qed. Lemma derive_pt_sin : - forall x:R, derive_pt sin x (derivable_pt_sin _) = cos x. -intros; apply derive_pt_eq_0. -apply derivable_pt_lim_sin. + forall x:R, derive_pt sin x (derivable_pt_sin _) = cos x. +Proof. + intros; apply derive_pt_eq_0. + apply derivable_pt_lim_sin. Qed. Lemma derive_pt_cos : - forall x:R, derive_pt cos x (derivable_pt_cos _) = - sin x. -intros; apply derive_pt_eq_0. -apply derivable_pt_lim_cos. + forall x:R, derive_pt cos x (derivable_pt_cos _) = - sin x. +Proof. + intros; apply derive_pt_eq_0. + apply derivable_pt_lim_cos. Qed. diff --git a/theories/Reals/SeqProp.v b/theories/Reals/SeqProp.v index 2e851b13..133f2b89 100644 --- a/theories/Reals/SeqProp.v +++ b/theories/Reals/SeqProp.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: SeqProp.v 8670 2006-03-28 22:16:14Z herbelin $ i*) +(*i $Id: SeqProp.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -23,136 +23,143 @@ Definition has_lb (Un:nat -> R) : Prop := bound (EUn (opp_seq Un)). (**********) Lemma growing_cv : - forall Un:nat -> R, - Un_growing Un -> has_ub Un -> sigT (fun l:R => Un_cv Un l). -unfold Un_growing, Un_cv in |- *; intros; - destruct (completeness (EUn Un) H0 (EUn_noempty Un)) as [x [H2 H3]]. - exists x; intros eps H1. - unfold is_upper_bound in H2, H3. -assert (H5 : forall n:nat, Un n <= x). + forall Un:nat -> R, + Un_growing Un -> has_ub Un -> sigT (fun l:R => Un_cv Un l). +Proof. + unfold Un_growing, Un_cv in |- *; intros; + destruct (completeness (EUn Un) H0 (EUn_noempty Un)) as [x [H2 H3]]. + exists x; intros eps H1. + unfold is_upper_bound in H2, H3. + assert (H5 : forall n:nat, Un n <= x). intro n; apply (H2 (Un n) (Un_in_EUn Un n)). -cut (exists N : nat, x - eps < Un N). -intro H6; destruct H6 as [N H6]; exists N. -intros n H7; unfold R_dist in |- *; apply (Rabs_def1 (Un n - x) eps). -unfold Rgt in H1. - apply (Rle_lt_trans (Un n - x) 0 eps (Rle_minus (Un n) x (H5 n)) H1). -fold Un_growing in H; generalize (growing_prop Un n N H H7); intro H8. - generalize - (Rlt_le_trans (x - eps) (Un N) (Un n) H6 (Rge_le (Un n) (Un N) H8)); - intro H9; generalize (Rplus_lt_compat_l (- x) (x - eps) (Un n) H9); - unfold Rminus in |- *; rewrite <- (Rplus_assoc (- x) x (- eps)); - rewrite (Rplus_comm (- x) (Un n)); fold (Un n - x) in |- *; - rewrite Rplus_opp_l; rewrite (let (H1, H2) := Rplus_ne (- eps) in H2); - trivial. -cut (~ (forall N:nat, Un N <= x - eps)). -intro H6; apply (not_all_not_ex nat (fun N:nat => x - eps < Un N)). - intro H7; apply H6; intro N; apply Rnot_lt_le; apply H7. -intro H7; generalize (Un_bound_imp Un (x - eps) H7); intro H8; - unfold is_upper_bound in H8; generalize (H3 (x - eps) H8); - apply Rlt_not_le; apply tech_Rgt_minus; exact H1. + cut (exists N : nat, x - eps < Un N). + intro H6; destruct H6 as [N H6]; exists N. + intros n H7; unfold R_dist in |- *; apply (Rabs_def1 (Un n - x) eps). + unfold Rgt in H1. + apply (Rle_lt_trans (Un n - x) 0 eps (Rle_minus (Un n) x (H5 n)) H1). + fold Un_growing in H; generalize (growing_prop Un n N H H7); intro H8. + generalize + (Rlt_le_trans (x - eps) (Un N) (Un n) H6 (Rge_le (Un n) (Un N) H8)); + intro H9; generalize (Rplus_lt_compat_l (- x) (x - eps) (Un n) H9); + unfold Rminus in |- *; rewrite <- (Rplus_assoc (- x) x (- eps)); + rewrite (Rplus_comm (- x) (Un n)); fold (Un n - x) in |- *; + rewrite Rplus_opp_l; rewrite (let (H1, H2) := Rplus_ne (- eps) in H2); + trivial. + cut (~ (forall N:nat, Un N <= x - eps)). + intro H6; apply (not_all_not_ex nat (fun N:nat => x - eps < Un N)). + intro H7; apply H6; intro N; apply Rnot_lt_le; apply H7. + intro H7; generalize (Un_bound_imp Un (x - eps) H7); intro H8; + unfold is_upper_bound in H8; generalize (H3 (x - eps) H8); + apply Rlt_not_le; apply tech_Rgt_minus; exact H1. Qed. Lemma decreasing_growing : - forall Un:nat -> R, Un_decreasing Un -> Un_growing (opp_seq Un). -intro. -unfold Un_growing, opp_seq, Un_decreasing in |- *. -intros. -apply Ropp_le_contravar. -apply H. + forall Un:nat -> R, Un_decreasing Un -> Un_growing (opp_seq Un). +Proof. + intro. + unfold Un_growing, opp_seq, Un_decreasing in |- *. + intros. + apply Ropp_le_contravar. + apply H. Qed. Lemma decreasing_cv : - forall Un:nat -> R, - Un_decreasing Un -> has_lb Un -> sigT (fun l:R => Un_cv Un l). -intros. -cut (sigT (fun l:R => Un_cv (opp_seq Un) l) -> sigT (fun l:R => Un_cv Un l)). -intro X. -apply X. -apply growing_cv. -apply decreasing_growing; assumption. -exact H0. -intro X. -elim X; intros. -apply existT with (- x). -unfold Un_cv in p. -unfold R_dist in p. -unfold opp_seq in p. -unfold Un_cv in |- *. -unfold R_dist in |- *. -intros. -elim (p eps H1); intros. -exists x0; intros. -assert (H4 := H2 n H3). -rewrite <- Rabs_Ropp. -replace (- (Un n - - x)) with (- Un n - x); [ assumption | ring ]. + forall Un:nat -> R, + Un_decreasing Un -> has_lb Un -> sigT (fun l:R => Un_cv Un l). +Proof. + intros. + cut (sigT (fun l:R => Un_cv (opp_seq Un) l) -> sigT (fun l:R => Un_cv Un l)). + intro X. + apply X. + apply growing_cv. + apply decreasing_growing; assumption. + exact H0. + intro X. + elim X; intros. + apply existT with (- x). + unfold Un_cv in p. + unfold R_dist in p. + unfold opp_seq in p. + unfold Un_cv in |- *. + unfold R_dist in |- *. + intros. + elim (p eps H1); intros. + exists x0; intros. + assert (H4 := H2 n H3). + rewrite <- Rabs_Ropp. + replace (- (Un n - - x)) with (- Un n - x); [ assumption | ring ]. Qed. (***********) Lemma maj_sup : - forall Un:nat -> R, has_ub Un -> sigT (fun l:R => is_lub (EUn Un) l). -intros. -unfold has_ub in H. -apply completeness. -assumption. -exists (Un 0%nat). -unfold EUn in |- *. -exists 0%nat; reflexivity. + forall Un:nat -> R, has_ub Un -> sigT (fun l:R => is_lub (EUn Un) l). +Proof. + intros. + unfold has_ub in H. + apply completeness. + assumption. + exists (Un 0%nat). + unfold EUn in |- *. + exists 0%nat; reflexivity. Qed. (**********) Lemma min_inf : - forall Un:nat -> R, - has_lb Un -> sigT (fun l:R => is_lub (EUn (opp_seq Un)) l). -intros; unfold has_lb in H. -apply completeness. -assumption. -exists (- Un 0%nat). -exists 0%nat. -reflexivity. + forall Un:nat -> R, + has_lb Un -> sigT (fun l:R => is_lub (EUn (opp_seq Un)) l). +Proof. + intros; unfold has_lb in H. + apply completeness. + assumption. + exists (- Un 0%nat). + exists 0%nat. + reflexivity. Qed. Definition majorant (Un:nat -> R) (pr:has_ub Un) : R := match maj_sup Un pr with - | existT a b => a + | existT a b => a end. Definition minorant (Un:nat -> R) (pr:has_lb Un) : R := match min_inf Un pr with - | existT a b => - a + | existT a b => - a end. Lemma maj_ss : - forall (Un:nat -> R) (k:nat), - has_ub Un -> has_ub (fun i:nat => Un (k + i)%nat). -intros. -unfold has_ub in H. -unfold bound in H. -elim H; intros. -unfold is_upper_bound in H0. -unfold has_ub in |- *. -exists x. -unfold is_upper_bound in |- *. -intros. -apply H0. -elim H1; intros. -exists (k + x1)%nat; assumption. + forall (Un:nat -> R) (k:nat), + has_ub Un -> has_ub (fun i:nat => Un (k + i)%nat). +Proof. + intros. + unfold has_ub in H. + unfold bound in H. + elim H; intros. + unfold is_upper_bound in H0. + unfold has_ub in |- *. + exists x. + unfold is_upper_bound in |- *. + intros. + apply H0. + elim H1; intros. + exists (k + x1)%nat; assumption. Qed. Lemma min_ss : - forall (Un:nat -> R) (k:nat), - has_lb Un -> has_lb (fun i:nat => Un (k + i)%nat). -intros. -unfold has_lb in H. -unfold bound in H. -elim H; intros. -unfold is_upper_bound in H0. -unfold has_lb in |- *. -exists x. -unfold is_upper_bound in |- *. -intros. -apply H0. -elim H1; intros. -exists (k + x1)%nat; assumption. + forall (Un:nat -> R) (k:nat), + has_lb Un -> has_lb (fun i:nat => Un (k + i)%nat). +Proof. + intros. + unfold has_lb in H. + unfold bound in H. + elim H; intros. + unfold is_upper_bound in H0. + unfold has_lb in |- *. + exists x. + unfold is_upper_bound in |- *. + intros. + apply H0. + elim H1; intros. + exists (k + x1)%nat; assumption. Qed. Definition sequence_majorant (Un:nat -> R) (pr:has_ub Un) @@ -162,1134 +169,1163 @@ Definition sequence_minorant (Un:nat -> R) (pr:has_lb Un) (i:nat) : R := minorant (fun k:nat => Un (i + k)%nat) (min_ss Un i pr). Lemma Wn_decreasing : - forall (Un:nat -> R) (pr:has_ub Un), Un_decreasing (sequence_majorant Un pr). -intros. -unfold Un_decreasing in |- *. -intro. -unfold sequence_majorant in |- *. -assert (H := maj_sup (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)). -assert (H0 := maj_sup (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)). -elim H; intros. -elim H0; intros. -cut (majorant (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr) = x); - [ intro Maj1; rewrite Maj1 | idtac ]. -cut (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr) = x0); - [ intro Maj2; rewrite Maj2 | idtac ]. -unfold is_lub in p. -unfold is_lub in p0. -elim p; intros. -apply H2. -elim p0; intros. -unfold is_upper_bound in |- *. -intros. -unfold is_upper_bound in H3. -apply H3. -elim H5; intros. -exists (1 + x2)%nat. -replace (n + (1 + x2))%nat with (S n + x2)%nat. -assumption. -replace (S n) with (1 + n)%nat; [ ring | ring ]. -cut - (is_lub (EUn (fun k:nat => Un (n + k)%nat)) - (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr))). -intro. -unfold is_lub in p0; unfold is_lub in H1. -elim p0; intros; elim H1; intros. -assert (H6 := H5 x0 H2). -assert - (H7 := H3 (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)) H4). -apply Rle_antisym; assumption. -unfold majorant in |- *. -case (maj_sup (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)). -trivial. -cut - (is_lub (EUn (fun k:nat => Un (S n + k)%nat)) - (majorant (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr))). -intro. -unfold is_lub in p; unfold is_lub in H1. -elim p; intros; elim H1; intros. -assert (H6 := H5 x H2). -assert - (H7 := - H3 (majorant (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)) H4). -apply Rle_antisym; assumption. -unfold majorant in |- *. -case (maj_sup (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)). -trivial. + forall (Un:nat -> R) (pr:has_ub Un), Un_decreasing (sequence_majorant Un pr). +Proof. + intros. + unfold Un_decreasing in |- *. + intro. + unfold sequence_majorant in |- *. + assert (H := maj_sup (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)). + assert (H0 := maj_sup (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)). + elim H; intros. + elim H0; intros. + cut (majorant (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr) = x); + [ intro Maj1; rewrite Maj1 | idtac ]. + cut (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr) = x0); + [ intro Maj2; rewrite Maj2 | idtac ]. + unfold is_lub in p. + unfold is_lub in p0. + elim p; intros. + apply H2. + elim p0; intros. + unfold is_upper_bound in |- *. + intros. + unfold is_upper_bound in H3. + apply H3. + elim H5; intros. + exists (1 + x2)%nat. + replace (n + (1 + x2))%nat with (S n + x2)%nat. + assumption. + replace (S n) with (1 + n)%nat; [ ring | ring ]. + cut + (is_lub (EUn (fun k:nat => Un (n + k)%nat)) + (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr))). + intro. + unfold is_lub in p0; unfold is_lub in H1. + elim p0; intros; elim H1; intros. + assert (H6 := H5 x0 H2). + assert + (H7 := H3 (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)) H4). + apply Rle_antisym; assumption. + unfold majorant in |- *. + case (maj_sup (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)). + trivial. + cut + (is_lub (EUn (fun k:nat => Un (S n + k)%nat)) + (majorant (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr))). + intro. + unfold is_lub in p; unfold is_lub in H1. + elim p; intros; elim H1; intros. + assert (H6 := H5 x H2). + assert + (H7 := + H3 (majorant (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)) H4). + apply Rle_antisym; assumption. + unfold majorant in |- *. + case (maj_sup (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)). + trivial. Qed. Lemma Vn_growing : - forall (Un:nat -> R) (pr:has_lb Un), Un_growing (sequence_minorant Un pr). -intros. -unfold Un_growing in |- *. -intro. -unfold sequence_minorant in |- *. -assert (H := min_inf (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)). -assert (H0 := min_inf (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)). -elim H; intros. -elim H0; intros. -cut (minorant (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr) = - x); - [ intro Maj1; rewrite Maj1 | idtac ]. -cut (minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr) = - x0); - [ intro Maj2; rewrite Maj2 | idtac ]. -unfold is_lub in p. -unfold is_lub in p0. -elim p; intros. -apply Ropp_le_contravar. -apply H2. -elim p0; intros. -unfold is_upper_bound in |- *. -intros. -unfold is_upper_bound in H3. -apply H3. -elim H5; intros. -exists (1 + x2)%nat. -unfold opp_seq in H6. -unfold opp_seq in |- *. -replace (n + (1 + x2))%nat with (S n + x2)%nat. -assumption. -replace (S n) with (1 + n)%nat; [ ring | ring ]. -cut - (is_lub (EUn (opp_seq (fun k:nat => Un (n + k)%nat))) - (- minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr))). -intro. -unfold is_lub in p0; unfold is_lub in H1. -elim p0; intros; elim H1; intros. -assert (H6 := H5 x0 H2). -assert - (H7 := H3 (- minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)) H4). -rewrite <- - (Ropp_involutive (minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr))) - . -apply Ropp_eq_compat; apply Rle_antisym; assumption. -unfold minorant in |- *. -case (min_inf (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)). -intro; rewrite Ropp_involutive. -trivial. -cut - (is_lub (EUn (opp_seq (fun k:nat => Un (S n + k)%nat))) - (- minorant (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr))). -intro. -unfold is_lub in p; unfold is_lub in H1. -elim p; intros; elim H1; intros. -assert (H6 := H5 x H2). -assert - (H7 := - H3 (- minorant (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)) H4). -rewrite <- - (Ropp_involutive - (minorant (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr))) - . -apply Ropp_eq_compat; apply Rle_antisym; assumption. -unfold minorant in |- *. -case (min_inf (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)). -intro; rewrite Ropp_involutive. -trivial. + forall (Un:nat -> R) (pr:has_lb Un), Un_growing (sequence_minorant Un pr). +Proof. + intros. + unfold Un_growing in |- *. + intro. + unfold sequence_minorant in |- *. + assert (H := min_inf (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)). + assert (H0 := min_inf (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)). + elim H; intros. + elim H0; intros. + cut (minorant (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr) = - x); + [ intro Maj1; rewrite Maj1 | idtac ]. + cut (minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr) = - x0); + [ intro Maj2; rewrite Maj2 | idtac ]. + unfold is_lub in p. + unfold is_lub in p0. + elim p; intros. + apply Ropp_le_contravar. + apply H2. + elim p0; intros. + unfold is_upper_bound in |- *. + intros. + unfold is_upper_bound in H3. + apply H3. + elim H5; intros. + exists (1 + x2)%nat. + unfold opp_seq in H6. + unfold opp_seq in |- *. + replace (n + (1 + x2))%nat with (S n + x2)%nat. + assumption. + replace (S n) with (1 + n)%nat; [ ring | ring ]. + cut + (is_lub (EUn (opp_seq (fun k:nat => Un (n + k)%nat))) + (- minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr))). + intro. + unfold is_lub in p0; unfold is_lub in H1. + elim p0; intros; elim H1; intros. + assert (H6 := H5 x0 H2). + assert + (H7 := H3 (- minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)) H4). + rewrite <- + (Ropp_involutive (minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr))) + . + apply Ropp_eq_compat; apply Rle_antisym; assumption. + unfold minorant in |- *. + case (min_inf (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)). + intro; rewrite Ropp_involutive. + trivial. + cut + (is_lub (EUn (opp_seq (fun k:nat => Un (S n + k)%nat))) + (- minorant (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr))). + intro. + unfold is_lub in p; unfold is_lub in H1. + elim p; intros; elim H1; intros. + assert (H6 := H5 x H2). + assert + (H7 := + H3 (- minorant (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)) H4). + rewrite <- + (Ropp_involutive + (minorant (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr))) + . + apply Ropp_eq_compat; apply Rle_antisym; assumption. + unfold minorant in |- *. + case (min_inf (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)). + intro; rewrite Ropp_involutive. + trivial. Qed. (**********) Lemma Vn_Un_Wn_order : - forall (Un:nat -> R) (pr1:has_ub Un) (pr2:has_lb Un) - (n:nat), sequence_minorant Un pr2 n <= Un n <= sequence_majorant Un pr1 n. -intros. -split. -unfold sequence_minorant in |- *. -cut - (sigT (fun l:R => is_lub (EUn (opp_seq (fun i:nat => Un (n + i)%nat))) l)). -intro X. -elim X; intros. -replace (minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)) with (- x). -unfold is_lub in p. -elim p; intros. -unfold is_upper_bound in H. -rewrite <- (Ropp_involutive (Un n)). -apply Ropp_le_contravar. -apply H. -exists 0%nat. -unfold opp_seq in |- *. -replace (n + 0)%nat with n; [ reflexivity | ring ]. -cut - (is_lub (EUn (opp_seq (fun k:nat => Un (n + k)%nat))) - (- minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2))). -intro. -unfold is_lub in p; unfold is_lub in H. -elim p; intros; elim H; intros. -assert (H4 := H3 x H0). -assert - (H5 := H1 (- minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)) H2). -rewrite <- - (Ropp_involutive (minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2))) - . -apply Ropp_eq_compat; apply Rle_antisym; assumption. -unfold minorant in |- *. -case (min_inf (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)). -intro; rewrite Ropp_involutive. -trivial. -apply min_inf. -apply min_ss; assumption. -unfold sequence_majorant in |- *. -cut (sigT (fun l:R => is_lub (EUn (fun i:nat => Un (n + i)%nat)) l)). -intro X. -elim X; intros. -replace (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)) with x. -unfold is_lub in p. -elim p; intros. -unfold is_upper_bound in H. -apply H. -exists 0%nat. -replace (n + 0)%nat with n; [ reflexivity | ring ]. -cut - (is_lub (EUn (fun k:nat => Un (n + k)%nat)) - (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1))). -intro. -unfold is_lub in p; unfold is_lub in H. -elim p; intros; elim H; intros. -assert (H4 := H3 x H0). -assert - (H5 := H1 (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)) H2). -apply Rle_antisym; assumption. -unfold majorant in |- *. -case (maj_sup (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)). -intro; trivial. -apply maj_sup. -apply maj_ss; assumption. + forall (Un:nat -> R) (pr1:has_ub Un) (pr2:has_lb Un) + (n:nat), sequence_minorant Un pr2 n <= Un n <= sequence_majorant Un pr1 n. +Proof. + intros. + split. + unfold sequence_minorant in |- *. + cut + (sigT (fun l:R => is_lub (EUn (opp_seq (fun i:nat => Un (n + i)%nat))) l)). + intro X. + elim X; intros. + replace (minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)) with (- x). + unfold is_lub in p. + elim p; intros. + unfold is_upper_bound in H. + rewrite <- (Ropp_involutive (Un n)). + apply Ropp_le_contravar. + apply H. + exists 0%nat. + unfold opp_seq in |- *. + replace (n + 0)%nat with n; [ reflexivity | ring ]. + cut + (is_lub (EUn (opp_seq (fun k:nat => Un (n + k)%nat))) + (- minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2))). + intro. + unfold is_lub in p; unfold is_lub in H. + elim p; intros; elim H; intros. + assert (H4 := H3 x H0). + assert + (H5 := H1 (- minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)) H2). + rewrite <- + (Ropp_involutive (minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2))) + . + apply Ropp_eq_compat; apply Rle_antisym; assumption. + unfold minorant in |- *. + case (min_inf (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)). + intro; rewrite Ropp_involutive. + trivial. + apply min_inf. + apply min_ss; assumption. + unfold sequence_majorant in |- *. + cut (sigT (fun l:R => is_lub (EUn (fun i:nat => Un (n + i)%nat)) l)). + intro X. + elim X; intros. + replace (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)) with x. + unfold is_lub in p. + elim p; intros. + unfold is_upper_bound in H. + apply H. + exists 0%nat. + replace (n + 0)%nat with n; [ reflexivity | ring ]. + cut + (is_lub (EUn (fun k:nat => Un (n + k)%nat)) + (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1))). + intro. + unfold is_lub in p; unfold is_lub in H. + elim p; intros; elim H; intros. + assert (H4 := H3 x H0). + assert + (H5 := H1 (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)) H2). + apply Rle_antisym; assumption. + unfold majorant in |- *. + case (maj_sup (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)). + intro; trivial. + apply maj_sup. + apply maj_ss; assumption. Qed. Lemma min_maj : - forall (Un:nat -> R) (pr1:has_ub Un) (pr2:has_lb Un), - has_ub (sequence_minorant Un pr2). -intros. -assert (H := Vn_Un_Wn_order Un pr1 pr2). -unfold has_ub in |- *. -unfold bound in |- *. -unfold has_ub in pr1. -unfold bound in pr1. -elim pr1; intros. -exists x. -unfold is_upper_bound in |- *. -intros. -unfold is_upper_bound in H0. -elim H1; intros. -rewrite H2. -apply Rle_trans with (Un x1). -assert (H3 := H x1); elim H3; intros; assumption. -apply H0. -exists x1; reflexivity. + forall (Un:nat -> R) (pr1:has_ub Un) (pr2:has_lb Un), + has_ub (sequence_minorant Un pr2). +Proof. + intros. + assert (H := Vn_Un_Wn_order Un pr1 pr2). + unfold has_ub in |- *. + unfold bound in |- *. + unfold has_ub in pr1. + unfold bound in pr1. + elim pr1; intros. + exists x. + unfold is_upper_bound in |- *. + intros. + unfold is_upper_bound in H0. + elim H1; intros. + rewrite H2. + apply Rle_trans with (Un x1). + assert (H3 := H x1); elim H3; intros; assumption. + apply H0. + exists x1; reflexivity. Qed. Lemma maj_min : - forall (Un:nat -> R) (pr1:has_ub Un) (pr2:has_lb Un), - has_lb (sequence_majorant Un pr1). -intros. -assert (H := Vn_Un_Wn_order Un pr1 pr2). -unfold has_lb in |- *. -unfold bound in |- *. -unfold has_lb in pr2. -unfold bound in pr2. -elim pr2; intros. -exists x. -unfold is_upper_bound in |- *. -intros. -unfold is_upper_bound in H0. -elim H1; intros. -rewrite H2. -apply Rle_trans with (opp_seq Un x1). -assert (H3 := H x1); elim H3; intros. -unfold opp_seq in |- *; apply Ropp_le_contravar. -assumption. -apply H0. -exists x1; reflexivity. + forall (Un:nat -> R) (pr1:has_ub Un) (pr2:has_lb Un), + has_lb (sequence_majorant Un pr1). +Proof. + intros. + assert (H := Vn_Un_Wn_order Un pr1 pr2). + unfold has_lb in |- *. + unfold bound in |- *. + unfold has_lb in pr2. + unfold bound in pr2. + elim pr2; intros. + exists x. + unfold is_upper_bound in |- *. + intros. + unfold is_upper_bound in H0. + elim H1; intros. + rewrite H2. + apply Rle_trans with (opp_seq Un x1). + assert (H3 := H x1); elim H3; intros. + unfold opp_seq in |- *; apply Ropp_le_contravar. + assumption. + apply H0. + exists x1; reflexivity. Qed. (**********) Lemma cauchy_maj : forall Un:nat -> R, Cauchy_crit Un -> has_ub Un. -intros. -unfold has_ub in |- *. -apply cauchy_bound. -assumption. +Proof. + intros. + unfold has_ub in |- *. + apply cauchy_bound. + assumption. Qed. (**********) Lemma cauchy_opp : - forall Un:nat -> R, Cauchy_crit Un -> Cauchy_crit (opp_seq Un). -intro. -unfold Cauchy_crit in |- *. -unfold R_dist in |- *. -intros. -elim (H eps H0); intros. -exists x; intros. -unfold opp_seq in |- *. -rewrite <- Rabs_Ropp. -replace (- (- Un n - - Un m)) with (Un n - Un m); - [ apply H1; assumption | ring ]. + forall Un:nat -> R, Cauchy_crit Un -> Cauchy_crit (opp_seq Un). +Proof. + intro. + unfold Cauchy_crit in |- *. + unfold R_dist in |- *. + intros. + elim (H eps H0); intros. + exists x; intros. + unfold opp_seq in |- *. + rewrite <- Rabs_Ropp. + replace (- (- Un n - - Un m)) with (Un n - Un m); + [ apply H1; assumption | ring ]. Qed. (**********) Lemma cauchy_min : forall Un:nat -> R, Cauchy_crit Un -> has_lb Un. -intros. -unfold has_lb in |- *. -assert (H0 := cauchy_opp _ H). -apply cauchy_bound. -assumption. +Proof. + intros. + unfold has_lb in |- *. + assert (H0 := cauchy_opp _ H). + apply cauchy_bound. + assumption. Qed. (**********) Lemma maj_cv : - forall (Un:nat -> R) (pr:Cauchy_crit Un), - sigT (fun l:R => Un_cv (sequence_majorant Un (cauchy_maj Un pr)) l). -intros. -apply decreasing_cv. -apply Wn_decreasing. -apply maj_min. -apply cauchy_min. -assumption. + forall (Un:nat -> R) (pr:Cauchy_crit Un), + sigT (fun l:R => Un_cv (sequence_majorant Un (cauchy_maj Un pr)) l). +Proof. + intros. + apply decreasing_cv. + apply Wn_decreasing. + apply maj_min. + apply cauchy_min. + assumption. Qed. (**********) Lemma min_cv : - forall (Un:nat -> R) (pr:Cauchy_crit Un), - sigT (fun l:R => Un_cv (sequence_minorant Un (cauchy_min Un pr)) l). -intros. -apply growing_cv. -apply Vn_growing. -apply min_maj. -apply cauchy_maj. -assumption. + forall (Un:nat -> R) (pr:Cauchy_crit Un), + sigT (fun l:R => Un_cv (sequence_minorant Un (cauchy_min Un pr)) l). +Proof. + intros. + apply growing_cv. + apply Vn_growing. + apply min_maj. + apply cauchy_maj. + assumption. Qed. Lemma cond_eq : - forall x y:R, (forall eps:R, 0 < eps -> Rabs (x - y) < eps) -> x = y. -intros. -case (total_order_T x y); intro. -elim s; intro. -cut (0 < y - x). -intro. -assert (H1 := H (y - x) H0). -rewrite <- Rabs_Ropp in H1. -cut (- (x - y) = y - x); [ intro; rewrite H2 in H1 | ring ]. -rewrite Rabs_right in H1. -elim (Rlt_irrefl _ H1). -left; assumption. -apply Rplus_lt_reg_r with x. -rewrite Rplus_0_r; replace (x + (y - x)) with y; [ assumption | ring ]. -assumption. -cut (0 < x - y). -intro. -assert (H1 := H (x - y) H0). -rewrite Rabs_right in H1. -elim (Rlt_irrefl _ H1). -left; assumption. -apply Rplus_lt_reg_r with y. -rewrite Rplus_0_r; replace (y + (x - y)) with x; [ assumption | ring ]. + forall x y:R, (forall eps:R, 0 < eps -> Rabs (x - y) < eps) -> x = y. +Proof. + intros. + case (total_order_T x y); intro. + elim s; intro. + cut (0 < y - x). + intro. + assert (H1 := H (y - x) H0). + rewrite <- Rabs_Ropp in H1. + cut (- (x - y) = y - x); [ intro; rewrite H2 in H1 | ring ]. + rewrite Rabs_right in H1. + elim (Rlt_irrefl _ H1). + left; assumption. + apply Rplus_lt_reg_r with x. + rewrite Rplus_0_r; replace (x + (y - x)) with y; [ assumption | ring ]. + assumption. + cut (0 < x - y). + intro. + assert (H1 := H (x - y) H0). + rewrite Rabs_right in H1. + elim (Rlt_irrefl _ H1). + left; assumption. + apply Rplus_lt_reg_r with y. + rewrite Rplus_0_r; replace (y + (x - y)) with x; [ assumption | ring ]. Qed. Lemma not_Rlt : forall r1 r2:R, ~ r1 < r2 -> r1 >= r2. -intros r1 r2; generalize (Rtotal_order r1 r2); unfold Rge in |- *. -tauto. +Proof. + intros r1 r2; generalize (Rtotal_order r1 r2); unfold Rge in |- *. + tauto. Qed. (**********) Lemma approx_maj : - forall (Un:nat -> R) (pr:has_ub Un) (eps:R), - 0 < eps -> exists k : nat, Rabs (majorant Un pr - Un k) < eps. -intros. -set (P := fun k:nat => Rabs (majorant Un pr - Un k) < eps). -unfold P in |- *. -cut - ((exists k : nat, P k) -> - exists k : nat, Rabs (majorant Un pr - Un k) < eps). -intros. -apply H0. -apply not_all_not_ex. -red in |- *; intro. -2: unfold P in |- *; trivial. -unfold P in H1. -cut (forall n:nat, Rabs (majorant Un pr - Un n) >= eps). -intro. -cut (is_lub (EUn Un) (majorant Un pr)). -intro. -unfold is_lub in H3. -unfold is_upper_bound in H3. -elim H3; intros. -cut (forall n:nat, eps <= majorant Un pr - Un n). -intro. -cut (forall n:nat, Un n <= majorant Un pr - eps). -intro. -cut (forall x:R, EUn Un x -> x <= majorant Un pr - eps). -intro. -assert (H9 := H5 (majorant Un pr - eps) H8). -cut (eps <= 0). -intro. -elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H H10)). -apply Rplus_le_reg_l with (majorant Un pr - eps). -rewrite Rplus_0_r. -replace (majorant Un pr - eps + eps) with (majorant Un pr); - [ assumption | ring ]. -intros. -unfold EUn in H8. -elim H8; intros. -rewrite H9; apply H7. -intro. -assert (H7 := H6 n). -apply Rplus_le_reg_l with (eps - Un n). -replace (eps - Un n + Un n) with eps. -replace (eps - Un n + (majorant Un pr - eps)) with (majorant Un pr - Un n). -assumption. -ring. -ring. -intro. -assert (H6 := H2 n). -rewrite Rabs_right in H6. -apply Rge_le. -assumption. -apply Rle_ge. -apply Rplus_le_reg_l with (Un n). -rewrite Rplus_0_r; - replace (Un n + (majorant Un pr - Un n)) with (majorant Un pr); - [ apply H4 | ring ]. -exists n; reflexivity. -unfold majorant in |- *. -case (maj_sup Un pr). -trivial. -intro. -assert (H2 := H1 n). -apply not_Rlt; assumption. + forall (Un:nat -> R) (pr:has_ub Un) (eps:R), + 0 < eps -> exists k : nat, Rabs (majorant Un pr - Un k) < eps. +Proof. + intros. + set (P := fun k:nat => Rabs (majorant Un pr - Un k) < eps). + unfold P in |- *. + cut + ((exists k : nat, P k) -> + exists k : nat, Rabs (majorant Un pr - Un k) < eps). + intros. + apply H0. + apply not_all_not_ex. + red in |- *; intro. + 2: unfold P in |- *; trivial. + unfold P in H1. + cut (forall n:nat, Rabs (majorant Un pr - Un n) >= eps). + intro. + cut (is_lub (EUn Un) (majorant Un pr)). + intro. + unfold is_lub in H3. + unfold is_upper_bound in H3. + elim H3; intros. + cut (forall n:nat, eps <= majorant Un pr - Un n). + intro. + cut (forall n:nat, Un n <= majorant Un pr - eps). + intro. + cut (forall x:R, EUn Un x -> x <= majorant Un pr - eps). + intro. + assert (H9 := H5 (majorant Un pr - eps) H8). + cut (eps <= 0). + intro. + elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H H10)). + apply Rplus_le_reg_l with (majorant Un pr - eps). + rewrite Rplus_0_r. + replace (majorant Un pr - eps + eps) with (majorant Un pr); + [ assumption | ring ]. + intros. + unfold EUn in H8. + elim H8; intros. + rewrite H9; apply H7. + intro. + assert (H7 := H6 n). + apply Rplus_le_reg_l with (eps - Un n). + replace (eps - Un n + Un n) with eps. + replace (eps - Un n + (majorant Un pr - eps)) with (majorant Un pr - Un n). + assumption. + ring. + ring. + intro. + assert (H6 := H2 n). + rewrite Rabs_right in H6. + apply Rge_le. + assumption. + apply Rle_ge. + apply Rplus_le_reg_l with (Un n). + rewrite Rplus_0_r; + replace (Un n + (majorant Un pr - Un n)) with (majorant Un pr); + [ apply H4 | ring ]. + exists n; reflexivity. + unfold majorant in |- *. + case (maj_sup Un pr). + trivial. + intro. + assert (H2 := H1 n). + apply not_Rlt; assumption. Qed. (**********) Lemma approx_min : - forall (Un:nat -> R) (pr:has_lb Un) (eps:R), - 0 < eps -> exists k : nat, Rabs (minorant Un pr - Un k) < eps. -intros. -set (P := fun k:nat => Rabs (minorant Un pr - Un k) < eps). -unfold P in |- *. -cut - ((exists k : nat, P k) -> - exists k : nat, Rabs (minorant Un pr - Un k) < eps). -intros. -apply H0. -apply not_all_not_ex. -red in |- *; intro. -2: unfold P in |- *; trivial. -unfold P in H1. -cut (forall n:nat, Rabs (minorant Un pr - Un n) >= eps). -intro. -cut (is_lub (EUn (opp_seq Un)) (- minorant Un pr)). -intro. -unfold is_lub in H3. -unfold is_upper_bound in H3. -elim H3; intros. -cut (forall n:nat, eps <= Un n - minorant Un pr). -intro. -cut (forall n:nat, opp_seq Un n <= - minorant Un pr - eps). -intro. -cut (forall x:R, EUn (opp_seq Un) x -> x <= - minorant Un pr - eps). -intro. -assert (H9 := H5 (- minorant Un pr - eps) H8). -cut (eps <= 0). -intro. -elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H H10)). -apply Rplus_le_reg_l with (- minorant Un pr - eps). -rewrite Rplus_0_r. -replace (- minorant Un pr - eps + eps) with (- minorant Un pr); - [ assumption | ring ]. -intros. -unfold EUn in H8. -elim H8; intros. -rewrite H9; apply H7. -intro. -assert (H7 := H6 n). -unfold opp_seq in |- *. -apply Rplus_le_reg_l with (eps + Un n). -replace (eps + Un n + - Un n) with eps. -replace (eps + Un n + (- minorant Un pr - eps)) with (Un n - minorant Un pr). -assumption. -ring. -ring. -intro. -assert (H6 := H2 n). -rewrite Rabs_left1 in H6. -apply Rge_le. -replace (Un n - minorant Un pr) with (- (minorant Un pr - Un n)); - [ assumption | ring ]. -apply Rplus_le_reg_l with (- minorant Un pr). -rewrite Rplus_0_r; - replace (- minorant Un pr + (minorant Un pr - Un n)) with (- Un n). -apply H4. -exists n; reflexivity. -ring. -unfold minorant in |- *. -case (min_inf Un pr). -intro. -rewrite Ropp_involutive. -trivial. -intro. -assert (H2 := H1 n). -apply not_Rlt; assumption. + forall (Un:nat -> R) (pr:has_lb Un) (eps:R), + 0 < eps -> exists k : nat, Rabs (minorant Un pr - Un k) < eps. +Proof. + intros. + set (P := fun k:nat => Rabs (minorant Un pr - Un k) < eps). + unfold P in |- *. + cut + ((exists k : nat, P k) -> + exists k : nat, Rabs (minorant Un pr - Un k) < eps). + intros. + apply H0. + apply not_all_not_ex. + red in |- *; intro. + 2: unfold P in |- *; trivial. + unfold P in H1. + cut (forall n:nat, Rabs (minorant Un pr - Un n) >= eps). + intro. + cut (is_lub (EUn (opp_seq Un)) (- minorant Un pr)). + intro. + unfold is_lub in H3. + unfold is_upper_bound in H3. + elim H3; intros. + cut (forall n:nat, eps <= Un n - minorant Un pr). + intro. + cut (forall n:nat, opp_seq Un n <= - minorant Un pr - eps). + intro. + cut (forall x:R, EUn (opp_seq Un) x -> x <= - minorant Un pr - eps). + intro. + assert (H9 := H5 (- minorant Un pr - eps) H8). + cut (eps <= 0). + intro. + elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H H10)). + apply Rplus_le_reg_l with (- minorant Un pr - eps). + rewrite Rplus_0_r. + replace (- minorant Un pr - eps + eps) with (- minorant Un pr); + [ assumption | ring ]. + intros. + unfold EUn in H8. + elim H8; intros. + rewrite H9; apply H7. + intro. + assert (H7 := H6 n). + unfold opp_seq in |- *. + apply Rplus_le_reg_l with (eps + Un n). + replace (eps + Un n + - Un n) with eps. + replace (eps + Un n + (- minorant Un pr - eps)) with (Un n - minorant Un pr). + assumption. + ring. + ring. + intro. + assert (H6 := H2 n). + rewrite Rabs_left1 in H6. + apply Rge_le. + replace (Un n - minorant Un pr) with (- (minorant Un pr - Un n)); + [ assumption | ring ]. + apply Rplus_le_reg_l with (- minorant Un pr). + rewrite Rplus_0_r; + replace (- minorant Un pr + (minorant Un pr - Un n)) with (- Un n). + apply H4. + exists n; reflexivity. + ring. + unfold minorant in |- *. + case (min_inf Un pr). + intro. + rewrite Ropp_involutive. + trivial. + intro. + assert (H2 := H1 n). + apply not_Rlt; assumption. Qed. -(* Unicity of limit for convergent sequences *) +(** Unicity of limit for convergent sequences *) Lemma UL_sequence : - forall (Un:nat -> R) (l1 l2:R), Un_cv Un l1 -> Un_cv Un l2 -> l1 = l2. -intros Un l1 l2; unfold Un_cv in |- *; unfold R_dist in |- *; intros. -apply cond_eq. -intros; cut (0 < eps / 2); - [ intro - | unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. -elim (H (eps / 2) H2); intros. -elim (H0 (eps / 2) H2); intros. -set (N := max x x0). -apply Rle_lt_trans with (Rabs (l1 - Un N) + Rabs (Un N - l2)). -replace (l1 - l2) with (l1 - Un N + (Un N - l2)); - [ apply Rabs_triang | ring ]. -rewrite (double_var eps); apply Rplus_lt_compat. -rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H3; - unfold ge, N in |- *; apply le_max_l. -apply H4; unfold ge, N in |- *; apply le_max_r. + forall (Un:nat -> R) (l1 l2:R), Un_cv Un l1 -> Un_cv Un l2 -> l1 = l2. +Proof. + intros Un l1 l2; unfold Un_cv in |- *; unfold R_dist in |- *; intros. + apply cond_eq. + intros; cut (0 < eps / 2); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. + elim (H (eps / 2) H2); intros. + elim (H0 (eps / 2) H2); intros. + set (N := max x x0). + apply Rle_lt_trans with (Rabs (l1 - Un N) + Rabs (Un N - l2)). + replace (l1 - l2) with (l1 - Un N + (Un N - l2)); + [ apply Rabs_triang | ring ]. + rewrite (double_var eps); apply Rplus_lt_compat. + rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H3; + unfold ge, N in |- *; apply le_max_l. + apply H4; unfold ge, N in |- *; apply le_max_r. Qed. (**********) Lemma CV_plus : - forall (An Bn:nat -> R) (l1 l2:R), - Un_cv An l1 -> Un_cv Bn l2 -> Un_cv (fun i:nat => An i + Bn i) (l1 + l2). -unfold Un_cv in |- *; unfold R_dist in |- *; intros. -cut (0 < eps / 2); - [ intro - | unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. -elim (H (eps / 2) H2); intros. -elim (H0 (eps / 2) H2); intros. -set (N := max x x0). -exists N; intros. -replace (An n + Bn n - (l1 + l2)) with (An n - l1 + (Bn n - l2)); - [ idtac | ring ]. -apply Rle_lt_trans with (Rabs (An n - l1) + Rabs (Bn n - l2)). -apply Rabs_triang. -rewrite (double_var eps); apply Rplus_lt_compat. -apply H3; unfold ge in |- *; apply le_trans with N; - [ unfold N in |- *; apply le_max_l | assumption ]. -apply H4; unfold ge in |- *; apply le_trans with N; - [ unfold N in |- *; apply le_max_r | assumption ]. + forall (An Bn:nat -> R) (l1 l2:R), + Un_cv An l1 -> Un_cv Bn l2 -> Un_cv (fun i:nat => An i + Bn i) (l1 + l2). +Proof. + unfold Un_cv in |- *; unfold R_dist in |- *; intros. + cut (0 < eps / 2); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. + elim (H (eps / 2) H2); intros. + elim (H0 (eps / 2) H2); intros. + set (N := max x x0). + exists N; intros. + replace (An n + Bn n - (l1 + l2)) with (An n - l1 + (Bn n - l2)); + [ idtac | ring ]. + apply Rle_lt_trans with (Rabs (An n - l1) + Rabs (Bn n - l2)). + apply Rabs_triang. + rewrite (double_var eps); apply Rplus_lt_compat. + apply H3; unfold ge in |- *; apply le_trans with N; + [ unfold N in |- *; apply le_max_l | assumption ]. + apply H4; unfold ge in |- *; apply le_trans with N; + [ unfold N in |- *; apply le_max_r | assumption ]. Qed. (**********) Lemma cv_cvabs : - forall (Un:nat -> R) (l:R), - Un_cv Un l -> Un_cv (fun i:nat => Rabs (Un i)) (Rabs l). -unfold Un_cv in |- *; unfold R_dist in |- *; intros. -elim (H eps H0); intros. -exists x; intros. -apply Rle_lt_trans with (Rabs (Un n - l)). -apply Rabs_triang_inv2. -apply H1; assumption. + forall (Un:nat -> R) (l:R), + Un_cv Un l -> Un_cv (fun i:nat => Rabs (Un i)) (Rabs l). +Proof. + unfold Un_cv in |- *; unfold R_dist in |- *; intros. + elim (H eps H0); intros. + exists x; intros. + apply Rle_lt_trans with (Rabs (Un n - l)). + apply Rabs_triang_inv2. + apply H1; assumption. Qed. (**********) Lemma CV_Cauchy : - forall Un:nat -> R, sigT (fun l:R => Un_cv Un l) -> Cauchy_crit Un. -intros Un X; elim X; intros. -unfold Cauchy_crit in |- *; intros. -unfold Un_cv in p; unfold R_dist in p. -cut (0 < eps / 2); - [ intro - | unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. -elim (p (eps / 2) H0); intros. -exists x0; intros. -unfold R_dist in |- *; - apply Rle_lt_trans with (Rabs (Un n - x) + Rabs (x - Un m)). -replace (Un n - Un m) with (Un n - x + (x - Un m)); - [ apply Rabs_triang | ring ]. -rewrite (double_var eps); apply Rplus_lt_compat. -apply H1; assumption. -rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H1; assumption. + forall Un:nat -> R, sigT (fun l:R => Un_cv Un l) -> Cauchy_crit Un. +Proof. + intros Un X; elim X; intros. + unfold Cauchy_crit in |- *; intros. + unfold Un_cv in p; unfold R_dist in p. + cut (0 < eps / 2); + [ intro + | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. + elim (p (eps / 2) H0); intros. + exists x0; intros. + unfold R_dist in |- *; + apply Rle_lt_trans with (Rabs (Un n - x) + Rabs (x - Un m)). + replace (Un n - Un m) with (Un n - x + (x - Un m)); + [ apply Rabs_triang | ring ]. + rewrite (double_var eps); apply Rplus_lt_compat. + apply H1; assumption. + rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H1; assumption. Qed. (**********) Lemma maj_by_pos : - forall Un:nat -> R, - sigT (fun l:R => Un_cv Un l) -> + forall Un:nat -> R, + sigT (fun l:R => Un_cv Un l) -> exists l : R, 0 < l /\ (forall n:nat, Rabs (Un n) <= l). -intros Un X; elim X; intros. -cut (sigT (fun l:R => Un_cv (fun k:nat => Rabs (Un k)) l)). -intro X0. -assert (H := CV_Cauchy (fun k:nat => Rabs (Un k)) X0). -assert (H0 := cauchy_bound (fun k:nat => Rabs (Un k)) H). -elim H0; intros. -exists (x0 + 1). -cut (0 <= x0). -intro. -split. -apply Rplus_le_lt_0_compat; [ assumption | apply Rlt_0_1 ]. -intros. -apply Rle_trans with x0. -unfold is_upper_bound in H1. -apply H1. -exists n; reflexivity. -pattern x0 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; - apply Rlt_0_1. -apply Rle_trans with (Rabs (Un 0%nat)). -apply Rabs_pos. -unfold is_upper_bound in H1. -apply H1. -exists 0%nat; reflexivity. -apply existT with (Rabs x). -apply cv_cvabs; assumption. +Proof. + intros Un X; elim X; intros. + cut (sigT (fun l:R => Un_cv (fun k:nat => Rabs (Un k)) l)). + intro X0. + assert (H := CV_Cauchy (fun k:nat => Rabs (Un k)) X0). + assert (H0 := cauchy_bound (fun k:nat => Rabs (Un k)) H). + elim H0; intros. + exists (x0 + 1). + cut (0 <= x0). + intro. + split. + apply Rplus_le_lt_0_compat; [ assumption | apply Rlt_0_1 ]. + intros. + apply Rle_trans with x0. + unfold is_upper_bound in H1. + apply H1. + exists n; reflexivity. + pattern x0 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; + apply Rlt_0_1. + apply Rle_trans with (Rabs (Un 0%nat)). + apply Rabs_pos. + unfold is_upper_bound in H1. + apply H1. + exists 0%nat; reflexivity. + apply existT with (Rabs x). + apply cv_cvabs; assumption. Qed. (**********) Lemma CV_mult : - forall (An Bn:nat -> R) (l1 l2:R), - Un_cv An l1 -> Un_cv Bn l2 -> Un_cv (fun i:nat => An i * Bn i) (l1 * l2). -intros. -cut (sigT (fun l:R => Un_cv An l)). -intro X. -assert (H1 := maj_by_pos An X). -elim H1; intros M H2. -elim H2; intros. -unfold Un_cv in |- *; unfold R_dist in |- *; intros. -cut (0 < eps / (2 * M)). -intro. -case (Req_dec l2 0); intro. -unfold Un_cv in H0; unfold R_dist in H0. -elim (H0 (eps / (2 * M)) H6); intros. -exists x; intros. -apply Rle_lt_trans with - (Rabs (An n * Bn n - An n * l2) + Rabs (An n * l2 - l1 * l2)). -replace (An n * Bn n - l1 * l2) with - (An n * Bn n - An n * l2 + (An n * l2 - l1 * l2)); - [ apply Rabs_triang | ring ]. -replace (Rabs (An n * Bn n - An n * l2)) with - (Rabs (An n) * Rabs (Bn n - l2)). -replace (Rabs (An n * l2 - l1 * l2)) with 0. -rewrite Rplus_0_r. -apply Rle_lt_trans with (M * Rabs (Bn n - l2)). -do 2 rewrite <- (Rmult_comm (Rabs (Bn n - l2))). -apply Rmult_le_compat_l. -apply Rabs_pos. -apply H4. -apply Rmult_lt_reg_l with (/ M). -apply Rinv_0_lt_compat; apply H3. -rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_l; rewrite (Rmult_comm (/ M)). -apply Rlt_trans with (eps / (2 * M)). -apply H8; assumption. -unfold Rdiv in |- *; rewrite Rinv_mult_distr. -apply Rmult_lt_reg_l with 2. -prove_sup0. -replace (2 * (eps * (/ 2 * / M))) with (2 * / 2 * (eps * / M)); - [ idtac | ring ]. -rewrite <- Rinv_r_sym. -rewrite Rmult_1_l; rewrite double. -pattern (eps * / M) at 1 in |- *; rewrite <- Rplus_0_r. -apply Rplus_lt_compat_l; apply Rmult_lt_0_compat; - [ assumption | apply Rinv_0_lt_compat; assumption ]. -discrR. -discrR. -red in |- *; intro; rewrite H10 in H3; elim (Rlt_irrefl _ H3). -red in |- *; intro; rewrite H10 in H3; elim (Rlt_irrefl _ H3). -rewrite H7; do 2 rewrite Rmult_0_r; unfold Rminus in |- *; - rewrite Rplus_opp_r; rewrite Rabs_R0; reflexivity. -replace (An n * Bn n - An n * l2) with (An n * (Bn n - l2)); [ idtac | ring ]. -symmetry in |- *; apply Rabs_mult. -cut (0 < eps / (2 * Rabs l2)). -intro. -unfold Un_cv in H; unfold R_dist in H; unfold Un_cv in H0; - unfold R_dist in H0. -elim (H (eps / (2 * Rabs l2)) H8); intros N1 H9. -elim (H0 (eps / (2 * M)) H6); intros N2 H10. -set (N := max N1 N2). -exists N; intros. -apply Rle_lt_trans with - (Rabs (An n * Bn n - An n * l2) + Rabs (An n * l2 - l1 * l2)). -replace (An n * Bn n - l1 * l2) with - (An n * Bn n - An n * l2 + (An n * l2 - l1 * l2)); - [ apply Rabs_triang | ring ]. -replace (Rabs (An n * Bn n - An n * l2)) with - (Rabs (An n) * Rabs (Bn n - l2)). -replace (Rabs (An n * l2 - l1 * l2)) with (Rabs l2 * Rabs (An n - l1)). -rewrite (double_var eps); apply Rplus_lt_compat. -apply Rle_lt_trans with (M * Rabs (Bn n - l2)). -do 2 rewrite <- (Rmult_comm (Rabs (Bn n - l2))). -apply Rmult_le_compat_l. -apply Rabs_pos. -apply H4. -apply Rmult_lt_reg_l with (/ M). -apply Rinv_0_lt_compat; apply H3. -rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_l; rewrite (Rmult_comm (/ M)). -apply Rlt_le_trans with (eps / (2 * M)). -apply H10. -unfold ge in |- *; apply le_trans with N. -unfold N in |- *; apply le_max_r. -assumption. -unfold Rdiv in |- *; rewrite Rinv_mult_distr. -right; ring. -discrR. -red in |- *; intro; rewrite H12 in H3; elim (Rlt_irrefl _ H3). -red in |- *; intro; rewrite H12 in H3; elim (Rlt_irrefl _ H3). -apply Rmult_lt_reg_l with (/ Rabs l2). -apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. -rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_l; apply Rlt_le_trans with (eps / (2 * Rabs l2)). -apply H9. -unfold ge in |- *; apply le_trans with N. -unfold N in |- *; apply le_max_l. -assumption. -unfold Rdiv in |- *; right; rewrite Rinv_mult_distr. -ring. -discrR. -apply Rabs_no_R0; assumption. -apply Rabs_no_R0; assumption. -replace (An n * l2 - l1 * l2) with (l2 * (An n - l1)); - [ symmetry in |- *; apply Rabs_mult | ring ]. -replace (An n * Bn n - An n * l2) with (An n * (Bn n - l2)); - [ symmetry in |- *; apply Rabs_mult | ring ]. -unfold Rdiv in |- *; apply Rmult_lt_0_compat. -assumption. -apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; - [ prove_sup0 | apply Rabs_pos_lt; assumption ]. -unfold Rdiv in |- *; apply Rmult_lt_0_compat; - [ assumption - | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; - [ prove_sup0 | assumption ] ]. -apply existT with l1; assumption. + forall (An Bn:nat -> R) (l1 l2:R), + Un_cv An l1 -> Un_cv Bn l2 -> Un_cv (fun i:nat => An i * Bn i) (l1 * l2). +Proof. + intros. + cut (sigT (fun l:R => Un_cv An l)). + intro X. + assert (H1 := maj_by_pos An X). + elim H1; intros M H2. + elim H2; intros. + unfold Un_cv in |- *; unfold R_dist in |- *; intros. + cut (0 < eps / (2 * M)). + intro. + case (Req_dec l2 0); intro. + unfold Un_cv in H0; unfold R_dist in H0. + elim (H0 (eps / (2 * M)) H6); intros. + exists x; intros. + apply Rle_lt_trans with + (Rabs (An n * Bn n - An n * l2) + Rabs (An n * l2 - l1 * l2)). + replace (An n * Bn n - l1 * l2) with + (An n * Bn n - An n * l2 + (An n * l2 - l1 * l2)); + [ apply Rabs_triang | ring ]. + replace (Rabs (An n * Bn n - An n * l2)) with + (Rabs (An n) * Rabs (Bn n - l2)). + replace (Rabs (An n * l2 - l1 * l2)) with 0. + rewrite Rplus_0_r. + apply Rle_lt_trans with (M * Rabs (Bn n - l2)). + do 2 rewrite <- (Rmult_comm (Rabs (Bn n - l2))). + apply Rmult_le_compat_l. + apply Rabs_pos. + apply H4. + apply Rmult_lt_reg_l with (/ M). + apply Rinv_0_lt_compat; apply H3. + rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_l; rewrite (Rmult_comm (/ M)). + apply Rlt_trans with (eps / (2 * M)). + apply H8; assumption. + unfold Rdiv in |- *; rewrite Rinv_mult_distr. + apply Rmult_lt_reg_l with 2. + prove_sup0. + replace (2 * (eps * (/ 2 * / M))) with (2 * / 2 * (eps * / M)); + [ idtac | ring ]. + rewrite <- Rinv_r_sym. + rewrite Rmult_1_l; rewrite double. + pattern (eps * / M) at 1 in |- *; rewrite <- Rplus_0_r. + apply Rplus_lt_compat_l; apply Rmult_lt_0_compat; + [ assumption | apply Rinv_0_lt_compat; assumption ]. + discrR. + discrR. + red in |- *; intro; rewrite H10 in H3; elim (Rlt_irrefl _ H3). + red in |- *; intro; rewrite H10 in H3; elim (Rlt_irrefl _ H3). + rewrite H7; do 2 rewrite Rmult_0_r; unfold Rminus in |- *; + rewrite Rplus_opp_r; rewrite Rabs_R0; reflexivity. + replace (An n * Bn n - An n * l2) with (An n * (Bn n - l2)); [ idtac | ring ]. + symmetry in |- *; apply Rabs_mult. + cut (0 < eps / (2 * Rabs l2)). + intro. + unfold Un_cv in H; unfold R_dist in H; unfold Un_cv in H0; + unfold R_dist in H0. + elim (H (eps / (2 * Rabs l2)) H8); intros N1 H9. + elim (H0 (eps / (2 * M)) H6); intros N2 H10. + set (N := max N1 N2). + exists N; intros. + apply Rle_lt_trans with + (Rabs (An n * Bn n - An n * l2) + Rabs (An n * l2 - l1 * l2)). + replace (An n * Bn n - l1 * l2) with + (An n * Bn n - An n * l2 + (An n * l2 - l1 * l2)); + [ apply Rabs_triang | ring ]. + replace (Rabs (An n * Bn n - An n * l2)) with + (Rabs (An n) * Rabs (Bn n - l2)). + replace (Rabs (An n * l2 - l1 * l2)) with (Rabs l2 * Rabs (An n - l1)). + rewrite (double_var eps); apply Rplus_lt_compat. + apply Rle_lt_trans with (M * Rabs (Bn n - l2)). + do 2 rewrite <- (Rmult_comm (Rabs (Bn n - l2))). + apply Rmult_le_compat_l. + apply Rabs_pos. + apply H4. + apply Rmult_lt_reg_l with (/ M). + apply Rinv_0_lt_compat; apply H3. + rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_l; rewrite (Rmult_comm (/ M)). + apply Rlt_le_trans with (eps / (2 * M)). + apply H10. + unfold ge in |- *; apply le_trans with N. + unfold N in |- *; apply le_max_r. + assumption. + unfold Rdiv in |- *; rewrite Rinv_mult_distr. + right; ring. + discrR. + red in |- *; intro; rewrite H12 in H3; elim (Rlt_irrefl _ H3). + red in |- *; intro; rewrite H12 in H3; elim (Rlt_irrefl _ H3). + apply Rmult_lt_reg_l with (/ Rabs l2). + apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. + rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_l; apply Rlt_le_trans with (eps / (2 * Rabs l2)). + apply H9. + unfold ge in |- *; apply le_trans with N. + unfold N in |- *; apply le_max_l. + assumption. + unfold Rdiv in |- *; right; rewrite Rinv_mult_distr. + ring. + discrR. + apply Rabs_no_R0; assumption. + apply Rabs_no_R0; assumption. + replace (An n * l2 - l1 * l2) with (l2 * (An n - l1)); + [ symmetry in |- *; apply Rabs_mult | ring ]. + replace (An n * Bn n - An n * l2) with (An n * (Bn n - l2)); + [ symmetry in |- *; apply Rabs_mult | ring ]. + unfold Rdiv in |- *; apply Rmult_lt_0_compat. + assumption. + apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; + [ prove_sup0 | apply Rabs_pos_lt; assumption ]. + unfold Rdiv in |- *; apply Rmult_lt_0_compat; + [ assumption + | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; + [ prove_sup0 | assumption ] ]. + apply existT with l1; assumption. Qed. Lemma tech9 : - forall Un:nat -> R, - Un_growing Un -> forall m n:nat, (m <= n)%nat -> Un m <= Un n. -intros; unfold Un_growing in H. -induction n as [| n Hrecn]. -induction m as [| m Hrecm]. -right; reflexivity. -elim (le_Sn_O _ H0). -cut ((m <= n)%nat \/ m = S n). -intro; elim H1; intro. -apply Rle_trans with (Un n). -apply Hrecn; assumption. -apply H. -rewrite H2; right; reflexivity. -inversion H0. -right; reflexivity. -left; assumption. + forall Un:nat -> R, + Un_growing Un -> forall m n:nat, (m <= n)%nat -> Un m <= Un n. +Proof. + intros; unfold Un_growing in H. + induction n as [| n Hrecn]. + induction m as [| m Hrecm]. + right; reflexivity. + elim (le_Sn_O _ H0). + cut ((m <= n)%nat \/ m = S n). + intro; elim H1; intro. + apply Rle_trans with (Un n). + apply Hrecn; assumption. + apply H. + rewrite H2; right; reflexivity. + inversion H0. + right; reflexivity. + left; assumption. Qed. Lemma tech10 : - forall (Un:nat -> R) (x:R), Un_growing Un -> is_lub (EUn Un) x -> Un_cv Un x. -intros; cut (bound (EUn Un)). -intro; assert (H2 := Un_cv_crit _ H H1). -elim H2; intros. -case (total_order_T x x0); intro. -elim s; intro. -cut (forall n:nat, Un n <= x). -intro; unfold Un_cv in H3; cut (0 < x0 - x). -intro; elim (H3 (x0 - x) H5); intros. -cut (x1 >= x1)%nat. -intro; assert (H8 := H6 x1 H7). -unfold R_dist in H8; rewrite Rabs_left1 in H8. -rewrite Ropp_minus_distr in H8; unfold Rminus in H8. -assert (H9 := Rplus_lt_reg_r x0 _ _ H8). -assert (H10 := Ropp_lt_cancel _ _ H9). -assert (H11 := H4 x1). -elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H10 H11)). -apply Rle_minus; apply Rle_trans with x. -apply H4. -left; assumption. -unfold ge in |- *; apply le_n. -apply Rgt_minus; assumption. -intro; unfold is_lub in H0; unfold is_upper_bound in H0; elim H0; intros. -apply H4; unfold EUn in |- *; exists n; reflexivity. -rewrite b; assumption. -cut (forall n:nat, Un n <= x0). -intro; unfold is_lub in H0; unfold is_upper_bound in H0; elim H0; intros. -cut (forall y:R, EUn Un y -> y <= x0). -intro; assert (H8 := H6 _ H7). -elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H8 r)). -unfold EUn in |- *; intros; elim H7; intros. -rewrite H8; apply H4. -intro; case (Rle_dec (Un n) x0); intro. -assumption. -cut (forall n0:nat, (n <= n0)%nat -> x0 < Un n0). -intro; unfold Un_cv in H3; cut (0 < Un n - x0). -intro; elim (H3 (Un n - x0) H5); intros. -cut (max n x1 >= x1)%nat. -intro; assert (H8 := H6 (max n x1) H7). -unfold R_dist in H8. -rewrite Rabs_right in H8. -unfold Rminus in H8; do 2 rewrite <- (Rplus_comm (- x0)) in H8. -assert (H9 := Rplus_lt_reg_r _ _ _ H8). -cut (Un n <= Un (max n x1)). -intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H10 H9)). -apply tech9; [ assumption | apply le_max_l ]. -apply Rge_trans with (Un n - x0). -unfold Rminus in |- *; apply Rle_ge; do 2 rewrite <- (Rplus_comm (- x0)); - apply Rplus_le_compat_l. -apply tech9; [ assumption | apply le_max_l ]. -left; assumption. -unfold ge in |- *; apply le_max_r. -apply Rplus_lt_reg_r with x0. -rewrite Rplus_0_r; unfold Rminus in |- *; rewrite (Rplus_comm x0); - rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; - apply H4; apply le_n. -intros; apply Rlt_le_trans with (Un n). -case (Rlt_le_dec x0 (Un n)); intro. -assumption. -elim n0; assumption. -apply tech9; assumption. -unfold bound in |- *; exists x; unfold is_lub in H0; elim H0; intros; - assumption. + forall (Un:nat -> R) (x:R), Un_growing Un -> is_lub (EUn Un) x -> Un_cv Un x. +Proof. + intros; cut (bound (EUn Un)). + intro; assert (H2 := Un_cv_crit _ H H1). + elim H2; intros. + case (total_order_T x x0); intro. + elim s; intro. + cut (forall n:nat, Un n <= x). + intro; unfold Un_cv in H3; cut (0 < x0 - x). + intro; elim (H3 (x0 - x) H5); intros. + cut (x1 >= x1)%nat. + intro; assert (H8 := H6 x1 H7). + unfold R_dist in H8; rewrite Rabs_left1 in H8. + rewrite Ropp_minus_distr in H8; unfold Rminus in H8. + assert (H9 := Rplus_lt_reg_r x0 _ _ H8). + assert (H10 := Ropp_lt_cancel _ _ H9). + assert (H11 := H4 x1). + elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H10 H11)). + apply Rle_minus; apply Rle_trans with x. + apply H4. + left; assumption. + unfold ge in |- *; apply le_n. + apply Rgt_minus; assumption. + intro; unfold is_lub in H0; unfold is_upper_bound in H0; elim H0; intros. + apply H4; unfold EUn in |- *; exists n; reflexivity. + rewrite b; assumption. + cut (forall n:nat, Un n <= x0). + intro; unfold is_lub in H0; unfold is_upper_bound in H0; elim H0; intros. + cut (forall y:R, EUn Un y -> y <= x0). + intro; assert (H8 := H6 _ H7). + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H8 r)). + unfold EUn in |- *; intros; elim H7; intros. + rewrite H8; apply H4. + intro; case (Rle_dec (Un n) x0); intro. + assumption. + cut (forall n0:nat, (n <= n0)%nat -> x0 < Un n0). + intro; unfold Un_cv in H3; cut (0 < Un n - x0). + intro; elim (H3 (Un n - x0) H5); intros. + cut (max n x1 >= x1)%nat. + intro; assert (H8 := H6 (max n x1) H7). + unfold R_dist in H8. + rewrite Rabs_right in H8. + unfold Rminus in H8; do 2 rewrite <- (Rplus_comm (- x0)) in H8. + assert (H9 := Rplus_lt_reg_r _ _ _ H8). + cut (Un n <= Un (max n x1)). + intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H10 H9)). + apply tech9; [ assumption | apply le_max_l ]. + apply Rge_trans with (Un n - x0). + unfold Rminus in |- *; apply Rle_ge; do 2 rewrite <- (Rplus_comm (- x0)); + apply Rplus_le_compat_l. + apply tech9; [ assumption | apply le_max_l ]. + left; assumption. + unfold ge in |- *; apply le_max_r. + apply Rplus_lt_reg_r with x0. + rewrite Rplus_0_r; unfold Rminus in |- *; rewrite (Rplus_comm x0); + rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; + apply H4; apply le_n. + intros; apply Rlt_le_trans with (Un n). + case (Rlt_le_dec x0 (Un n)); intro. + assumption. + elim n0; assumption. + apply tech9; assumption. + unfold bound in |- *; exists x; unfold is_lub in H0; elim H0; intros; + assumption. Qed. Lemma tech13 : - forall (An:nat -> R) (k:R), - 0 <= k < 1 -> - Un_cv (fun n:nat => Rabs (An (S n) / An n)) k -> + forall (An:nat -> R) (k:R), + 0 <= k < 1 -> + Un_cv (fun n:nat => Rabs (An (S n) / An n)) k -> exists k0 : R, - k < k0 < 1 /\ - (exists N : nat, + k < k0 < 1 /\ + (exists N : nat, (forall n:nat, (N <= n)%nat -> Rabs (An (S n) / An n) < k0)). -intros; exists (k + (1 - k) / 2). -split. -split. -pattern k at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l. -unfold Rdiv in |- *; apply Rmult_lt_0_compat. -apply Rplus_lt_reg_r with k; rewrite Rplus_0_r; replace (k + (1 - k)) with 1; - [ elim H; intros; assumption | ring ]. -apply Rinv_0_lt_compat; prove_sup0. -apply Rmult_lt_reg_l with 2. -prove_sup0. -unfold Rdiv in |- *; rewrite Rmult_1_r; rewrite Rmult_plus_distr_l; - pattern 2 at 1 in |- *; rewrite Rmult_comm; rewrite Rmult_assoc; - rewrite <- Rinv_l_sym; [ idtac | discrR ]; rewrite Rmult_1_r; - replace (2 * k + (1 - k)) with (1 + k); [ idtac | ring ]. -elim H; intros. -apply Rplus_lt_compat_l; assumption. -unfold Un_cv in H0; cut (0 < (1 - k) / 2). -intro; elim (H0 ((1 - k) / 2) H1); intros. -exists x; intros. -assert (H4 := H2 n H3). -unfold R_dist in H4; rewrite <- Rabs_Rabsolu; - replace (Rabs (An (S n) / An n)) with (Rabs (An (S n) / An n) - k + k); - [ idtac | ring ]; - apply Rle_lt_trans with (Rabs (Rabs (An (S n) / An n) - k) + Rabs k). -apply Rabs_triang. -rewrite (Rabs_right k). -apply Rplus_lt_reg_r with (- k); rewrite <- (Rplus_comm k); - repeat rewrite <- Rplus_assoc; rewrite Rplus_opp_l; - repeat rewrite Rplus_0_l; apply H4. -apply Rle_ge; elim H; intros; assumption. -unfold Rdiv in |- *; apply Rmult_lt_0_compat. -apply Rplus_lt_reg_r with k; rewrite Rplus_0_r; elim H; intros; - replace (k + (1 - k)) with 1; [ assumption | ring ]. -apply Rinv_0_lt_compat; prove_sup0. +Proof. + intros; exists (k + (1 - k) / 2). + split. + split. + pattern k at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l. + unfold Rdiv in |- *; apply Rmult_lt_0_compat. + apply Rplus_lt_reg_r with k; rewrite Rplus_0_r; replace (k + (1 - k)) with 1; + [ elim H; intros; assumption | ring ]. + apply Rinv_0_lt_compat; prove_sup0. + apply Rmult_lt_reg_l with 2. + prove_sup0. + unfold Rdiv in |- *; rewrite Rmult_1_r; rewrite Rmult_plus_distr_l; + pattern 2 at 1 in |- *; rewrite Rmult_comm; rewrite Rmult_assoc; + rewrite <- Rinv_l_sym; [ idtac | discrR ]; rewrite Rmult_1_r; + replace (2 * k + (1 - k)) with (1 + k); [ idtac | ring ]. + elim H; intros. + apply Rplus_lt_compat_l; assumption. + unfold Un_cv in H0; cut (0 < (1 - k) / 2). + intro; elim (H0 ((1 - k) / 2) H1); intros. + exists x; intros. + assert (H4 := H2 n H3). + unfold R_dist in H4; rewrite <- Rabs_Rabsolu; + replace (Rabs (An (S n) / An n)) with (Rabs (An (S n) / An n) - k + k); + [ idtac | ring ]; + apply Rle_lt_trans with (Rabs (Rabs (An (S n) / An n) - k) + Rabs k). + apply Rabs_triang. + rewrite (Rabs_right k). + apply Rplus_lt_reg_r with (- k); rewrite <- (Rplus_comm k); + repeat rewrite <- Rplus_assoc; rewrite Rplus_opp_l; + repeat rewrite Rplus_0_l; apply H4. + apply Rle_ge; elim H; intros; assumption. + unfold Rdiv in |- *; apply Rmult_lt_0_compat. + apply Rplus_lt_reg_r with k; rewrite Rplus_0_r; elim H; intros; + replace (k + (1 - k)) with 1; [ assumption | ring ]. + apply Rinv_0_lt_compat; prove_sup0. Qed. (**********) Lemma growing_ineq : - forall (Un:nat -> R) (l:R), - Un_growing Un -> Un_cv Un l -> forall n:nat, Un n <= l. -intros; case (total_order_T (Un n) l); intro. -elim s; intro. -left; assumption. -right; assumption. -cut (0 < Un n - l). -intro; unfold Un_cv in H0; unfold R_dist in H0. -elim (H0 (Un n - l) H1); intros N1 H2. -set (N := max n N1). -cut (Un n - l <= Un N - l). -intro; cut (Un N - l < Un n - l). -intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H3 H4)). -apply Rle_lt_trans with (Rabs (Un N - l)). -apply RRle_abs. -apply H2. -unfold ge, N in |- *; apply le_max_r. -unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- l)); - apply Rplus_le_compat_l. -apply tech9. -assumption. -unfold N in |- *; apply le_max_l. -apply Rplus_lt_reg_r with l. -rewrite Rplus_0_r. -replace (l + (Un n - l)) with (Un n); [ assumption | ring ]. + forall (Un:nat -> R) (l:R), + Un_growing Un -> Un_cv Un l -> forall n:nat, Un n <= l. +Proof. + intros; case (total_order_T (Un n) l); intro. + elim s; intro. + left; assumption. + right; assumption. + cut (0 < Un n - l). + intro; unfold Un_cv in H0; unfold R_dist in H0. + elim (H0 (Un n - l) H1); intros N1 H2. + set (N := max n N1). + cut (Un n - l <= Un N - l). + intro; cut (Un N - l < Un n - l). + intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H3 H4)). + apply Rle_lt_trans with (Rabs (Un N - l)). + apply RRle_abs. + apply H2. + unfold ge, N in |- *; apply le_max_r. + unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- l)); + apply Rplus_le_compat_l. + apply tech9. + assumption. + unfold N in |- *; apply le_max_l. + apply Rplus_lt_reg_r with l. + rewrite Rplus_0_r. + replace (l + (Un n - l)) with (Un n); [ assumption | ring ]. Qed. -(* Un->l => (-Un) -> (-l) *) +(** Un->l => (-Un) -> (-l) *) Lemma CV_opp : - forall (An:nat -> R) (l:R), Un_cv An l -> Un_cv (opp_seq An) (- l). -intros An l. -unfold Un_cv in |- *; unfold R_dist in |- *; intros. -elim (H eps H0); intros. -exists x; intros. -unfold opp_seq in |- *; replace (- An n - - l) with (- (An n - l)); - [ rewrite Rabs_Ropp | ring ]. -apply H1; assumption. + forall (An:nat -> R) (l:R), Un_cv An l -> Un_cv (opp_seq An) (- l). +Proof. + intros An l. + unfold Un_cv in |- *; unfold R_dist in |- *; intros. + elim (H eps H0); intros. + exists x; intros. + unfold opp_seq in |- *; replace (- An n - - l) with (- (An n - l)); + [ rewrite Rabs_Ropp | ring ]. + apply H1; assumption. Qed. (**********) Lemma decreasing_ineq : - forall (Un:nat -> R) (l:R), - Un_decreasing Un -> Un_cv Un l -> forall n:nat, l <= Un n. -intros. -assert (H1 := decreasing_growing _ H). -assert (H2 := CV_opp _ _ H0). -assert (H3 := growing_ineq _ _ H1 H2). -apply Ropp_le_cancel. -unfold opp_seq in H3; apply H3. + forall (Un:nat -> R) (l:R), + Un_decreasing Un -> Un_cv Un l -> forall n:nat, l <= Un n. +Proof. + intros. + assert (H1 := decreasing_growing _ H). + assert (H2 := CV_opp _ _ H0). + assert (H3 := growing_ineq _ _ H1 H2). + apply Ropp_le_cancel. + unfold opp_seq in H3; apply H3. Qed. (**********) Lemma CV_minus : - forall (An Bn:nat -> R) (l1 l2:R), - Un_cv An l1 -> Un_cv Bn l2 -> Un_cv (fun i:nat => An i - Bn i) (l1 - l2). -intros. -replace (fun i:nat => An i - Bn i) with (fun i:nat => An i + opp_seq Bn i). -unfold Rminus in |- *; apply CV_plus. -assumption. -apply CV_opp; assumption. -unfold Rminus, opp_seq in |- *; reflexivity. + forall (An Bn:nat -> R) (l1 l2:R), + Un_cv An l1 -> Un_cv Bn l2 -> Un_cv (fun i:nat => An i - Bn i) (l1 - l2). +Proof. + intros. + replace (fun i:nat => An i - Bn i) with (fun i:nat => An i + opp_seq Bn i). + unfold Rminus in |- *; apply CV_plus. + assumption. + apply CV_opp; assumption. + unfold Rminus, opp_seq in |- *; reflexivity. Qed. -(* Un -> +oo *) +(** Un -> +oo *) Definition cv_infty (Un:nat -> R) : Prop := forall M:R, exists N : nat, (forall n:nat, (N <= n)%nat -> M < Un n). -(* Un -> +oo => /Un -> O *) +(** Un -> +oo => /Un -> O *) Lemma cv_infty_cv_R0 : - forall Un:nat -> R, - (forall n:nat, Un n <> 0) -> cv_infty Un -> Un_cv (fun n:nat => / Un n) 0. -unfold cv_infty, Un_cv in |- *; unfold R_dist in |- *; intros. -elim (H0 (/ eps)); intros N0 H2. -exists N0; intros. -unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; - rewrite (Rabs_Rinv _ (H n)). -apply Rmult_lt_reg_l with (Rabs (Un n)). -apply Rabs_pos_lt; apply H. -rewrite <- Rinv_r_sym. -apply Rmult_lt_reg_l with (/ eps). -apply Rinv_0_lt_compat; assumption. -rewrite Rmult_1_r; rewrite (Rmult_comm (/ eps)); rewrite Rmult_assoc; - rewrite <- Rinv_r_sym. -rewrite Rmult_1_r; apply Rlt_le_trans with (Un n). -apply H2; assumption. -apply RRle_abs. -red in |- *; intro; rewrite H4 in H1; elim (Rlt_irrefl _ H1). -apply Rabs_no_R0; apply H. + forall Un:nat -> R, + (forall n:nat, Un n <> 0) -> cv_infty Un -> Un_cv (fun n:nat => / Un n) 0. +Proof. + unfold cv_infty, Un_cv in |- *; unfold R_dist in |- *; intros. + elim (H0 (/ eps)); intros N0 H2. + exists N0; intros. + unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; + rewrite (Rabs_Rinv _ (H n)). + apply Rmult_lt_reg_l with (Rabs (Un n)). + apply Rabs_pos_lt; apply H. + rewrite <- Rinv_r_sym. + apply Rmult_lt_reg_l with (/ eps). + apply Rinv_0_lt_compat; assumption. + rewrite Rmult_1_r; rewrite (Rmult_comm (/ eps)); rewrite Rmult_assoc; + rewrite <- Rinv_r_sym. + rewrite Rmult_1_r; apply Rlt_le_trans with (Un n). + apply H2; assumption. + apply RRle_abs. + red in |- *; intro; rewrite H4 in H1; elim (Rlt_irrefl _ H1). + apply Rabs_no_R0; apply H. Qed. (**********) Lemma decreasing_prop : - forall (Un:nat -> R) (m n:nat), - Un_decreasing Un -> (m <= n)%nat -> Un n <= Un m. -unfold Un_decreasing in |- *; intros. -induction n as [| n Hrecn]. -induction m as [| m Hrecm]. -right; reflexivity. -elim (le_Sn_O _ H0). -cut ((m <= n)%nat \/ m = S n). -intro; elim H1; intro. -apply Rle_trans with (Un n). -apply H. -apply Hrecn; assumption. -rewrite H2; right; reflexivity. -inversion H0; [ right; reflexivity | left; assumption ]. + forall (Un:nat -> R) (m n:nat), + Un_decreasing Un -> (m <= n)%nat -> Un n <= Un m. +Proof. + unfold Un_decreasing in |- *; intros. + induction n as [| n Hrecn]. + induction m as [| m Hrecm]. + right; reflexivity. + elim (le_Sn_O _ H0). + cut ((m <= n)%nat \/ m = S n). + intro; elim H1; intro. + apply Rle_trans with (Un n). + apply H. + apply Hrecn; assumption. + rewrite H2; right; reflexivity. + inversion H0; [ right; reflexivity | left; assumption ]. Qed. -(* |x|^n/n! -> 0 *) +(** |x|^n/n! -> 0 *) Lemma cv_speed_pow_fact : - forall x:R, Un_cv (fun n:nat => x ^ n / INR (fact n)) 0. -intro; - cut - (Un_cv (fun n:nat => Rabs x ^ n / INR (fact n)) 0 -> - Un_cv (fun n:nat => x ^ n / INR (fact n)) 0). -intro; apply H. -unfold Un_cv in |- *; unfold R_dist in |- *; intros; case (Req_dec x 0); - intro. -exists 1%nat; intros. -rewrite H1; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; - rewrite Rabs_R0; rewrite pow_ne_zero; - [ unfold Rdiv in |- *; rewrite Rmult_0_l; rewrite Rabs_R0; assumption - | red in |- *; intro; rewrite H3 in H2; elim (le_Sn_n _ H2) ]. -assert (H2 := Rabs_pos_lt x H1); set (M := up (Rabs x)); cut (0 <= M)%Z. -intro; elim (IZN M H3); intros M_nat H4. -set (Un := fun n:nat => Rabs x ^ (M_nat + n) / INR (fact (M_nat + n))). -cut (Un_cv Un 0); unfold Un_cv in |- *; unfold R_dist in |- *; intros. -elim (H5 eps H0); intros N H6. -exists (M_nat + N)%nat; intros; - cut (exists p : nat, (p >= N)%nat /\ n = (M_nat + p)%nat). -intro; elim H8; intros p H9. -elim H9; intros; rewrite H11; unfold Un in H6; apply H6; assumption. -exists (n - M_nat)%nat. -split. -unfold ge in |- *; apply (fun p n m:nat => plus_le_reg_l n m p) with M_nat; - rewrite <- le_plus_minus. -assumption. -apply le_trans with (M_nat + N)%nat. -apply le_plus_l. -assumption. -apply le_plus_minus; apply le_trans with (M_nat + N)%nat; - [ apply le_plus_l | assumption ]. -set (Vn := fun n:nat => Rabs x * (Un 0%nat / INR (S n))). -cut (1 <= M_nat)%nat. -intro; cut (forall n:nat, 0 < Un n). -intro; cut (Un_decreasing Un). -intro; cut (forall n:nat, Un (S n) <= Vn n). -intro; cut (Un_cv Vn 0). -unfold Un_cv in |- *; unfold R_dist in |- *; intros. -elim (H10 eps0 H5); intros N1 H11. -exists (S N1); intros. -cut (forall n:nat, 0 < Vn n). -intro; apply Rle_lt_trans with (Rabs (Vn (pred n) - 0)). -repeat rewrite Rabs_right. -unfold Rminus in |- *; rewrite Ropp_0; do 2 rewrite Rplus_0_r; - replace n with (S (pred n)). -apply H9. -inversion H12; simpl in |- *; reflexivity. -apply Rle_ge; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; left; - apply H13. -apply Rle_ge; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; left; - apply H7. -apply H11; unfold ge in |- *; apply le_S_n; replace (S (pred n)) with n; - [ unfold ge in H12; exact H12 | inversion H12; simpl in |- *; reflexivity ]. -intro; apply Rlt_le_trans with (Un (S n0)); [ apply H7 | apply H9 ]. -cut (cv_infty (fun n:nat => INR (S n))). -intro; cut (Un_cv (fun n:nat => / INR (S n)) 0). -unfold Un_cv, R_dist in |- *; intros; unfold Vn in |- *. -cut (0 < eps1 / (Rabs x * Un 0%nat)). -intro; elim (H11 _ H13); intros N H14. -exists N; intros; - replace (Rabs x * (Un 0%nat / INR (S n)) - 0) with - (Rabs x * Un 0%nat * (/ INR (S n) - 0)); - [ idtac | unfold Rdiv in |- *; ring ]. -rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs (Rabs x * Un 0%nat)). -apply Rinv_0_lt_compat; apply Rabs_pos_lt. -apply prod_neq_R0. -apply Rabs_no_R0; assumption. -assert (H16 := H7 0%nat); red in |- *; intro; rewrite H17 in H16; - elim (Rlt_irrefl _ H16). -rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_l. -replace (/ Rabs (Rabs x * Un 0%nat) * eps1) with (eps1 / (Rabs x * Un 0%nat)). -apply H14; assumption. -unfold Rdiv in |- *; rewrite (Rabs_right (Rabs x * Un 0%nat)). -apply Rmult_comm. -apply Rle_ge; apply Rmult_le_pos. -apply Rabs_pos. -left; apply H7. -apply Rabs_no_R0. -apply prod_neq_R0; - [ apply Rabs_no_R0; assumption - | assert (H16 := H7 0%nat); red in |- *; intro; rewrite H17 in H16; - elim (Rlt_irrefl _ H16) ]. -unfold Rdiv in |- *; apply Rmult_lt_0_compat. -assumption. -apply Rinv_0_lt_compat; apply Rmult_lt_0_compat. -apply Rabs_pos_lt; assumption. -apply H7. -apply (cv_infty_cv_R0 (fun n:nat => INR (S n))). -intro; apply not_O_INR; discriminate. -assumption. -unfold cv_infty in |- *; intro; case (total_order_T M0 0); intro. -elim s; intro. -exists 0%nat; intros. -apply Rlt_trans with 0; [ assumption | apply lt_INR_0; apply lt_O_Sn ]. -exists 0%nat; intros; rewrite b; apply lt_INR_0; apply lt_O_Sn. -set (M0_z := up M0). -assert (H10 := archimed M0). -cut (0 <= M0_z)%Z. -intro; elim (IZN _ H11); intros M0_nat H12. -exists M0_nat; intros. -apply Rlt_le_trans with (IZR M0_z). -elim H10; intros; assumption. -rewrite H12; rewrite <- INR_IZR_INZ; apply le_INR. -apply le_trans with n; [ assumption | apply le_n_Sn ]. -apply le_IZR; left; simpl in |- *; unfold M0_z in |- *; - apply Rlt_trans with M0; [ assumption | elim H10; intros; assumption ]. -intro; apply Rle_trans with (Rabs x * Un n * / INR (S n)). -unfold Un in |- *; replace (M_nat + S n)%nat with (M_nat + n + 1)%nat. -rewrite pow_add; replace (Rabs x ^ 1) with (Rabs x); - [ idtac | simpl in |- *; ring ]. -unfold Rdiv in |- *; rewrite <- (Rmult_comm (Rabs x)); - repeat rewrite Rmult_assoc; repeat apply Rmult_le_compat_l. -apply Rabs_pos. -left; apply pow_lt; assumption. -replace (M_nat + n + 1)%nat with (S (M_nat + n)). -rewrite fact_simpl; rewrite mult_comm; rewrite mult_INR; - rewrite Rinv_mult_distr. -apply Rmult_le_compat_l. -left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red in |- *; - intro; assert (H10 := sym_eq H9); elim (fact_neq_0 _ H10). -left; apply Rinv_lt_contravar. -apply Rmult_lt_0_compat; apply lt_INR_0; apply lt_O_Sn. -apply lt_INR; apply lt_n_S. -pattern n at 1 in |- *; replace n with (0 + n)%nat; [ idtac | reflexivity ]. -apply plus_lt_compat_r. -apply lt_le_trans with 1%nat; [ apply lt_O_Sn | assumption ]. -apply INR_fact_neq_0. -apply not_O_INR; discriminate. -apply INR_eq; rewrite S_INR; do 3 rewrite plus_INR; reflexivity. -apply INR_eq; do 3 rewrite plus_INR; do 2 rewrite S_INR; ring. -unfold Vn in |- *; rewrite Rmult_assoc; unfold Rdiv in |- *; - rewrite (Rmult_comm (Un 0%nat)); rewrite (Rmult_comm (Un n)). -repeat apply Rmult_le_compat_l. -apply Rabs_pos. -left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn. -apply decreasing_prop; [ assumption | apply le_O_n ]. -unfold Un_decreasing in |- *; intro; unfold Un in |- *. -replace (M_nat + S n)%nat with (M_nat + n + 1)%nat. -rewrite pow_add; unfold Rdiv in |- *; rewrite Rmult_assoc; - apply Rmult_le_compat_l. -left; apply pow_lt; assumption. -replace (Rabs x ^ 1) with (Rabs x); [ idtac | simpl in |- *; ring ]. -replace (M_nat + n + 1)%nat with (S (M_nat + n)). -apply Rmult_le_reg_l with (INR (fact (S (M_nat + n)))). -apply lt_INR_0; apply neq_O_lt; red in |- *; intro; assert (H9 := sym_eq H8); - elim (fact_neq_0 _ H9). -rewrite (Rmult_comm (Rabs x)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. -rewrite Rmult_1_l. -rewrite fact_simpl; rewrite mult_INR; rewrite Rmult_assoc; - rewrite <- Rinv_r_sym. -rewrite Rmult_1_r; apply Rle_trans with (INR M_nat). -left; rewrite INR_IZR_INZ. -rewrite <- H4; assert (H8 := archimed (Rabs x)); elim H8; intros; assumption. -apply le_INR; apply le_trans with (S M_nat); - [ apply le_n_Sn | apply le_n_S; apply le_plus_l ]. -apply INR_fact_neq_0. -apply INR_fact_neq_0. -apply INR_eq; rewrite S_INR; do 3 rewrite plus_INR; reflexivity. -apply INR_eq; do 3 rewrite plus_INR; do 2 rewrite S_INR; ring. -intro; unfold Un in |- *; unfold Rdiv in |- *; apply Rmult_lt_0_compat. -apply pow_lt; assumption. -apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red in |- *; intro; - assert (H8 := sym_eq H7); elim (fact_neq_0 _ H8). -clear Un Vn; apply INR_le; simpl in |- *. -induction M_nat as [| M_nat HrecM_nat]. -assert (H6 := archimed (Rabs x)); fold M in H6; elim H6; intros. -rewrite H4 in H7; rewrite <- INR_IZR_INZ in H7. -simpl in H7; elim (Rlt_irrefl _ (Rlt_trans _ _ _ H2 H7)). -replace 1 with (INR 1); [ apply le_INR | reflexivity ]; apply le_n_S; - apply le_O_n. -apply le_IZR; simpl in |- *; left; apply Rlt_trans with (Rabs x). -assumption. -elim (archimed (Rabs x)); intros; assumption. -unfold Un_cv in |- *; unfold R_dist in |- *; intros; elim (H eps H0); intros. -exists x0; intros; - apply Rle_lt_trans with (Rabs (Rabs x ^ n / INR (fact n) - 0)). -unfold Rminus in |- *; rewrite Ropp_0; do 2 rewrite Rplus_0_r; - rewrite (Rabs_right (Rabs x ^ n / INR (fact n))). -unfold Rdiv in |- *; rewrite Rabs_mult; rewrite (Rabs_right (/ INR (fact n))). -rewrite RPow_abs; right; reflexivity. -apply Rle_ge; left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; - red in |- *; intro; assert (H4 := sym_eq H3); elim (fact_neq_0 _ H4). -apply Rle_ge; unfold Rdiv in |- *; apply Rmult_le_pos. -case (Req_dec x 0); intro. -rewrite H3; rewrite Rabs_R0. -induction n as [| n Hrecn]; - [ simpl in |- *; left; apply Rlt_0_1 - | simpl in |- *; rewrite Rmult_0_l; right; reflexivity ]. -left; apply pow_lt; apply Rabs_pos_lt; assumption. -left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red in |- *; - intro; assert (H4 := sym_eq H3); elim (fact_neq_0 _ H4). -apply H1; assumption. + forall x:R, Un_cv (fun n:nat => x ^ n / INR (fact n)) 0. +Proof. + intro; + cut + (Un_cv (fun n:nat => Rabs x ^ n / INR (fact n)) 0 -> + Un_cv (fun n:nat => x ^ n / INR (fact n)) 0). + intro; apply H. + unfold Un_cv in |- *; unfold R_dist in |- *; intros; case (Req_dec x 0); + intro. + exists 1%nat; intros. + rewrite H1; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; + rewrite Rabs_R0; rewrite pow_ne_zero; + [ unfold Rdiv in |- *; rewrite Rmult_0_l; rewrite Rabs_R0; assumption + | red in |- *; intro; rewrite H3 in H2; elim (le_Sn_n _ H2) ]. + assert (H2 := Rabs_pos_lt x H1); set (M := up (Rabs x)); cut (0 <= M)%Z. + intro; elim (IZN M H3); intros M_nat H4. + set (Un := fun n:nat => Rabs x ^ (M_nat + n) / INR (fact (M_nat + n))). + cut (Un_cv Un 0); unfold Un_cv in |- *; unfold R_dist in |- *; intros. + elim (H5 eps H0); intros N H6. + exists (M_nat + N)%nat; intros; + cut (exists p : nat, (p >= N)%nat /\ n = (M_nat + p)%nat). + intro; elim H8; intros p H9. + elim H9; intros; rewrite H11; unfold Un in H6; apply H6; assumption. + exists (n - M_nat)%nat. + split. + unfold ge in |- *; apply (fun p n m:nat => plus_le_reg_l n m p) with M_nat; + rewrite <- le_plus_minus. + assumption. + apply le_trans with (M_nat + N)%nat. + apply le_plus_l. + assumption. + apply le_plus_minus; apply le_trans with (M_nat + N)%nat; + [ apply le_plus_l | assumption ]. + set (Vn := fun n:nat => Rabs x * (Un 0%nat / INR (S n))). + cut (1 <= M_nat)%nat. + intro; cut (forall n:nat, 0 < Un n). + intro; cut (Un_decreasing Un). + intro; cut (forall n:nat, Un (S n) <= Vn n). + intro; cut (Un_cv Vn 0). + unfold Un_cv in |- *; unfold R_dist in |- *; intros. + elim (H10 eps0 H5); intros N1 H11. + exists (S N1); intros. + cut (forall n:nat, 0 < Vn n). + intro; apply Rle_lt_trans with (Rabs (Vn (pred n) - 0)). + repeat rewrite Rabs_right. + unfold Rminus in |- *; rewrite Ropp_0; do 2 rewrite Rplus_0_r; + replace n with (S (pred n)). + apply H9. + inversion H12; simpl in |- *; reflexivity. + apply Rle_ge; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; left; + apply H13. + apply Rle_ge; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; left; + apply H7. + apply H11; unfold ge in |- *; apply le_S_n; replace (S (pred n)) with n; + [ unfold ge in H12; exact H12 | inversion H12; simpl in |- *; reflexivity ]. + intro; apply Rlt_le_trans with (Un (S n0)); [ apply H7 | apply H9 ]. + cut (cv_infty (fun n:nat => INR (S n))). + intro; cut (Un_cv (fun n:nat => / INR (S n)) 0). + unfold Un_cv, R_dist in |- *; intros; unfold Vn in |- *. + cut (0 < eps1 / (Rabs x * Un 0%nat)). + intro; elim (H11 _ H13); intros N H14. + exists N; intros; + replace (Rabs x * (Un 0%nat / INR (S n)) - 0) with + (Rabs x * Un 0%nat * (/ INR (S n) - 0)); + [ idtac | unfold Rdiv in |- *; ring ]. + rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs (Rabs x * Un 0%nat)). + apply Rinv_0_lt_compat; apply Rabs_pos_lt. + apply prod_neq_R0. + apply Rabs_no_R0; assumption. + assert (H16 := H7 0%nat); red in |- *; intro; rewrite H17 in H16; + elim (Rlt_irrefl _ H16). + rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_l. + replace (/ Rabs (Rabs x * Un 0%nat) * eps1) with (eps1 / (Rabs x * Un 0%nat)). + apply H14; assumption. + unfold Rdiv in |- *; rewrite (Rabs_right (Rabs x * Un 0%nat)). + apply Rmult_comm. + apply Rle_ge; apply Rmult_le_pos. + apply Rabs_pos. + left; apply H7. + apply Rabs_no_R0. + apply prod_neq_R0; + [ apply Rabs_no_R0; assumption + | assert (H16 := H7 0%nat); red in |- *; intro; rewrite H17 in H16; + elim (Rlt_irrefl _ H16) ]. + unfold Rdiv in |- *; apply Rmult_lt_0_compat. + assumption. + apply Rinv_0_lt_compat; apply Rmult_lt_0_compat. + apply Rabs_pos_lt; assumption. + apply H7. + apply (cv_infty_cv_R0 (fun n:nat => INR (S n))). + intro; apply not_O_INR; discriminate. + assumption. + unfold cv_infty in |- *; intro; case (total_order_T M0 0); intro. + elim s; intro. + exists 0%nat; intros. + apply Rlt_trans with 0; [ assumption | apply lt_INR_0; apply lt_O_Sn ]. + exists 0%nat; intros; rewrite b; apply lt_INR_0; apply lt_O_Sn. + set (M0_z := up M0). + assert (H10 := archimed M0). + cut (0 <= M0_z)%Z. + intro; elim (IZN _ H11); intros M0_nat H12. + exists M0_nat; intros. + apply Rlt_le_trans with (IZR M0_z). + elim H10; intros; assumption. + rewrite H12; rewrite <- INR_IZR_INZ; apply le_INR. + apply le_trans with n; [ assumption | apply le_n_Sn ]. + apply le_IZR; left; simpl in |- *; unfold M0_z in |- *; + apply Rlt_trans with M0; [ assumption | elim H10; intros; assumption ]. + intro; apply Rle_trans with (Rabs x * Un n * / INR (S n)). + unfold Un in |- *; replace (M_nat + S n)%nat with (M_nat + n + 1)%nat. + rewrite pow_add; replace (Rabs x ^ 1) with (Rabs x); + [ idtac | simpl in |- *; ring ]. + unfold Rdiv in |- *; rewrite <- (Rmult_comm (Rabs x)); + repeat rewrite Rmult_assoc; repeat apply Rmult_le_compat_l. + apply Rabs_pos. + left; apply pow_lt; assumption. + replace (M_nat + n + 1)%nat with (S (M_nat + n)). + rewrite fact_simpl; rewrite mult_comm; rewrite mult_INR; + rewrite Rinv_mult_distr. + apply Rmult_le_compat_l. + left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red in |- *; + intro; assert (H10 := sym_eq H9); elim (fact_neq_0 _ H10). + left; apply Rinv_lt_contravar. + apply Rmult_lt_0_compat; apply lt_INR_0; apply lt_O_Sn. + apply lt_INR; apply lt_n_S. + pattern n at 1 in |- *; replace n with (0 + n)%nat; [ idtac | reflexivity ]. + apply plus_lt_compat_r. + apply lt_le_trans with 1%nat; [ apply lt_O_Sn | assumption ]. + apply INR_fact_neq_0. + apply not_O_INR; discriminate. + ring_nat. + ring_nat. + unfold Vn in |- *; rewrite Rmult_assoc; unfold Rdiv in |- *; + rewrite (Rmult_comm (Un 0%nat)); rewrite (Rmult_comm (Un n)). + repeat apply Rmult_le_compat_l. + apply Rabs_pos. + left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn. + apply decreasing_prop; [ assumption | apply le_O_n ]. + unfold Un_decreasing in |- *; intro; unfold Un in |- *. + replace (M_nat + S n)%nat with (M_nat + n + 1)%nat. + rewrite pow_add; unfold Rdiv in |- *; rewrite Rmult_assoc; + apply Rmult_le_compat_l. + left; apply pow_lt; assumption. + replace (Rabs x ^ 1) with (Rabs x); [ idtac | simpl in |- *; ring ]. + replace (M_nat + n + 1)%nat with (S (M_nat + n)). + apply Rmult_le_reg_l with (INR (fact (S (M_nat + n)))). + apply lt_INR_0; apply neq_O_lt; red in |- *; intro; assert (H9 := sym_eq H8); + elim (fact_neq_0 _ H9). + rewrite (Rmult_comm (Rabs x)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. + rewrite Rmult_1_l. + rewrite fact_simpl; rewrite mult_INR; rewrite Rmult_assoc; + rewrite <- Rinv_r_sym. + rewrite Rmult_1_r; apply Rle_trans with (INR M_nat). + left; rewrite INR_IZR_INZ. + rewrite <- H4; assert (H8 := archimed (Rabs x)); elim H8; intros; assumption. + apply le_INR; omega. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + ring_nat. + ring_nat. + intro; unfold Un in |- *; unfold Rdiv in |- *; apply Rmult_lt_0_compat. + apply pow_lt; assumption. + apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red in |- *; intro; + assert (H8 := sym_eq H7); elim (fact_neq_0 _ H8). + clear Un Vn; apply INR_le; simpl in |- *. + induction M_nat as [| M_nat HrecM_nat]. + assert (H6 := archimed (Rabs x)); fold M in H6; elim H6; intros. + rewrite H4 in H7; rewrite <- INR_IZR_INZ in H7. + simpl in H7; elim (Rlt_irrefl _ (Rlt_trans _ _ _ H2 H7)). + replace 1 with (INR 1); [ apply le_INR | reflexivity ]; apply le_n_S; + apply le_O_n. + apply le_IZR; simpl in |- *; left; apply Rlt_trans with (Rabs x). + assumption. + elim (archimed (Rabs x)); intros; assumption. + unfold Un_cv in |- *; unfold R_dist in |- *; intros; elim (H eps H0); intros. + exists x0; intros; + apply Rle_lt_trans with (Rabs (Rabs x ^ n / INR (fact n) - 0)). + unfold Rminus in |- *; rewrite Ropp_0; do 2 rewrite Rplus_0_r; + rewrite (Rabs_right (Rabs x ^ n / INR (fact n))). + unfold Rdiv in |- *; rewrite Rabs_mult; rewrite (Rabs_right (/ INR (fact n))). + rewrite RPow_abs; right; reflexivity. + apply Rle_ge; left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; + red in |- *; intro; assert (H4 := sym_eq H3); elim (fact_neq_0 _ H4). + apply Rle_ge; unfold Rdiv in |- *; apply Rmult_le_pos. + case (Req_dec x 0); intro. + rewrite H3; rewrite Rabs_R0. + induction n as [| n Hrecn]; + [ simpl in |- *; left; apply Rlt_0_1 + | simpl in |- *; rewrite Rmult_0_l; right; reflexivity ]. + left; apply pow_lt; apply Rabs_pos_lt; assumption. + left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red in |- *; + intro; assert (H4 := sym_eq H3); elim (fact_neq_0 _ H4). + apply H1; assumption. Qed. diff --git a/theories/Reals/SeqSeries.v b/theories/Reals/SeqSeries.v index 6cab2486..bc17cd43 100644 --- a/theories/Reals/SeqSeries.v +++ b/theories/Reals/SeqSeries.v @@ -5,8 +5,8 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) - -(*i $Id: SeqSeries.v 8670 2006-03-28 22:16:14Z herbelin $ i*) + +(*i $Id: SeqSeries.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -25,393 +25,395 @@ Open Local Scope R_scope. (**********) Lemma sum_maj1 : - forall (fn:nat -> R -> R) (An:nat -> R) (x l1 l2:R) - (N:nat), - Un_cv (fun n:nat => SP fn n x) l1 -> - Un_cv (fun n:nat => sum_f_R0 An n) l2 -> - (forall n:nat, Rabs (fn n x) <= An n) -> - Rabs (l1 - SP fn N x) <= l2 - sum_f_R0 An N. -intros; - cut - (sigT - (fun l:R => - Un_cv (fun n:nat => sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n) l)). -intro X; - cut - (sigT - (fun l:R => - Un_cv (fun n:nat => sum_f_R0 (fun l:nat => An (S N + l)%nat) n) l)). -intro X0; elim X; intros l1N H2. -elim X0; intros l2N H3. -cut (l1 - SP fn N x = l1N). -intro; cut (l2 - sum_f_R0 An N = l2N). -intro; rewrite H4; rewrite H5. -apply sum_cv_maj with - (fun l:nat => An (S N + l)%nat) (fun (l:nat) (x:R) => fn (S N + l)%nat x) x. -unfold SP in |- *; apply H2. -apply H3. -intros; apply H1. -symmetry in |- *; eapply UL_sequence. -apply H3. -unfold Un_cv in H0; unfold Un_cv in |- *; intros; elim (H0 eps H5); - intros N0 H6. -unfold R_dist in H6; exists N0; intros. -unfold R_dist in |- *; - replace (sum_f_R0 (fun l:nat => An (S N + l)%nat) n - (l2 - sum_f_R0 An N)) - with (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n - l2); - [ idtac | ring ]. -replace (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n) with - (sum_f_R0 An (S (N + n))). -apply H6; unfold ge in |- *; apply le_trans with n. -apply H7. -apply le_trans with (N + n)%nat. -apply le_plus_r. -apply le_n_Sn. -cut (0 <= N)%nat. -cut (N < S (N + n))%nat. -intros; assert (H10 := sigma_split An H9 H8). -unfold sigma in H10. -do 2 rewrite <- minus_n_O in H10. -replace (sum_f_R0 An (S (N + n))) with - (sum_f_R0 (fun k:nat => An (0 + k)%nat) (S (N + n))). -replace (sum_f_R0 An N) with (sum_f_R0 (fun k:nat => An (0 + k)%nat) N). -cut ((S (N + n) - S N)%nat = n). -intro; rewrite H11 in H10. -apply H10. -apply INR_eq; rewrite minus_INR. -do 2 rewrite S_INR; rewrite plus_INR; ring. -apply le_n_S; apply le_plus_l. -apply sum_eq; intros. -reflexivity. -apply sum_eq; intros. -reflexivity. -apply le_lt_n_Sm; apply le_plus_l. -apply le_O_n. -symmetry in |- *; eapply UL_sequence. -apply H2. -unfold Un_cv in H; unfold Un_cv in |- *; intros. -elim (H eps H4); intros N0 H5. -unfold R_dist in H5; exists N0; intros. -unfold R_dist, SP in |- *; - replace + forall (fn:nat -> R -> R) (An:nat -> R) (x l1 l2:R) + (N:nat), + Un_cv (fun n:nat => SP fn n x) l1 -> + Un_cv (fun n:nat => sum_f_R0 An n) l2 -> + (forall n:nat, Rabs (fn n x) <= An n) -> + Rabs (l1 - SP fn N x) <= l2 - sum_f_R0 An N. +Proof. + intros; + cut + (sigT + (fun l:R => + Un_cv (fun n:nat => sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n) l)). + intro X; + cut + (sigT + (fun l:R => + Un_cv (fun n:nat => sum_f_R0 (fun l:nat => An (S N + l)%nat) n) l)). + intro X0; elim X; intros l1N H2. + elim X0; intros l2N H3. + cut (l1 - SP fn N x = l1N). + intro; cut (l2 - sum_f_R0 An N = l2N). + intro; rewrite H4; rewrite H5. + apply sum_cv_maj with + (fun l:nat => An (S N + l)%nat) (fun (l:nat) (x:R) => fn (S N + l)%nat x) x. + unfold SP in |- *; apply H2. + apply H3. + intros; apply H1. + symmetry in |- *; eapply UL_sequence. + apply H3. + unfold Un_cv in H0; unfold Un_cv in |- *; intros; elim (H0 eps H5); + intros N0 H6. + unfold R_dist in H6; exists N0; intros. + unfold R_dist in |- *; + replace (sum_f_R0 (fun l:nat => An (S N + l)%nat) n - (l2 - sum_f_R0 An N)) + with (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n - l2); + [ idtac | ring ]. + replace (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n) with + (sum_f_R0 An (S (N + n))). + apply H6; unfold ge in |- *; apply le_trans with n. + apply H7. + apply le_trans with (N + n)%nat. + apply le_plus_r. + apply le_n_Sn. + cut (0 <= N)%nat. + cut (N < S (N + n))%nat. + intros; assert (H10 := sigma_split An H9 H8). + unfold sigma in H10. + do 2 rewrite <- minus_n_O in H10. + replace (sum_f_R0 An (S (N + n))) with + (sum_f_R0 (fun k:nat => An (0 + k)%nat) (S (N + n))). + replace (sum_f_R0 An N) with (sum_f_R0 (fun k:nat => An (0 + k)%nat) N). + cut ((S (N + n) - S N)%nat = n). + intro; rewrite H11 in H10. + apply H10. + apply INR_eq; rewrite minus_INR. + do 2 rewrite S_INR; rewrite plus_INR; ring. + apply le_n_S; apply le_plus_l. + apply sum_eq; intros. + reflexivity. + apply sum_eq; intros. + reflexivity. + apply le_lt_n_Sm; apply le_plus_l. + apply le_O_n. + symmetry in |- *; eapply UL_sequence. + apply H2. + unfold Un_cv in H; unfold Un_cv in |- *; intros. + elim (H eps H4); intros N0 H5. + unfold R_dist in H5; exists N0; intros. + unfold R_dist, SP in |- *; + replace + (sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - + (l1 - sum_f_R0 (fun k:nat => fn k x) N)) with + (sum_f_R0 (fun k:nat => fn k x) N + + sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - l1); + [ idtac | ring ]. + replace + (sum_f_R0 (fun k:nat => fn k x) N + + sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n) with + (sum_f_R0 (fun k:nat => fn k x) (S (N + n))). + unfold SP in H5; apply H5; unfold ge in |- *; apply le_trans with n. + apply H6. + apply le_trans with (N + n)%nat. + apply le_plus_r. + apply le_n_Sn. + cut (0 <= N)%nat. + cut (N < S (N + n))%nat. + intros; assert (H9 := sigma_split (fun k:nat => fn k x) H8 H7). + unfold sigma in H9. + do 2 rewrite <- minus_n_O in H9. + replace (sum_f_R0 (fun k:nat => fn k x) (S (N + n))) with + (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) (S (N + n))). + replace (sum_f_R0 (fun k:nat => fn k x) N) with + (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) N). + cut ((S (N + n) - S N)%nat = n). + intro; rewrite H10 in H9. + apply H9. + apply INR_eq; rewrite minus_INR. + do 2 rewrite S_INR; rewrite plus_INR; ring. + apply le_n_S; apply le_plus_l. + apply sum_eq; intros. + reflexivity. + apply sum_eq; intros. + reflexivity. + apply le_lt_n_Sm. + apply le_plus_l. + apply le_O_n. + apply existT with (l2 - sum_f_R0 An N). + unfold Un_cv in H0; unfold Un_cv in |- *; intros. + elim (H0 eps H2); intros N0 H3. + unfold R_dist in H3; exists N0; intros. + unfold R_dist in |- *; + replace (sum_f_R0 (fun l:nat => An (S N + l)%nat) n - (l2 - sum_f_R0 An N)) + with (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n - l2); + [ idtac | ring ]. + replace (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n) with + (sum_f_R0 An (S (N + n))). + apply H3; unfold ge in |- *; apply le_trans with n. + apply H4. + apply le_trans with (N + n)%nat. + apply le_plus_r. + apply le_n_Sn. + cut (0 <= N)%nat. + cut (N < S (N + n))%nat. + intros; assert (H7 := sigma_split An H6 H5). + unfold sigma in H7. + do 2 rewrite <- minus_n_O in H7. + replace (sum_f_R0 An (S (N + n))) with + (sum_f_R0 (fun k:nat => An (0 + k)%nat) (S (N + n))). + replace (sum_f_R0 An N) with (sum_f_R0 (fun k:nat => An (0 + k)%nat) N). + cut ((S (N + n) - S N)%nat = n). + intro; rewrite H8 in H7. + apply H7. + apply INR_eq; rewrite minus_INR. + do 2 rewrite S_INR; rewrite plus_INR; ring. + apply le_n_S; apply le_plus_l. + apply sum_eq; intros. + reflexivity. + apply sum_eq; intros. + reflexivity. + apply le_lt_n_Sm. + apply le_plus_l. + apply le_O_n. + apply existT with (l1 - SP fn N x). + unfold Un_cv in H; unfold Un_cv in |- *; intros. + elim (H eps H2); intros N0 H3. + unfold R_dist in H3; exists N0; intros. + unfold R_dist, SP in |- *. + replace (sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - - (l1 - sum_f_R0 (fun k:nat => fn k x) N)) with + (l1 - sum_f_R0 (fun k:nat => fn k x) N)) with + (sum_f_R0 (fun k:nat => fn k x) N + + sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - l1); + [ idtac | ring ]. + replace (sum_f_R0 (fun k:nat => fn k x) N + - sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - l1); - [ idtac | ring ]. -replace - (sum_f_R0 (fun k:nat => fn k x) N + - sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n) with - (sum_f_R0 (fun k:nat => fn k x) (S (N + n))). -unfold SP in H5; apply H5; unfold ge in |- *; apply le_trans with n. -apply H6. -apply le_trans with (N + n)%nat. -apply le_plus_r. -apply le_n_Sn. -cut (0 <= N)%nat. -cut (N < S (N + n))%nat. -intros; assert (H9 := sigma_split (fun k:nat => fn k x) H8 H7). -unfold sigma in H9. -do 2 rewrite <- minus_n_O in H9. -replace (sum_f_R0 (fun k:nat => fn k x) (S (N + n))) with - (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) (S (N + n))). -replace (sum_f_R0 (fun k:nat => fn k x) N) with - (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) N). -cut ((S (N + n) - S N)%nat = n). -intro; rewrite H10 in H9. -apply H9. -apply INR_eq; rewrite minus_INR. -do 2 rewrite S_INR; rewrite plus_INR; ring. -apply le_n_S; apply le_plus_l. -apply sum_eq; intros. -reflexivity. -apply sum_eq; intros. -reflexivity. -apply le_lt_n_Sm. -apply le_plus_l. -apply le_O_n. -apply existT with (l2 - sum_f_R0 An N). -unfold Un_cv in H0; unfold Un_cv in |- *; intros. -elim (H0 eps H2); intros N0 H3. -unfold R_dist in H3; exists N0; intros. -unfold R_dist in |- *; - replace (sum_f_R0 (fun l:nat => An (S N + l)%nat) n - (l2 - sum_f_R0 An N)) - with (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n - l2); - [ idtac | ring ]. -replace (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n) with - (sum_f_R0 An (S (N + n))). -apply H3; unfold ge in |- *; apply le_trans with n. -apply H4. -apply le_trans with (N + n)%nat. -apply le_plus_r. -apply le_n_Sn. -cut (0 <= N)%nat. -cut (N < S (N + n))%nat. -intros; assert (H7 := sigma_split An H6 H5). -unfold sigma in H7. -do 2 rewrite <- minus_n_O in H7. -replace (sum_f_R0 An (S (N + n))) with - (sum_f_R0 (fun k:nat => An (0 + k)%nat) (S (N + n))). -replace (sum_f_R0 An N) with (sum_f_R0 (fun k:nat => An (0 + k)%nat) N). -cut ((S (N + n) - S N)%nat = n). -intro; rewrite H8 in H7. -apply H7. -apply INR_eq; rewrite minus_INR. -do 2 rewrite S_INR; rewrite plus_INR; ring. -apply le_n_S; apply le_plus_l. -apply sum_eq; intros. -reflexivity. -apply sum_eq; intros. -reflexivity. -apply le_lt_n_Sm. -apply le_plus_l. -apply le_O_n. -apply existT with (l1 - SP fn N x). -unfold Un_cv in H; unfold Un_cv in |- *; intros. -elim (H eps H2); intros N0 H3. -unfold R_dist in H3; exists N0; intros. -unfold R_dist, SP in |- *. -replace - (sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - - (l1 - sum_f_R0 (fun k:nat => fn k x) N)) with - (sum_f_R0 (fun k:nat => fn k x) N + - sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - l1); - [ idtac | ring ]. -replace - (sum_f_R0 (fun k:nat => fn k x) N + - sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n) with - (sum_f_R0 (fun k:nat => fn k x) (S (N + n))). -unfold SP in H3; apply H3. -unfold ge in |- *; apply le_trans with n. -apply H4. -apply le_trans with (N + n)%nat. -apply le_plus_r. -apply le_n_Sn. -cut (0 <= N)%nat. -cut (N < S (N + n))%nat. -intros; assert (H7 := sigma_split (fun k:nat => fn k x) H6 H5). -unfold sigma in H7. -do 2 rewrite <- minus_n_O in H7. -replace (sum_f_R0 (fun k:nat => fn k x) (S (N + n))) with - (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) (S (N + n))). -replace (sum_f_R0 (fun k:nat => fn k x) N) with - (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) N). -cut ((S (N + n) - S N)%nat = n). -intro; rewrite H8 in H7. -apply H7. -apply INR_eq; rewrite minus_INR. -do 2 rewrite S_INR; rewrite plus_INR; ring. -apply le_n_S; apply le_plus_l. -apply sum_eq; intros. -reflexivity. -apply sum_eq; intros. -reflexivity. -apply le_lt_n_Sm. -apply le_plus_l. -apply le_O_n. + sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n) with + (sum_f_R0 (fun k:nat => fn k x) (S (N + n))). + unfold SP in H3; apply H3. + unfold ge in |- *; apply le_trans with n. + apply H4. + apply le_trans with (N + n)%nat. + apply le_plus_r. + apply le_n_Sn. + cut (0 <= N)%nat. + cut (N < S (N + n))%nat. + intros; assert (H7 := sigma_split (fun k:nat => fn k x) H6 H5). + unfold sigma in H7. + do 2 rewrite <- minus_n_O in H7. + replace (sum_f_R0 (fun k:nat => fn k x) (S (N + n))) with + (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) (S (N + n))). + replace (sum_f_R0 (fun k:nat => fn k x) N) with + (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) N). + cut ((S (N + n) - S N)%nat = n). + intro; rewrite H8 in H7. + apply H7. + apply INR_eq; rewrite minus_INR. + do 2 rewrite S_INR; rewrite plus_INR; ring. + apply le_n_S; apply le_plus_l. + apply sum_eq; intros. + reflexivity. + apply sum_eq; intros. + reflexivity. + apply le_lt_n_Sm. + apply le_plus_l. + apply le_O_n. Qed. -(* Comparaison of convergence for series *) +(** Comparaison of convergence for series *) Lemma Rseries_CV_comp : - forall An Bn:nat -> R, - (forall n:nat, 0 <= An n <= Bn n) -> - sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 Bn N) l) -> - sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l). -intros An Bn H X; apply cv_cauchy_2. -assert (H0 := cv_cauchy_1 _ X). -unfold Cauchy_crit_series in |- *; unfold Cauchy_crit in |- *. -intros; elim (H0 eps H1); intros. -exists x; intros. -cut - (R_dist (sum_f_R0 An n) (sum_f_R0 An m) <= - R_dist (sum_f_R0 Bn n) (sum_f_R0 Bn m)). -intro; apply Rle_lt_trans with (R_dist (sum_f_R0 Bn n) (sum_f_R0 Bn m)). -assumption. -apply H2; assumption. -assert (H5 := lt_eq_lt_dec n m). -elim H5; intro. -elim a; intro. -rewrite (tech2 An n m); [ idtac | assumption ]. -rewrite (tech2 Bn n m); [ idtac | assumption ]. -unfold R_dist in |- *; unfold Rminus in |- *; do 2 rewrite Ropp_plus_distr; - do 2 rewrite <- Rplus_assoc; do 2 rewrite Rplus_opp_r; - do 2 rewrite Rplus_0_l; do 2 rewrite Rabs_Ropp; repeat rewrite Rabs_right. -apply sum_Rle; intros. -elim (H (S n + n0)%nat); intros. -apply H8. -apply Rle_ge; apply cond_pos_sum; intro. -elim (H (S n + n0)%nat); intros. -apply Rle_trans with (An (S n + n0)%nat); assumption. -apply Rle_ge; apply cond_pos_sum; intro. -elim (H (S n + n0)%nat); intros; assumption. -rewrite b; unfold R_dist in |- *; unfold Rminus in |- *; - do 2 rewrite Rplus_opp_r; rewrite Rabs_R0; right; - reflexivity. -rewrite (tech2 An m n); [ idtac | assumption ]. -rewrite (tech2 Bn m n); [ idtac | assumption ]. -unfold R_dist in |- *; unfold Rminus in |- *; do 2 rewrite Rplus_assoc; - rewrite (Rplus_comm (sum_f_R0 An m)); rewrite (Rplus_comm (sum_f_R0 Bn m)); - do 2 rewrite Rplus_assoc; do 2 rewrite Rplus_opp_l; - do 2 rewrite Rplus_0_r; repeat rewrite Rabs_right. -apply sum_Rle; intros. -elim (H (S m + n0)%nat); intros; apply H8. -apply Rle_ge; apply cond_pos_sum; intro. -elim (H (S m + n0)%nat); intros. -apply Rle_trans with (An (S m + n0)%nat); assumption. -apply Rle_ge. -apply cond_pos_sum; intro. -elim (H (S m + n0)%nat); intros; assumption. + forall An Bn:nat -> R, + (forall n:nat, 0 <= An n <= Bn n) -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 Bn N) l) -> + sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l). +Proof. + intros An Bn H X; apply cv_cauchy_2. + assert (H0 := cv_cauchy_1 _ X). + unfold Cauchy_crit_series in |- *; unfold Cauchy_crit in |- *. + intros; elim (H0 eps H1); intros. + exists x; intros. + cut + (R_dist (sum_f_R0 An n) (sum_f_R0 An m) <= + R_dist (sum_f_R0 Bn n) (sum_f_R0 Bn m)). + intro; apply Rle_lt_trans with (R_dist (sum_f_R0 Bn n) (sum_f_R0 Bn m)). + assumption. + apply H2; assumption. + assert (H5 := lt_eq_lt_dec n m). + elim H5; intro. + elim a; intro. + rewrite (tech2 An n m); [ idtac | assumption ]. + rewrite (tech2 Bn n m); [ idtac | assumption ]. + unfold R_dist in |- *; unfold Rminus in |- *; do 2 rewrite Ropp_plus_distr; + do 2 rewrite <- Rplus_assoc; do 2 rewrite Rplus_opp_r; + do 2 rewrite Rplus_0_l; do 2 rewrite Rabs_Ropp; repeat rewrite Rabs_right. + apply sum_Rle; intros. + elim (H (S n + n0)%nat); intros. + apply H8. + apply Rle_ge; apply cond_pos_sum; intro. + elim (H (S n + n0)%nat); intros. + apply Rle_trans with (An (S n + n0)%nat); assumption. + apply Rle_ge; apply cond_pos_sum; intro. + elim (H (S n + n0)%nat); intros; assumption. + rewrite b; unfold R_dist in |- *; unfold Rminus in |- *; + do 2 rewrite Rplus_opp_r; rewrite Rabs_R0; right; + reflexivity. + rewrite (tech2 An m n); [ idtac | assumption ]. + rewrite (tech2 Bn m n); [ idtac | assumption ]. + unfold R_dist in |- *; unfold Rminus in |- *; do 2 rewrite Rplus_assoc; + rewrite (Rplus_comm (sum_f_R0 An m)); rewrite (Rplus_comm (sum_f_R0 Bn m)); + do 2 rewrite Rplus_assoc; do 2 rewrite Rplus_opp_l; + do 2 rewrite Rplus_0_r; repeat rewrite Rabs_right. + apply sum_Rle; intros. + elim (H (S m + n0)%nat); intros; apply H8. + apply Rle_ge; apply cond_pos_sum; intro. + elim (H (S m + n0)%nat); intros. + apply Rle_trans with (An (S m + n0)%nat); assumption. + apply Rle_ge. + apply cond_pos_sum; intro. + elim (H (S m + n0)%nat); intros; assumption. Qed. -(* Cesaro's theorem *) +(** Cesaro's theorem *) Lemma Cesaro : - forall (An Bn:nat -> R) (l:R), - Un_cv Bn l -> - (forall n:nat, 0 < An n) -> - cv_infty (fun n:nat => sum_f_R0 An n) -> - Un_cv (fun n:nat => sum_f_R0 (fun k:nat => An k * Bn k) n / sum_f_R0 An n) - l. + forall (An Bn:nat -> R) (l:R), + Un_cv Bn l -> + (forall n:nat, 0 < An n) -> + cv_infty (fun n:nat => sum_f_R0 An n) -> + Un_cv (fun n:nat => sum_f_R0 (fun k:nat => An k * Bn k) n / sum_f_R0 An n) + l. Proof with trivial. -unfold Un_cv in |- *; intros; assert (H3 : forall n:nat, 0 < sum_f_R0 An n)... -intro; apply tech1... -assert (H4 : forall n:nat, sum_f_R0 An n <> 0)... -intro; red in |- *; intro; assert (H5 := H3 n); rewrite H4 in H5; - elim (Rlt_irrefl _ H5)... -assert (H5 := cv_infty_cv_R0 _ H4 H1); assert (H6 : 0 < eps / 2)... -unfold Rdiv in |- *; apply Rmult_lt_0_compat... -apply Rinv_0_lt_compat; prove_sup... -elim (H _ H6); clear H; intros N1 H; - set (C := Rabs (sum_f_R0 (fun k:nat => An k * (Bn k - l)) N1)); - assert - (H7 : - exists N : nat, - (forall n:nat, (N <= n)%nat -> C / sum_f_R0 An n < eps / 2))... -case (Req_dec C 0); intro... -exists 0%nat; intros... -rewrite H7; unfold Rdiv in |- *; rewrite Rmult_0_l; apply Rmult_lt_0_compat... -apply Rinv_0_lt_compat; prove_sup... -assert (H8 : 0 < eps / (2 * Rabs C))... -unfold Rdiv in |- *; apply Rmult_lt_0_compat... -apply Rinv_0_lt_compat; apply Rmult_lt_0_compat... -prove_sup... -apply Rabs_pos_lt... -elim (H5 _ H8); intros; exists x; intros; assert (H11 := H9 _ H10); - unfold R_dist in H11; unfold Rminus in H11; rewrite Ropp_0 in H11; - rewrite Rplus_0_r in H11... -apply Rle_lt_trans with (Rabs (C / sum_f_R0 An n))... -apply RRle_abs... -unfold Rdiv in |- *; rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs C)... -apply Rinv_0_lt_compat; apply Rabs_pos_lt... -rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym... -rewrite Rmult_1_l; replace (/ Rabs C * (eps * / 2)) with (eps / (2 * Rabs C))... -unfold Rdiv in |- *; rewrite Rinv_mult_distr... -ring... -discrR... -apply Rabs_no_R0... -apply Rabs_no_R0... -elim H7; clear H7; intros N2 H7; set (N := max N1 N2); exists (S N); intros; - unfold R_dist in |- *; - replace (sum_f_R0 (fun k:nat => An k * Bn k) n / sum_f_R0 An n - l) with - (sum_f_R0 (fun k:nat => An k * (Bn k - l)) n / sum_f_R0 An n)... -assert (H9 : (N1 < n)%nat)... -apply lt_le_trans with (S N)... -apply le_lt_n_Sm; unfold N in |- *; apply le_max_l... -rewrite (tech2 (fun k:nat => An k * (Bn k - l)) _ _ H9); unfold Rdiv in |- *; - rewrite Rmult_plus_distr_r; - apply Rle_lt_trans with - (Rabs (sum_f_R0 (fun k:nat => An k * (Bn k - l)) N1 / sum_f_R0 An n) + - Rabs - (sum_f_R0 (fun i:nat => An (S N1 + i)%nat * (Bn (S N1 + i)%nat - l)) - (n - S N1) / sum_f_R0 An n))... -apply Rabs_triang... -rewrite (double_var eps); apply Rplus_lt_compat... -unfold Rdiv in |- *; rewrite Rabs_mult; fold C in |- *; rewrite Rabs_right... -apply (H7 n); apply le_trans with (S N)... -apply le_trans with N; [ unfold N in |- *; apply le_max_r | apply le_n_Sn ]... -apply Rle_ge; left; apply Rinv_0_lt_compat... + unfold Un_cv in |- *; intros; assert (H3 : forall n:nat, 0 < sum_f_R0 An n)... + intro; apply tech1... + assert (H4 : forall n:nat, sum_f_R0 An n <> 0)... + intro; red in |- *; intro; assert (H5 := H3 n); rewrite H4 in H5; + elim (Rlt_irrefl _ H5)... + assert (H5 := cv_infty_cv_R0 _ H4 H1); assert (H6 : 0 < eps / 2)... + unfold Rdiv in |- *; apply Rmult_lt_0_compat... + apply Rinv_0_lt_compat; prove_sup... + elim (H _ H6); clear H; intros N1 H; + set (C := Rabs (sum_f_R0 (fun k:nat => An k * (Bn k - l)) N1)); + assert + (H7 : + exists N : nat, + (forall n:nat, (N <= n)%nat -> C / sum_f_R0 An n < eps / 2))... + case (Req_dec C 0); intro... + exists 0%nat; intros... + rewrite H7; unfold Rdiv in |- *; rewrite Rmult_0_l; apply Rmult_lt_0_compat... + apply Rinv_0_lt_compat; prove_sup... + assert (H8 : 0 < eps / (2 * Rabs C))... + unfold Rdiv in |- *; apply Rmult_lt_0_compat... + apply Rinv_0_lt_compat; apply Rmult_lt_0_compat... + prove_sup... + apply Rabs_pos_lt... + elim (H5 _ H8); intros; exists x; intros; assert (H11 := H9 _ H10); + unfold R_dist in H11; unfold Rminus in H11; rewrite Ropp_0 in H11; + rewrite Rplus_0_r in H11... + apply Rle_lt_trans with (Rabs (C / sum_f_R0 An n))... + apply RRle_abs... + unfold Rdiv in |- *; rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs C)... + apply Rinv_0_lt_compat; apply Rabs_pos_lt... + rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym... + rewrite Rmult_1_l; replace (/ Rabs C * (eps * / 2)) with (eps / (2 * Rabs C))... + unfold Rdiv in |- *; rewrite Rinv_mult_distr... + ring... + discrR... + apply Rabs_no_R0... + apply Rabs_no_R0... + elim H7; clear H7; intros N2 H7; set (N := max N1 N2); exists (S N); intros; + unfold R_dist in |- *; + replace (sum_f_R0 (fun k:nat => An k * Bn k) n / sum_f_R0 An n - l) with + (sum_f_R0 (fun k:nat => An k * (Bn k - l)) n / sum_f_R0 An n)... + assert (H9 : (N1 < n)%nat)... + apply lt_le_trans with (S N)... + apply le_lt_n_Sm; unfold N in |- *; apply le_max_l... + rewrite (tech2 (fun k:nat => An k * (Bn k - l)) _ _ H9); unfold Rdiv in |- *; + rewrite Rmult_plus_distr_r; + apply Rle_lt_trans with + (Rabs (sum_f_R0 (fun k:nat => An k * (Bn k - l)) N1 / sum_f_R0 An n) + + Rabs + (sum_f_R0 (fun i:nat => An (S N1 + i)%nat * (Bn (S N1 + i)%nat - l)) + (n - S N1) / sum_f_R0 An n))... + apply Rabs_triang... + rewrite (double_var eps); apply Rplus_lt_compat... + unfold Rdiv in |- *; rewrite Rabs_mult; fold C in |- *; rewrite Rabs_right... + apply (H7 n); apply le_trans with (S N)... + apply le_trans with N; [ unfold N in |- *; apply le_max_r | apply le_n_Sn ]... + apply Rle_ge; left; apply Rinv_0_lt_compat... -unfold R_dist in H; unfold Rdiv in |- *; rewrite Rabs_mult; - rewrite (Rabs_right (/ sum_f_R0 An n))... -apply Rle_lt_trans with - (sum_f_R0 (fun i:nat => Rabs (An (S N1 + i)%nat * (Bn (S N1 + i)%nat - l))) - (n - S N1) * / sum_f_R0 An n)... -do 2 rewrite <- (Rmult_comm (/ sum_f_R0 An n)); apply Rmult_le_compat_l... -left; apply Rinv_0_lt_compat... -apply - (Rsum_abs (fun i:nat => An (S N1 + i)%nat * (Bn (S N1 + i)%nat - l)) - (n - S N1))... -apply Rle_lt_trans with - (sum_f_R0 (fun i:nat => An (S N1 + i)%nat * (eps / 2)) (n - S N1) * - / sum_f_R0 An n)... -do 2 rewrite <- (Rmult_comm (/ sum_f_R0 An n)); apply Rmult_le_compat_l... -left; apply Rinv_0_lt_compat... -apply sum_Rle; intros; rewrite Rabs_mult; - pattern (An (S N1 + n0)%nat) at 2 in |- *; - rewrite <- (Rabs_right (An (S N1 + n0)%nat))... -apply Rmult_le_compat_l... -apply Rabs_pos... -left; apply H; unfold ge in |- *; apply le_trans with (S N1); - [ apply le_n_Sn | apply le_plus_l ]... -apply Rle_ge; left... -rewrite <- (scal_sum (fun i:nat => An (S N1 + i)%nat) (n - S N1) (eps / 2)); - unfold Rdiv in |- *; repeat rewrite Rmult_assoc; apply Rmult_lt_compat_l... -pattern (/ 2) at 2 in |- *; rewrite <- Rmult_1_r; apply Rmult_lt_compat_l... -apply Rinv_0_lt_compat; prove_sup... -rewrite Rmult_comm; apply Rmult_lt_reg_l with (sum_f_R0 An n)... -rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym... -rewrite Rmult_1_l; rewrite Rmult_1_r; rewrite (tech2 An N1 n)... -rewrite Rplus_comm; - pattern (sum_f_R0 (fun i:nat => An (S N1 + i)%nat) (n - S N1)) at 1 in |- *; - rewrite <- Rplus_0_r; apply Rplus_lt_compat_l... -apply Rle_ge; left; apply Rinv_0_lt_compat... -replace (sum_f_R0 (fun k:nat => An k * (Bn k - l)) n) with - (sum_f_R0 (fun k:nat => An k * Bn k) n + - sum_f_R0 (fun k:nat => An k * - l) n)... -rewrite <- (scal_sum An n (- l)); field... -rewrite <- plus_sum; apply sum_eq; intros; ring... + unfold R_dist in H; unfold Rdiv in |- *; rewrite Rabs_mult; + rewrite (Rabs_right (/ sum_f_R0 An n))... + apply Rle_lt_trans with + (sum_f_R0 (fun i:nat => Rabs (An (S N1 + i)%nat * (Bn (S N1 + i)%nat - l))) + (n - S N1) * / sum_f_R0 An n)... + do 2 rewrite <- (Rmult_comm (/ sum_f_R0 An n)); apply Rmult_le_compat_l... + left; apply Rinv_0_lt_compat... + apply + (Rsum_abs (fun i:nat => An (S N1 + i)%nat * (Bn (S N1 + i)%nat - l)) + (n - S N1))... + apply Rle_lt_trans with + (sum_f_R0 (fun i:nat => An (S N1 + i)%nat * (eps / 2)) (n - S N1) * + / sum_f_R0 An n)... + do 2 rewrite <- (Rmult_comm (/ sum_f_R0 An n)); apply Rmult_le_compat_l... + left; apply Rinv_0_lt_compat... + apply sum_Rle; intros; rewrite Rabs_mult; + pattern (An (S N1 + n0)%nat) at 2 in |- *; + rewrite <- (Rabs_right (An (S N1 + n0)%nat))... + apply Rmult_le_compat_l... + apply Rabs_pos... + left; apply H; unfold ge in |- *; apply le_trans with (S N1); + [ apply le_n_Sn | apply le_plus_l ]... + apply Rle_ge; left... + rewrite <- (scal_sum (fun i:nat => An (S N1 + i)%nat) (n - S N1) (eps / 2)); + unfold Rdiv in |- *; repeat rewrite Rmult_assoc; apply Rmult_lt_compat_l... + pattern (/ 2) at 2 in |- *; rewrite <- Rmult_1_r; apply Rmult_lt_compat_l... + apply Rinv_0_lt_compat; prove_sup... + rewrite Rmult_comm; apply Rmult_lt_reg_l with (sum_f_R0 An n)... + rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym... + rewrite Rmult_1_l; rewrite Rmult_1_r; rewrite (tech2 An N1 n)... + rewrite Rplus_comm; + pattern (sum_f_R0 (fun i:nat => An (S N1 + i)%nat) (n - S N1)) at 1 in |- *; + rewrite <- Rplus_0_r; apply Rplus_lt_compat_l... + apply Rle_ge; left; apply Rinv_0_lt_compat... + replace (sum_f_R0 (fun k:nat => An k * (Bn k - l)) n) with + (sum_f_R0 (fun k:nat => An k * Bn k) n + + sum_f_R0 (fun k:nat => An k * - l) n)... + rewrite <- (scal_sum An n (- l)); field... + rewrite <- plus_sum; apply sum_eq; intros; ring... Qed. Lemma Cesaro_1 : - forall (An:nat -> R) (l:R), - Un_cv An l -> Un_cv (fun n:nat => sum_f_R0 An (pred n) / INR n) l. + forall (An:nat -> R) (l:R), + Un_cv An l -> Un_cv (fun n:nat => sum_f_R0 An (pred n) / INR n) l. Proof with trivial. -intros Bn l H; set (An := fun _:nat => 1)... -assert (H0 : forall n:nat, 0 < An n)... -intro; unfold An in |- *; apply Rlt_0_1... -assert (H1 : forall n:nat, 0 < sum_f_R0 An n)... -intro; apply tech1... -assert (H2 : cv_infty (fun n:nat => sum_f_R0 An n))... -unfold cv_infty in |- *; intro; case (Rle_dec M 0); intro... -exists 0%nat; intros; apply Rle_lt_trans with 0... -assert (H2 : 0 < M)... -auto with real... -clear n; set (m := up M); elim (archimed M); intros; - assert (H5 : (0 <= m)%Z)... -apply le_IZR; unfold m in |- *; simpl in |- *; left; apply Rlt_trans with M... -elim (IZN _ H5); intros; exists x; intros; unfold An in |- *; rewrite sum_cte; - rewrite Rmult_1_l; apply Rlt_trans with (IZR (up M))... -apply Rle_lt_trans with (INR x)... -rewrite INR_IZR_INZ; fold m in |- *; rewrite <- H6; right... -apply lt_INR; apply le_lt_n_Sm... -assert (H3 := Cesaro _ _ _ H H0 H2)... -unfold Un_cv in |- *; unfold Un_cv in H3; intros; elim (H3 _ H4); intros; - exists (S x); intros; unfold R_dist in |- *; unfold R_dist in H5; - apply Rle_lt_trans with - (Rabs - (sum_f_R0 (fun k:nat => An k * Bn k) (pred n) / sum_f_R0 An (pred n) - l))... -right; - replace (sum_f_R0 Bn (pred n) / INR n - l) with - (sum_f_R0 (fun k:nat => An k * Bn k) (pred n) / sum_f_R0 An (pred n) - l)... -unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- l)); - apply Rplus_eq_compat_l... -unfold An in |- *; - replace (sum_f_R0 (fun k:nat => 1 * Bn k) (pred n)) with - (sum_f_R0 Bn (pred n))... -rewrite sum_cte; rewrite Rmult_1_l; replace (S (pred n)) with n... -apply S_pred with 0%nat; apply lt_le_trans with (S x)... -apply lt_O_Sn... -apply sum_eq; intros; ring... -apply H5; unfold ge in |- *; apply le_S_n; replace (S (pred n)) with n... -apply S_pred with 0%nat; apply lt_le_trans with (S x)... -apply lt_O_Sn... + intros Bn l H; set (An := fun _:nat => 1)... + assert (H0 : forall n:nat, 0 < An n)... + intro; unfold An in |- *; apply Rlt_0_1... + assert (H1 : forall n:nat, 0 < sum_f_R0 An n)... + intro; apply tech1... + assert (H2 : cv_infty (fun n:nat => sum_f_R0 An n))... + unfold cv_infty in |- *; intro; case (Rle_dec M 0); intro... + exists 0%nat; intros; apply Rle_lt_trans with 0... + assert (H2 : 0 < M)... + auto with real... + clear n; set (m := up M); elim (archimed M); intros; + assert (H5 : (0 <= m)%Z)... + apply le_IZR; unfold m in |- *; simpl in |- *; left; apply Rlt_trans with M... + elim (IZN _ H5); intros; exists x; intros; unfold An in |- *; rewrite sum_cte; + rewrite Rmult_1_l; apply Rlt_trans with (IZR (up M))... + apply Rle_lt_trans with (INR x)... + rewrite INR_IZR_INZ; fold m in |- *; rewrite <- H6; right... + apply lt_INR; apply le_lt_n_Sm... + assert (H3 := Cesaro _ _ _ H H0 H2)... + unfold Un_cv in |- *; unfold Un_cv in H3; intros; elim (H3 _ H4); intros; + exists (S x); intros; unfold R_dist in |- *; unfold R_dist in H5; + apply Rle_lt_trans with + (Rabs + (sum_f_R0 (fun k:nat => An k * Bn k) (pred n) / sum_f_R0 An (pred n) - l))... + right; + replace (sum_f_R0 Bn (pred n) / INR n - l) with + (sum_f_R0 (fun k:nat => An k * Bn k) (pred n) / sum_f_R0 An (pred n) - l)... + unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- l)); + apply Rplus_eq_compat_l... + unfold An in |- *; + replace (sum_f_R0 (fun k:nat => 1 * Bn k) (pred n)) with + (sum_f_R0 Bn (pred n))... + rewrite sum_cte; rewrite Rmult_1_l; replace (S (pred n)) with n... + apply S_pred with 0%nat; apply lt_le_trans with (S x)... + apply lt_O_Sn... + apply sum_eq; intros; ring... + apply H5; unfold ge in |- *; apply le_S_n; replace (S (pred n)) with n... + apply S_pred with 0%nat; apply lt_le_trans with (S x)... + apply lt_O_Sn... Qed. diff --git a/theories/Reals/SplitAbsolu.v b/theories/Reals/SplitAbsolu.v index 11b9d57b..08dbd67b 100644 --- a/theories/Reals/SplitAbsolu.v +++ b/theories/Reals/SplitAbsolu.v @@ -6,20 +6,20 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: SplitAbsolu.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: SplitAbsolu.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbasic_fun. Ltac split_case_Rabs := match goal with - | |- context [(Rcase_abs ?X1)] => + | |- context [(Rcase_abs ?X1)] => case (Rcase_abs X1); try split_case_Rabs end. Ltac split_Rabs := match goal with - | id:context [(Rabs _)] |- _ => generalize id; clear id; try split_Rabs - | |- context [(Rabs ?X1)] => + | id:context [(Rabs _)] |- _ => generalize id; clear id; try split_Rabs + | |- context [(Rabs ?X1)] => unfold Rabs in |- *; try split_case_Rabs; intros - end.
\ No newline at end of file + end. diff --git a/theories/Reals/SplitRmult.v b/theories/Reals/SplitRmult.v index 31d49b76..4f3fab24 100644 --- a/theories/Reals/SplitRmult.v +++ b/theories/Reals/SplitRmult.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: SplitRmult.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: SplitRmult.v 9245 2006-10-17 12:53:34Z notin $ i*) (*i Lemma mult_non_zero :(r1,r2:R)``r1<>0`` /\ ``r2<>0`` -> ``r1*r2<>0``. i*) @@ -15,6 +15,6 @@ Require Import Rbase. Ltac split_Rmult := match goal with - | |- ((?X1 * ?X2)%R <> 0%R) => + | |- ((?X1 * ?X2)%R <> 0%R) => apply Rmult_integral_contrapositive; split; try split_Rmult end. diff --git a/theories/Reals/Sqrt_reg.v b/theories/Reals/Sqrt_reg.v index 3e2b6b9f..ff0a72e8 100644 --- a/theories/Reals/Sqrt_reg.v +++ b/theories/Reals/Sqrt_reg.v @@ -5,8 +5,8 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) - -(*i $Id: Sqrt_reg.v 5920 2004-07-16 20:01:26Z herbelin $ i*) + +(*i $Id: Sqrt_reg.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rbase. Require Import Rfunctions. @@ -15,337 +15,344 @@ Require Import R_sqrt. Open Local Scope R_scope. (**********) Lemma sqrt_var_maj : - forall h:R, Rabs h <= 1 -> Rabs (sqrt (1 + h) - 1) <= Rabs h. -intros; cut (0 <= 1 + h). -intro; apply Rle_trans with (Rabs (sqrt (Rsqr (1 + h)) - 1)). -case (total_order_T h 0); intro. -elim s; intro. -repeat rewrite Rabs_left. -unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (-1)). -do 2 rewrite Ropp_plus_distr; rewrite Ropp_involutive; - apply Rplus_le_compat_l. -apply Ropp_le_contravar; apply sqrt_le_1. -apply Rle_0_sqr. -apply H0. -pattern (1 + h) at 2 in |- *; rewrite <- Rmult_1_r; unfold Rsqr in |- *; - apply Rmult_le_compat_l. -apply H0. -pattern 1 at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; - assumption. -apply Rplus_lt_reg_r with 1; rewrite Rplus_0_r; rewrite Rplus_comm; - unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l; - rewrite Rplus_0_r. -pattern 1 at 2 in |- *; rewrite <- sqrt_1; apply sqrt_lt_1. -apply Rle_0_sqr. -left; apply Rlt_0_1. -pattern 1 at 2 in |- *; rewrite <- Rsqr_1; apply Rsqr_incrst_1. -pattern 1 at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; - assumption. -apply H0. -left; apply Rlt_0_1. -apply Rplus_lt_reg_r with 1; rewrite Rplus_0_r; rewrite Rplus_comm; - unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l; - rewrite Rplus_0_r. -pattern 1 at 2 in |- *; rewrite <- sqrt_1; apply sqrt_lt_1. -apply H0. -left; apply Rlt_0_1. -pattern 1 at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; - assumption. -rewrite b; rewrite Rplus_0_r; rewrite Rsqr_1; rewrite sqrt_1; right; - reflexivity. -repeat rewrite Rabs_right. -unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (-1)); - apply Rplus_le_compat_l. -apply sqrt_le_1. -apply H0. -apply Rle_0_sqr. -pattern (1 + h) at 1 in |- *; rewrite <- Rmult_1_r; unfold Rsqr in |- *; - apply Rmult_le_compat_l. -apply H0. -pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; - assumption. -apply Rle_ge; apply Rplus_le_reg_l with 1. -rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *; - rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r. -pattern 1 at 1 in |- *; rewrite <- sqrt_1; apply sqrt_le_1. -left; apply Rlt_0_1. -apply Rle_0_sqr. -pattern 1 at 1 in |- *; rewrite <- Rsqr_1; apply Rsqr_incr_1. -pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; - assumption. -left; apply Rlt_0_1. -apply H0. -apply Rle_ge; left; apply Rplus_lt_reg_r with 1. -rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *; - rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r. -pattern 1 at 1 in |- *; rewrite <- sqrt_1; apply sqrt_lt_1. -left; apply Rlt_0_1. -apply H0. -pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; - assumption. -rewrite sqrt_Rsqr. -replace (1 + h - 1) with h; [ right; reflexivity | ring ]. -apply H0. -case (total_order_T h 0); intro. -elim s; intro. -rewrite (Rabs_left h a) in H. -apply Rplus_le_reg_l with (- h). -rewrite Rplus_0_r; rewrite Rplus_comm; rewrite Rplus_assoc; - rewrite Rplus_opp_r; rewrite Rplus_0_r; exact H. -left; rewrite b; rewrite Rplus_0_r; apply Rlt_0_1. -left; apply Rplus_lt_0_compat. -apply Rlt_0_1. -apply r. + forall h:R, Rabs h <= 1 -> Rabs (sqrt (1 + h) - 1) <= Rabs h. +Proof. + intros; cut (0 <= 1 + h). + intro; apply Rle_trans with (Rabs (sqrt (Rsqr (1 + h)) - 1)). + case (total_order_T h 0); intro. + elim s; intro. + repeat rewrite Rabs_left. + unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (-1)). + do 2 rewrite Ropp_plus_distr; rewrite Ropp_involutive; + apply Rplus_le_compat_l. + apply Ropp_le_contravar; apply sqrt_le_1. + apply Rle_0_sqr. + apply H0. + pattern (1 + h) at 2 in |- *; rewrite <- Rmult_1_r; unfold Rsqr in |- *; + apply Rmult_le_compat_l. + apply H0. + pattern 1 at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; + assumption. + apply Rplus_lt_reg_r with 1; rewrite Rplus_0_r; rewrite Rplus_comm; + unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l; + rewrite Rplus_0_r. + pattern 1 at 2 in |- *; rewrite <- sqrt_1; apply sqrt_lt_1. + apply Rle_0_sqr. + left; apply Rlt_0_1. + pattern 1 at 2 in |- *; rewrite <- Rsqr_1; apply Rsqr_incrst_1. + pattern 1 at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + assumption. + apply H0. + left; apply Rlt_0_1. + apply Rplus_lt_reg_r with 1; rewrite Rplus_0_r; rewrite Rplus_comm; + unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l; + rewrite Rplus_0_r. + pattern 1 at 2 in |- *; rewrite <- sqrt_1; apply sqrt_lt_1. + apply H0. + left; apply Rlt_0_1. + pattern 1 at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + assumption. + rewrite b; rewrite Rplus_0_r; rewrite Rsqr_1; rewrite sqrt_1; right; + reflexivity. + repeat rewrite Rabs_right. + unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (-1)); + apply Rplus_le_compat_l. + apply sqrt_le_1. + apply H0. + apply Rle_0_sqr. + pattern (1 + h) at 1 in |- *; rewrite <- Rmult_1_r; unfold Rsqr in |- *; + apply Rmult_le_compat_l. + apply H0. + pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; + assumption. + apply Rle_ge; apply Rplus_le_reg_l with 1. + rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *; + rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r. + pattern 1 at 1 in |- *; rewrite <- sqrt_1; apply sqrt_le_1. + left; apply Rlt_0_1. + apply Rle_0_sqr. + pattern 1 at 1 in |- *; rewrite <- Rsqr_1; apply Rsqr_incr_1. + pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; + assumption. + left; apply Rlt_0_1. + apply H0. + apply Rle_ge; left; apply Rplus_lt_reg_r with 1. + rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *; + rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r. + pattern 1 at 1 in |- *; rewrite <- sqrt_1; apply sqrt_lt_1. + left; apply Rlt_0_1. + apply H0. + pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + assumption. + rewrite sqrt_Rsqr. + replace (1 + h - 1) with h; [ right; reflexivity | ring ]. + apply H0. + case (total_order_T h 0); intro. + elim s; intro. + rewrite (Rabs_left h a) in H. + apply Rplus_le_reg_l with (- h). + rewrite Rplus_0_r; rewrite Rplus_comm; rewrite Rplus_assoc; + rewrite Rplus_opp_r; rewrite Rplus_0_r; exact H. + left; rewrite b; rewrite Rplus_0_r; apply Rlt_0_1. + left; apply Rplus_lt_0_compat. + apply Rlt_0_1. + apply r. Qed. -(* sqrt is continuous in 1 *) +(** sqrt is continuous in 1 *) Lemma sqrt_continuity_pt_R1 : continuity_pt sqrt 1. -unfold continuity_pt in |- *; unfold continue_in in |- *; - unfold limit1_in in |- *; unfold limit_in in |- *; - unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; - intros. -set (alpha := Rmin eps 1). -exists alpha; intros. -split. -unfold alpha in |- *; unfold Rmin in |- *; case (Rle_dec eps 1); intro. -assumption. -apply Rlt_0_1. -intros; elim H0; intros. -rewrite sqrt_1; replace x with (1 + (x - 1)); [ idtac | ring ]; - apply Rle_lt_trans with (Rabs (x - 1)). -apply sqrt_var_maj. -apply Rle_trans with alpha. -left; apply H2. -unfold alpha in |- *; apply Rmin_r. -apply Rlt_le_trans with alpha; - [ apply H2 | unfold alpha in |- *; apply Rmin_l ]. +Proof. + unfold continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; + intros. + set (alpha := Rmin eps 1). + exists alpha; intros. + split. + unfold alpha in |- *; unfold Rmin in |- *; case (Rle_dec eps 1); intro. + assumption. + apply Rlt_0_1. + intros; elim H0; intros. + rewrite sqrt_1; replace x with (1 + (x - 1)); [ idtac | ring ]; + apply Rle_lt_trans with (Rabs (x - 1)). + apply sqrt_var_maj. + apply Rle_trans with alpha. + left; apply H2. + unfold alpha in |- *; apply Rmin_r. + apply Rlt_le_trans with alpha; + [ apply H2 | unfold alpha in |- *; apply Rmin_l ]. Qed. -(* sqrt is continuous forall x>0 *) +(** sqrt is continuous forall x>0 *) Lemma sqrt_continuity_pt : forall x:R, 0 < x -> continuity_pt sqrt x. -intros; generalize sqrt_continuity_pt_R1. -unfold continuity_pt in |- *; unfold continue_in in |- *; - unfold limit1_in in |- *; unfold limit_in in |- *; - unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; - intros. -cut (0 < eps / sqrt x). -intro; elim (H0 _ H2); intros alp_1 H3. -elim H3; intros. -set (alpha := alp_1 * x). -exists (Rmin alpha x); intros. -split. -change (0 < Rmin alpha x) in |- *; unfold Rmin in |- *; - case (Rle_dec alpha x); intro. -unfold alpha in |- *; apply Rmult_lt_0_compat; assumption. -apply H. -intros; replace x0 with (x + (x0 - x)); [ idtac | ring ]; - replace (sqrt (x + (x0 - x)) - sqrt x) with - (sqrt x * (sqrt (1 + (x0 - x) / x) - sqrt 1)). -rewrite Rabs_mult; rewrite (Rabs_right (sqrt x)). -apply Rmult_lt_reg_l with (/ sqrt x). -apply Rinv_0_lt_compat; apply sqrt_lt_R0; assumption. -rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. -rewrite Rmult_1_l; rewrite Rmult_comm. -unfold Rdiv in H5. -case (Req_dec x x0); intro. -rewrite H7; unfold Rminus, Rdiv in |- *; rewrite Rplus_opp_r; - rewrite Rmult_0_l; rewrite Rplus_0_r; rewrite Rplus_opp_r; - rewrite Rabs_R0. -apply Rmult_lt_0_compat. -assumption. -apply Rinv_0_lt_compat; rewrite <- H7; apply sqrt_lt_R0; assumption. -apply H5. -split. -unfold D_x, no_cond in |- *. -split. -trivial. -red in |- *; intro. -cut ((x0 - x) * / x = 0). -intro. -elim (Rmult_integral _ _ H9); intro. -elim H7. -apply (Rminus_diag_uniq_sym _ _ H10). -assert (H11 := Rmult_eq_0_compat_r _ x H10). -rewrite <- Rinv_l_sym in H11. -elim R1_neq_R0; exact H11. -red in |- *; intro; rewrite H12 in H; elim (Rlt_irrefl _ H). -symmetry in |- *; apply Rplus_eq_reg_l with 1; rewrite Rplus_0_r; - unfold Rdiv in H8; exact H8. -unfold Rminus in |- *; rewrite Rplus_comm; rewrite <- Rplus_assoc; - rewrite Rplus_opp_l; rewrite Rplus_0_l; elim H6; intros. -unfold Rdiv in |- *; rewrite Rabs_mult. -rewrite Rabs_Rinv. -rewrite (Rabs_right x). -rewrite Rmult_comm; apply Rmult_lt_reg_l with x. -apply H. -rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. -rewrite Rmult_1_l; rewrite Rmult_comm; fold alpha in |- *. -apply Rlt_le_trans with (Rmin alpha x). -apply H9. -apply Rmin_l. -red in |- *; intro; rewrite H10 in H; elim (Rlt_irrefl _ H). -apply Rle_ge; left; apply H. -red in |- *; intro; rewrite H10 in H; elim (Rlt_irrefl _ H). -assert (H7 := sqrt_lt_R0 x H). -red in |- *; intro; rewrite H8 in H7; elim (Rlt_irrefl _ H7). -apply Rle_ge; apply sqrt_positivity. -left; apply H. -unfold Rminus in |- *; rewrite Rmult_plus_distr_l; - rewrite Ropp_mult_distr_r_reverse; repeat rewrite <- sqrt_mult. -rewrite Rmult_1_r; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r; - unfold Rdiv in |- *; rewrite Rmult_comm; rewrite Rmult_assoc; - rewrite <- Rinv_l_sym. -rewrite Rmult_1_r; reflexivity. -red in |- *; intro; rewrite H7 in H; elim (Rlt_irrefl _ H). -left; apply H. -left; apply Rlt_0_1. -left; apply H. -elim H6; intros. -case (Rcase_abs (x0 - x)); intro. -rewrite (Rabs_left (x0 - x) r) in H8. -rewrite Rplus_comm. -apply Rplus_le_reg_l with (- ((x0 - x) / x)). -rewrite Rplus_0_r; rewrite <- Rplus_assoc; rewrite Rplus_opp_l; - rewrite Rplus_0_l; unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse. -apply Rmult_le_reg_l with x. -apply H. -rewrite Rmult_1_r; rewrite Rmult_comm; rewrite Rmult_assoc; - rewrite <- Rinv_l_sym. -rewrite Rmult_1_r; left; apply Rlt_le_trans with (Rmin alpha x). -apply H8. -apply Rmin_r. -red in |- *; intro; rewrite H9 in H; elim (Rlt_irrefl _ H). -apply Rplus_le_le_0_compat. -left; apply Rlt_0_1. -unfold Rdiv in |- *; apply Rmult_le_pos. -apply Rge_le; exact r. -left; apply Rinv_0_lt_compat; apply H. -unfold Rdiv in |- *; apply Rmult_lt_0_compat. -apply H1. -apply Rinv_0_lt_compat; apply sqrt_lt_R0; apply H. +Proof. + intros; generalize sqrt_continuity_pt_R1. + unfold continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; + intros. + cut (0 < eps / sqrt x). + intro; elim (H0 _ H2); intros alp_1 H3. + elim H3; intros. + set (alpha := alp_1 * x). + exists (Rmin alpha x); intros. + split. + change (0 < Rmin alpha x) in |- *; unfold Rmin in |- *; + case (Rle_dec alpha x); intro. + unfold alpha in |- *; apply Rmult_lt_0_compat; assumption. + apply H. + intros; replace x0 with (x + (x0 - x)); [ idtac | ring ]; + replace (sqrt (x + (x0 - x)) - sqrt x) with + (sqrt x * (sqrt (1 + (x0 - x) / x) - sqrt 1)). + rewrite Rabs_mult; rewrite (Rabs_right (sqrt x)). + apply Rmult_lt_reg_l with (/ sqrt x). + apply Rinv_0_lt_compat; apply sqrt_lt_R0; assumption. + rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. + rewrite Rmult_1_l; rewrite Rmult_comm. + unfold Rdiv in H5. + case (Req_dec x x0); intro. + rewrite H7; unfold Rminus, Rdiv in |- *; rewrite Rplus_opp_r; + rewrite Rmult_0_l; rewrite Rplus_0_r; rewrite Rplus_opp_r; + rewrite Rabs_R0. + apply Rmult_lt_0_compat. + assumption. + apply Rinv_0_lt_compat; rewrite <- H7; apply sqrt_lt_R0; assumption. + apply H5. + split. + unfold D_x, no_cond in |- *. + split. + trivial. + red in |- *; intro. + cut ((x0 - x) * / x = 0). + intro. + elim (Rmult_integral _ _ H9); intro. + elim H7. + apply (Rminus_diag_uniq_sym _ _ H10). + assert (H11 := Rmult_eq_0_compat_r _ x H10). + rewrite <- Rinv_l_sym in H11. + elim R1_neq_R0; exact H11. + red in |- *; intro; rewrite H12 in H; elim (Rlt_irrefl _ H). + symmetry in |- *; apply Rplus_eq_reg_l with 1; rewrite Rplus_0_r; + unfold Rdiv in H8; exact H8. + unfold Rminus in |- *; rewrite Rplus_comm; rewrite <- Rplus_assoc; + rewrite Rplus_opp_l; rewrite Rplus_0_l; elim H6; intros. + unfold Rdiv in |- *; rewrite Rabs_mult. + rewrite Rabs_Rinv. + rewrite (Rabs_right x). + rewrite Rmult_comm; apply Rmult_lt_reg_l with x. + apply H. + rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. + rewrite Rmult_1_l; rewrite Rmult_comm; fold alpha in |- *. + apply Rlt_le_trans with (Rmin alpha x). + apply H9. + apply Rmin_l. + red in |- *; intro; rewrite H10 in H; elim (Rlt_irrefl _ H). + apply Rle_ge; left; apply H. + red in |- *; intro; rewrite H10 in H; elim (Rlt_irrefl _ H). + assert (H7 := sqrt_lt_R0 x H). + red in |- *; intro; rewrite H8 in H7; elim (Rlt_irrefl _ H7). + apply Rle_ge; apply sqrt_positivity. + left; apply H. + unfold Rminus in |- *; rewrite Rmult_plus_distr_l; + rewrite Ropp_mult_distr_r_reverse; repeat rewrite <- sqrt_mult. + rewrite Rmult_1_r; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r; + unfold Rdiv in |- *; rewrite Rmult_comm; rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. + rewrite Rmult_1_r; reflexivity. + red in |- *; intro; rewrite H7 in H; elim (Rlt_irrefl _ H). + left; apply H. + left; apply Rlt_0_1. + left; apply H. + elim H6; intros. + case (Rcase_abs (x0 - x)); intro. + rewrite (Rabs_left (x0 - x) r) in H8. + rewrite Rplus_comm. + apply Rplus_le_reg_l with (- ((x0 - x) / x)). + rewrite Rplus_0_r; rewrite <- Rplus_assoc; rewrite Rplus_opp_l; + rewrite Rplus_0_l; unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse. + apply Rmult_le_reg_l with x. + apply H. + rewrite Rmult_1_r; rewrite Rmult_comm; rewrite Rmult_assoc; + rewrite <- Rinv_l_sym. + rewrite Rmult_1_r; left; apply Rlt_le_trans with (Rmin alpha x). + apply H8. + apply Rmin_r. + red in |- *; intro; rewrite H9 in H; elim (Rlt_irrefl _ H). + apply Rplus_le_le_0_compat. + left; apply Rlt_0_1. + unfold Rdiv in |- *; apply Rmult_le_pos. + apply Rge_le; exact r. + left; apply Rinv_0_lt_compat; apply H. + unfold Rdiv in |- *; apply Rmult_lt_0_compat. + apply H1. + apply Rinv_0_lt_compat; apply sqrt_lt_R0; apply H. Qed. -(* sqrt is derivable for all x>0 *) +(** sqrt is derivable for all x>0 *) Lemma derivable_pt_lim_sqrt : - forall x:R, 0 < x -> derivable_pt_lim sqrt x (/ (2 * sqrt x)). -intros; set (g := fun h:R => sqrt x + sqrt (x + h)). -cut (continuity_pt g 0). -intro; cut (g 0 <> 0). -intro; assert (H2 := continuity_pt_inv g 0 H0 H1). -unfold derivable_pt_lim in |- *; intros; unfold continuity_pt in H2; - unfold continue_in in H2; unfold limit1_in in H2; - unfold limit_in in H2; simpl in H2; unfold R_dist in H2. -elim (H2 eps H3); intros alpha H4. -elim H4; intros. -set (alpha1 := Rmin alpha x). -cut (0 < alpha1). -intro; exists (mkposreal alpha1 H7); intros. -replace ((sqrt (x + h) - sqrt x) / h) with (/ (sqrt x + sqrt (x + h))). -unfold inv_fct, g in H6; replace (2 * sqrt x) with (sqrt x + sqrt (x + 0)). -apply H6. -split. -unfold D_x, no_cond in |- *. -split. -trivial. -apply (sym_not_eq (A:=R)); exact H8. -unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; - apply Rlt_le_trans with alpha1. -exact H9. -unfold alpha1 in |- *; apply Rmin_l. -rewrite Rplus_0_r; ring. -cut (0 <= x + h). -intro; cut (0 < sqrt x + sqrt (x + h)). -intro; apply Rmult_eq_reg_l with (sqrt x + sqrt (x + h)). -rewrite <- Rinv_r_sym. -rewrite Rplus_comm; unfold Rdiv in |- *; rewrite <- Rmult_assoc; - rewrite Rsqr_plus_minus; repeat rewrite Rsqr_sqrt. -rewrite Rplus_comm; unfold Rminus in |- *; rewrite Rplus_assoc; - rewrite Rplus_opp_r; rewrite Rplus_0_r; rewrite <- Rinv_r_sym. -reflexivity. -apply H8. -left; apply H. -assumption. -red in |- *; intro; rewrite H12 in H11; elim (Rlt_irrefl _ H11). -red in |- *; intro; rewrite H12 in H11; elim (Rlt_irrefl _ H11). -apply Rplus_lt_le_0_compat. -apply sqrt_lt_R0; apply H. -apply sqrt_positivity; apply H10. -case (Rcase_abs h); intro. -rewrite (Rabs_left h r) in H9. -apply Rplus_le_reg_l with (- h). -rewrite Rplus_0_r; rewrite Rplus_comm; rewrite Rplus_assoc; - rewrite Rplus_opp_r; rewrite Rplus_0_r; left; apply Rlt_le_trans with alpha1. -apply H9. -unfold alpha1 in |- *; apply Rmin_r. -apply Rplus_le_le_0_compat. -left; assumption. -apply Rge_le; apply r. -unfold alpha1 in |- *; unfold Rmin in |- *; case (Rle_dec alpha x); intro. -apply H5. -apply H. -unfold g in |- *; rewrite Rplus_0_r. -cut (0 < sqrt x + sqrt x). -intro; red in |- *; intro; rewrite H2 in H1; elim (Rlt_irrefl _ H1). -apply Rplus_lt_0_compat; apply sqrt_lt_R0; apply H. -replace g with (fct_cte (sqrt x) + comp sqrt (fct_cte x + id))%F; - [ idtac | reflexivity ]. -apply continuity_pt_plus. -apply continuity_pt_const; unfold constant, fct_cte in |- *; intro; - reflexivity. -apply continuity_pt_comp. -apply continuity_pt_plus. -apply continuity_pt_const; unfold constant, fct_cte in |- *; intro; - reflexivity. -apply derivable_continuous_pt; apply derivable_pt_id. -apply sqrt_continuity_pt. -unfold plus_fct, fct_cte, id in |- *; rewrite Rplus_0_r; apply H. + forall x:R, 0 < x -> derivable_pt_lim sqrt x (/ (2 * sqrt x)). +Proof. + intros; set (g := fun h:R => sqrt x + sqrt (x + h)). + cut (continuity_pt g 0). + intro; cut (g 0 <> 0). + intro; assert (H2 := continuity_pt_inv g 0 H0 H1). + unfold derivable_pt_lim in |- *; intros; unfold continuity_pt in H2; + unfold continue_in in H2; unfold limit1_in in H2; + unfold limit_in in H2; simpl in H2; unfold R_dist in H2. + elim (H2 eps H3); intros alpha H4. + elim H4; intros. + set (alpha1 := Rmin alpha x). + cut (0 < alpha1). + intro; exists (mkposreal alpha1 H7); intros. + replace ((sqrt (x + h) - sqrt x) / h) with (/ (sqrt x + sqrt (x + h))). + unfold inv_fct, g in H6; replace (2 * sqrt x) with (sqrt x + sqrt (x + 0)). + apply H6. + split. + unfold D_x, no_cond in |- *. + split. + trivial. + apply (sym_not_eq (A:=R)); exact H8. + unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; + apply Rlt_le_trans with alpha1. + exact H9. + unfold alpha1 in |- *; apply Rmin_l. + rewrite Rplus_0_r; ring. + cut (0 <= x + h). + intro; cut (0 < sqrt x + sqrt (x + h)). + intro; apply Rmult_eq_reg_l with (sqrt x + sqrt (x + h)). + rewrite <- Rinv_r_sym. + rewrite Rplus_comm; unfold Rdiv in |- *; rewrite <- Rmult_assoc; + rewrite Rsqr_plus_minus; repeat rewrite Rsqr_sqrt. + rewrite Rplus_comm; unfold Rminus in |- *; rewrite Rplus_assoc; + rewrite Rplus_opp_r; rewrite Rplus_0_r; rewrite <- Rinv_r_sym. + reflexivity. + apply H8. + left; apply H. + assumption. + red in |- *; intro; rewrite H12 in H11; elim (Rlt_irrefl _ H11). + red in |- *; intro; rewrite H12 in H11; elim (Rlt_irrefl _ H11). + apply Rplus_lt_le_0_compat. + apply sqrt_lt_R0; apply H. + apply sqrt_positivity; apply H10. + case (Rcase_abs h); intro. + rewrite (Rabs_left h r) in H9. + apply Rplus_le_reg_l with (- h). + rewrite Rplus_0_r; rewrite Rplus_comm; rewrite Rplus_assoc; + rewrite Rplus_opp_r; rewrite Rplus_0_r; left; apply Rlt_le_trans with alpha1. + apply H9. + unfold alpha1 in |- *; apply Rmin_r. + apply Rplus_le_le_0_compat. + left; assumption. + apply Rge_le; apply r. + unfold alpha1 in |- *; unfold Rmin in |- *; case (Rle_dec alpha x); intro. + apply H5. + apply H. + unfold g in |- *; rewrite Rplus_0_r. + cut (0 < sqrt x + sqrt x). + intro; red in |- *; intro; rewrite H2 in H1; elim (Rlt_irrefl _ H1). + apply Rplus_lt_0_compat; apply sqrt_lt_R0; apply H. + replace g with (fct_cte (sqrt x) + comp sqrt (fct_cte x + id))%F; + [ idtac | reflexivity ]. + apply continuity_pt_plus. + apply continuity_pt_const; unfold constant, fct_cte in |- *; intro; + reflexivity. + apply continuity_pt_comp. + apply continuity_pt_plus. + apply continuity_pt_const; unfold constant, fct_cte in |- *; intro; + reflexivity. + apply derivable_continuous_pt; apply derivable_pt_id. + apply sqrt_continuity_pt. + unfold plus_fct, fct_cte, id in |- *; rewrite Rplus_0_r; apply H. Qed. (**********) Lemma derivable_pt_sqrt : forall x:R, 0 < x -> derivable_pt sqrt x. -unfold derivable_pt in |- *; intros. -apply existT with (/ (2 * sqrt x)). -apply derivable_pt_lim_sqrt; assumption. +Proof. + unfold derivable_pt in |- *; intros. + apply existT with (/ (2 * sqrt x)). + apply derivable_pt_lim_sqrt; assumption. Qed. (**********) Lemma derive_pt_sqrt : - forall (x:R) (pr:0 < x), - derive_pt sqrt x (derivable_pt_sqrt _ pr) = / (2 * sqrt x). -intros. -apply derive_pt_eq_0. -apply derivable_pt_lim_sqrt; assumption. + forall (x:R) (pr:0 < x), + derive_pt sqrt x (derivable_pt_sqrt _ pr) = / (2 * sqrt x). +Proof. + intros. + apply derive_pt_eq_0. + apply derivable_pt_lim_sqrt; assumption. Qed. -(* We show that sqrt is continuous for all x>=0 *) -(* Remark : by definition of sqrt (as extension of Rsqrt on |R), *) -(* we could also show that sqrt is continuous for all x *) +(** We show that sqrt is continuous for all x>=0 *) +(** Remark : by definition of sqrt (as extension of Rsqrt on |R), + we could also show that sqrt is continuous for all x *) Lemma continuity_pt_sqrt : forall x:R, 0 <= x -> continuity_pt sqrt x. -intros; case (Rtotal_order 0 x); intro. -apply (sqrt_continuity_pt x H0). -elim H0; intro. -unfold continuity_pt in |- *; unfold continue_in in |- *; - unfold limit1_in in |- *; unfold limit_in in |- *; - simpl in |- *; unfold R_dist in |- *; intros. -exists (Rsqr eps); intros. -split. -change (0 < Rsqr eps) in |- *; apply Rsqr_pos_lt. -red in |- *; intro; rewrite H3 in H2; elim (Rlt_irrefl _ H2). -intros; elim H3; intros. -rewrite <- H1; rewrite sqrt_0; unfold Rminus in |- *; rewrite Ropp_0; - rewrite Rplus_0_r; rewrite <- H1 in H5; unfold Rminus in H5; - rewrite Ropp_0 in H5; rewrite Rplus_0_r in H5. -case (Rcase_abs x0); intro. -unfold sqrt in |- *; case (Rcase_abs x0); intro. -rewrite Rabs_R0; apply H2. -assert (H6 := Rge_le _ _ r0); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 r)). -rewrite Rabs_right. -apply Rsqr_incrst_0. -rewrite Rsqr_sqrt. -rewrite (Rabs_right x0 r) in H5; apply H5. -apply Rge_le; exact r. -apply sqrt_positivity; apply Rge_le; exact r. -left; exact H2. -apply Rle_ge; apply sqrt_positivity; apply Rge_le; exact r. -elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H1 H)). -Qed.
\ No newline at end of file +Proof. + intros; case (Rtotal_order 0 x); intro. + apply (sqrt_continuity_pt x H0). + elim H0; intro. + unfold continuity_pt in |- *; unfold continue_in in |- *; + unfold limit1_in in |- *; unfold limit_in in |- *; + simpl in |- *; unfold R_dist in |- *; intros. + exists (Rsqr eps); intros. + split. + change (0 < Rsqr eps) in |- *; apply Rsqr_pos_lt. + red in |- *; intro; rewrite H3 in H2; elim (Rlt_irrefl _ H2). + intros; elim H3; intros. + rewrite <- H1; rewrite sqrt_0; unfold Rminus in |- *; rewrite Ropp_0; + rewrite Rplus_0_r; rewrite <- H1 in H5; unfold Rminus in H5; + rewrite Ropp_0 in H5; rewrite Rplus_0_r in H5. + case (Rcase_abs x0); intro. + unfold sqrt in |- *; case (Rcase_abs x0); intro. + rewrite Rabs_R0; apply H2. + assert (H6 := Rge_le _ _ r0); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 r)). + rewrite Rabs_right. + apply Rsqr_incrst_0. + rewrite Rsqr_sqrt. + rewrite (Rabs_right x0 r) in H5; apply H5. + apply Rge_le; exact r. + apply sqrt_positivity; apply Rge_le; exact r. + left; exact H2. + apply Rle_ge; apply sqrt_positivity; apply Rge_le; exact r. + elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H1 H)). +Qed. diff --git a/theories/Relations/Newman.v b/theories/Relations/Newman.v index ae914933..e7bb66eb 100644 --- a/theories/Relations/Newman.v +++ b/theories/Relations/Newman.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Newman.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Newman.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Rstar. @@ -23,24 +23,23 @@ Let Rstar_Rstar' := Rstar_Rstar' A R. Definition coherence (x y:A) := ex2 (Rstar x) (Rstar y). Theorem coherence_intro : - forall x y z:A, Rstar x z -> Rstar y z -> coherence x y. -Proof - fun (x y z:A) (h1:Rstar x z) (h2:Rstar y z) => - ex_intro2 (Rstar x) (Rstar y) z h1 h2. + forall x y z:A, Rstar x z -> Rstar y z -> coherence x y. +Proof fun (x y z:A) (h1:Rstar x z) (h2:Rstar y z) => + ex_intro2 (Rstar x) (Rstar y) z h1 h2. (** A very simple case of coherence : *) Lemma Rstar_coherence : forall x y:A, Rstar x y -> coherence x y. - Proof - fun (x y:A) (h:Rstar x y) => coherence_intro x y y h (Rstar_reflexive y). +Proof + fun (x y:A) (h:Rstar x y) => coherence_intro x y y h (Rstar_reflexive y). (** coherence is symmetric *) Lemma coherence_sym : forall x y:A, coherence x y -> coherence y x. - Proof - fun (x y:A) (h:coherence x y) => - ex2_ind - (fun (w:A) (h1:Rstar x w) (h2:Rstar y w) => - coherence_intro y x w h2 h1) h. +Proof + fun (x y:A) (h:coherence x y) => + ex2_ind + (fun (w:A) (h1:Rstar x w) (h2:Rstar y w) => + coherence_intro y x w h2 h1) h. Definition confluence (x:A) := forall y z:A, Rstar x y -> Rstar x z -> coherence y z. @@ -54,68 +53,67 @@ Definition noetherian := Section Newman_section. -(** The general hypotheses of the theorem *) + (** The general hypotheses of the theorem *) -Hypothesis Hyp1 : noetherian. -Hypothesis Hyp2 : forall x:A, local_confluence x. + Hypothesis Hyp1 : noetherian. + Hypothesis Hyp2 : forall x:A, local_confluence x. -(** The induction hypothesis *) + (** The induction hypothesis *) -Section Induct. - Variable x : A. - Hypothesis hyp_ind : forall u:A, R x u -> confluence u. + Section Induct. + Variable x : A. + Hypothesis hyp_ind : forall u:A, R x u -> confluence u. -(** Confluence in [x] *) + (** Confluence in [x] *) - Variables y z : A. - Hypothesis h1 : Rstar x y. - Hypothesis h2 : Rstar x z. + Variables y z : A. + Hypothesis h1 : Rstar x y. + Hypothesis h2 : Rstar x z. -(** particular case [x->u] and [u->*y] *) -Section Newman_. - Variable u : A. - Hypothesis t1 : R x u. - Hypothesis t2 : Rstar u y. + (** particular case [x->u] and [u->*y] *) + Section Newman_. + Variable u : A. + Hypothesis t1 : R x u. + Hypothesis t2 : Rstar u y. + + (** In the usual diagram, we assume also [x->v] and [v->*z] *) + + Theorem Diagram : forall (v:A) (u1:R x v) (u2:Rstar v z), coherence y z. + Proof + (* We draw the diagram ! *) + fun (v:A) (u1:R x v) (u2:Rstar v z) => + ex2_ind + (* local confluence in x for u,v *) + (* gives w, u->*w and v->*w *) + (fun (w:A) (s1:Rstar u w) (s2:Rstar v w) => + ex2_ind + (* confluence in u => coherence(y,w) *) + (* gives a, y->*a and z->*a *) + (fun (a:A) (v1:Rstar y a) (v2:Rstar w a) => + ex2_ind + (* confluence in v => coherence(a,z) *) + (* gives b, a->*b and z->*b *) + (fun (b:A) (w1:Rstar a b) (w2:Rstar z b) => + coherence_intro y z b (Rstar_transitive y a b v1 w1) w2) + (hyp_ind v u1 a z (Rstar_transitive v w a s2 v2) u2)) + (hyp_ind u t1 y w t2 s1)) (Hyp2 x u v t1 u1). -(** In the usual diagram, we assume also [x->v] and [v->*z] *) - -Theorem Diagram : forall (v:A) (u1:R x v) (u2:Rstar v z), coherence y z. - -Proof - (* We draw the diagram ! *) - fun (v:A) (u1:R x v) (u2:Rstar v z) => - ex2_ind - (* local confluence in x for u,v *) - (* gives w, u->*w and v->*w *) - (fun (w:A) (s1:Rstar u w) (s2:Rstar v w) => - ex2_ind - (* confluence in u => coherence(y,w) *) - (* gives a, y->*a and z->*a *) - (fun (a:A) (v1:Rstar y a) (v2:Rstar w a) => - ex2_ind - (* confluence in v => coherence(a,z) *) - (* gives b, a->*b and z->*b *) - (fun (b:A) (w1:Rstar a b) (w2:Rstar z b) => - coherence_intro y z b (Rstar_transitive y a b v1 w1) w2) - (hyp_ind v u1 a z (Rstar_transitive v w a s2 v2) u2)) - (hyp_ind u t1 y w t2 s1)) (Hyp2 x u v t1 u1). - -Theorem caseRxy : coherence y z. -Proof - Rstar_Rstar' x z h2 (fun v w:A => coherence y w) - (coherence_sym x y (Rstar_coherence x y h1)) (*i case x=z i*) - Diagram. (*i case x->v->*z i*) -End Newman_. - -Theorem Ind_proof : coherence y z. -Proof - Rstar_Rstar' x y h1 (fun u v:A => coherence v z) - (Rstar_coherence x z h2) (*i case x=y i*) - caseRxy. (*i case x->u->*z i*) -End Induct. - -Theorem Newman : forall x:A, confluence x. -Proof fun x:A => Hyp1 x confluence Ind_proof. + Theorem caseRxy : coherence y z. + Proof + Rstar_Rstar' x z h2 (fun v w:A => coherence y w) + (coherence_sym x y (Rstar_coherence x y h1)) (*i case x=z i*) + Diagram. (*i case x->v->*z i*) + End Newman_. + + Theorem Ind_proof : coherence y z. + Proof + Rstar_Rstar' x y h1 (fun u v:A => coherence v z) + (Rstar_coherence x z h2) (*i case x=y i*) + caseRxy. (*i case x->u->*z i*) + End Induct. + + Theorem Newman : forall x:A, confluence x. + Proof fun x:A => Hyp1 x confluence Ind_proof. End Newman_section. diff --git a/theories/Relations/Operators_Properties.v b/theories/Relations/Operators_Properties.v index 22a08a27..40fd8f36 100644 --- a/theories/Relations/Operators_Properties.v +++ b/theories/Relations/Operators_Properties.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Operators_Properties.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Operators_Properties.v 9245 2006-10-17 12:53:34Z notin $ i*) (****************************************************************************) (* Bruno Barras *) @@ -22,75 +22,77 @@ Section Properties. Variable R : relation A. Let incl (R1 R2:relation A) : Prop := forall x y:A, R1 x y -> R2 x y. - -Section Clos_Refl_Trans. - - Lemma clos_rt_is_preorder : preorder A (clos_refl_trans A R). -apply Build_preorder. -exact (rt_refl A R). - -exact (rt_trans A R). -Qed. - - - -Lemma clos_rt_idempotent : - incl (clos_refl_trans A (clos_refl_trans A R)) (clos_refl_trans A R). -red in |- *. -induction 1; auto with sets. -intros. -apply rt_trans with y; auto with sets. -Qed. - - Lemma clos_refl_trans_ind_left : - forall (A:Set) (R:A -> A -> Prop) (M:A) (P:A -> Prop), - P M -> - (forall P0 N:A, clos_refl_trans A R M P0 -> P P0 -> R P0 N -> P N) -> - forall a:A, clos_refl_trans A R M a -> P a. -intros. -generalize H H0. -clear H H0. -elim H1; intros; auto with sets. -apply H2 with x; auto with sets. - -apply H3. -apply H0; auto with sets. - -intros. -apply H5 with P0; auto with sets. -apply rt_trans with y; auto with sets. -Qed. - - -End Clos_Refl_Trans. - - -Section Clos_Refl_Sym_Trans. - - Lemma clos_rt_clos_rst : - inclusion A (clos_refl_trans A R) (clos_refl_sym_trans A R). -red in |- *. -induction 1; auto with sets. -apply rst_trans with y; auto with sets. -Qed. - - Lemma clos_rst_is_equiv : equivalence A (clos_refl_sym_trans A R). -apply Build_equivalence. -exact (rst_refl A R). - -exact (rst_trans A R). - -exact (rst_sym A R). -Qed. - - Lemma clos_rst_idempotent : - incl (clos_refl_sym_trans A (clos_refl_sym_trans A R)) - (clos_refl_sym_trans A R). -red in |- *. -induction 1; auto with sets. -apply rst_trans with y; auto with sets. -Qed. - -End Clos_Refl_Sym_Trans. + + Section Clos_Refl_Trans. + + Lemma clos_rt_is_preorder : preorder A (clos_refl_trans A R). + Proof. + apply Build_preorder. + exact (rt_refl A R). + + exact (rt_trans A R). + Qed. + + Lemma clos_rt_idempotent : + incl (clos_refl_trans A (clos_refl_trans A R)) (clos_refl_trans A R). + Proof. + red in |- *. + induction 1; auto with sets. + intros. + apply rt_trans with y; auto with sets. + Qed. + + Lemma clos_refl_trans_ind_left : + forall (A:Set) (R:A -> A -> Prop) (M:A) (P:A -> Prop), + P M -> + (forall P0 N:A, clos_refl_trans A R M P0 -> P P0 -> R P0 N -> P N) -> + forall a:A, clos_refl_trans A R M a -> P a. + Proof. + intros. + generalize H H0. + clear H H0. + elim H1; intros; auto with sets. + apply H2 with x; auto with sets. + + apply H3. + apply H0; auto with sets. + + intros. + apply H5 with P0; auto with sets. + apply rt_trans with y; auto with sets. + Qed. + + + End Clos_Refl_Trans. + + + Section Clos_Refl_Sym_Trans. + + Lemma clos_rt_clos_rst : + inclusion A (clos_refl_trans A R) (clos_refl_sym_trans A R). + Proof. + red in |- *. + induction 1; auto with sets. + apply rst_trans with y; auto with sets. + Qed. + + Lemma clos_rst_is_equiv : equivalence A (clos_refl_sym_trans A R). + Proof. + apply Build_equivalence. + exact (rst_refl A R). + exact (rst_trans A R). + exact (rst_sym A R). + Qed. + + Lemma clos_rst_idempotent : + incl (clos_refl_sym_trans A (clos_refl_sym_trans A R)) + (clos_refl_sym_trans A R). + Proof. + red in |- *. + induction 1; auto with sets. + apply rst_trans with y; auto with sets. + Qed. + + End Clos_Refl_Sym_Trans. End Properties.
\ No newline at end of file diff --git a/theories/Relations/Relation_Definitions.v b/theories/Relations/Relation_Definitions.v index 22ba7413..762da1ff 100644 --- a/theories/Relations/Relation_Definitions.v +++ b/theories/Relations/Relation_Definitions.v @@ -6,67 +6,66 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Relation_Definitions.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Relation_Definitions.v 9245 2006-10-17 12:53:34Z notin $ i*) Section Relation_Definition. - Variable A : Type. - - Definition relation := A -> A -> Prop. + Variable A : Type. + + Definition relation := A -> A -> Prop. - Variable R : relation. + Variable R : relation. -Section General_Properties_of_Relations. - - Definition reflexive : Prop := forall x:A, R x x. - Definition transitive : Prop := forall x y z:A, R x y -> R y z -> R x z. - Definition symmetric : Prop := forall x y:A, R x y -> R y x. - Definition antisymmetric : Prop := forall x y:A, R x y -> R y x -> x = y. - - (* for compatibility with Equivalence in ../PROGRAMS/ALG/ *) - Definition equiv := reflexive /\ transitive /\ symmetric. - -End General_Properties_of_Relations. - + Section General_Properties_of_Relations. + + Definition reflexive : Prop := forall x:A, R x x. + Definition transitive : Prop := forall x y z:A, R x y -> R y z -> R x z. + Definition symmetric : Prop := forall x y:A, R x y -> R y x. + Definition antisymmetric : Prop := forall x y:A, R x y -> R y x -> x = y. + (* for compatibility with Equivalence in ../PROGRAMS/ALG/ *) + Definition equiv := reflexive /\ transitive /\ symmetric. -Section Sets_of_Relations. + End General_Properties_of_Relations. - Record preorder : Prop := - {preord_refl : reflexive; preord_trans : transitive}. - Record order : Prop := - {ord_refl : reflexive; - ord_trans : transitive; - ord_antisym : antisymmetric}. - Record equivalence : Prop := - {equiv_refl : reflexive; - equiv_trans : transitive; - equiv_sym : symmetric}. - - Record PER : Prop := {per_sym : symmetric; per_trans : transitive}. - -End Sets_of_Relations. + Section Sets_of_Relations. + + Record preorder : Prop := + { preord_refl : reflexive; preord_trans : transitive}. + + Record order : Prop := + { ord_refl : reflexive; + ord_trans : transitive; + ord_antisym : antisymmetric}. + + Record equivalence : Prop := + { equiv_refl : reflexive; + equiv_trans : transitive; + equiv_sym : symmetric}. + + Record PER : Prop := {per_sym : symmetric; per_trans : transitive}. + End Sets_of_Relations. -Section Relations_of_Relations. + Section Relations_of_Relations. + + Definition inclusion (R1 R2:relation) : Prop := + forall x y:A, R1 x y -> R2 x y. + + Definition same_relation (R1 R2:relation) : Prop := + inclusion R1 R2 /\ inclusion R2 R1. + + Definition commut (R1 R2:relation) : Prop := + forall x y:A, + R1 y x -> forall z:A, R2 z y -> exists2 y' : A, R2 y' x & R1 z y'. - Definition inclusion (R1 R2:relation) : Prop := - forall x y:A, R1 x y -> R2 x y. + End Relations_of_Relations. - Definition same_relation (R1 R2:relation) : Prop := - inclusion R1 R2 /\ inclusion R2 R1. - - Definition commut (R1 R2:relation) : Prop := - forall x y:A, - R1 y x -> forall z:A, R2 z y -> exists2 y' : A, R2 y' x & R1 z y'. -End Relations_of_Relations. - - End Relation_Definition. Hint Unfold reflexive transitive antisymmetric symmetric: sets v62. @@ -75,4 +74,4 @@ Hint Resolve Build_preorder Build_order Build_equivalence Build_PER preord_refl preord_trans ord_refl ord_trans ord_antisym equiv_refl equiv_trans equiv_sym per_sym per_trans: sets v62. -Hint Unfold inclusion same_relation commut: sets v62.
\ No newline at end of file +Hint Unfold inclusion same_relation commut: sets v62. diff --git a/theories/Relations/Relation_Operators.v b/theories/Relations/Relation_Operators.v index edc112e5..089246da 100644 --- a/theories/Relations/Relation_Operators.v +++ b/theories/Relations/Relation_Operators.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Relation_Operators.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Relation_Operators.v 9245 2006-10-17 12:53:34Z notin $ i*) (****************************************************************************) (* Bruno Barras, Cristina Cornes *) @@ -24,7 +24,7 @@ Require Import List. Section Transitive_Closure. Variable A : Type. Variable R : relation A. - + Inductive clos_trans (x: A) : A -> Prop := | t_step : forall y:A, R x y -> clos_trans x y | t_trans : @@ -48,16 +48,16 @@ End Reflexive_Transitive_Closure. Section Reflexive_Symetric_Transitive_Closure. Variable A : Type. Variable R : relation A. - + Inductive clos_refl_sym_trans : relation A := | rst_step : forall x y:A, R x y -> clos_refl_sym_trans x y | rst_refl : forall x:A, clos_refl_sym_trans x x | rst_sym : - forall x y:A, clos_refl_sym_trans x y -> clos_refl_sym_trans y x + forall x y:A, clos_refl_sym_trans x y -> clos_refl_sym_trans y x | rst_trans : - forall x y z:A, - clos_refl_sym_trans x y -> - clos_refl_sym_trans y z -> clos_refl_sym_trans x z. + forall x y z:A, + clos_refl_sym_trans x y -> + clos_refl_sym_trans y z -> clos_refl_sym_trans x z. End Reflexive_Symetric_Transitive_Closure. @@ -92,18 +92,18 @@ End Disjoint_Union. Section Lexicographic_Product. -(* Lexicographic order on dependent pairs *) + (* Lexicographic order on dependent pairs *) -Variable A : Set. -Variable B : A -> Set. -Variable leA : A -> A -> Prop. -Variable leB : forall x:A, B x -> B x -> Prop. + Variable A : Set. + Variable B : A -> Set. + Variable leA : A -> A -> Prop. + Variable leB : forall x:A, B x -> B x -> Prop. -Inductive lexprod : sigS B -> sigS B -> Prop := - | left_lex : + Inductive lexprod : sigS B -> sigS B -> Prop := + | left_lex : forall (x x':A) (y:B x) (y':B x'), leA x x' -> lexprod (existS B x y) (existS B x' y') - | right_lex : + | right_lex : forall (x:A) (y y':B x), leB x y y' -> lexprod (existS B x y) (existS B x y'). End Lexicographic_Product. @@ -117,9 +117,9 @@ Section Symmetric_Product. Inductive symprod : A * B -> A * B -> Prop := | left_sym : - forall x x':A, leA x x' -> forall y:B, symprod (x, y) (x', y) + forall x x':A, leA x x' -> forall y:B, symprod (x, y) (x', y) | right_sym : - forall y y':B, leB y y' -> forall x:A, symprod (x, y) (x, y'). + forall y y':B, leB y y' -> forall x:A, symprod (x, y) (x, y'). End Symmetric_Product. @@ -131,34 +131,34 @@ Section Swap. Inductive swapprod : A * A -> A * A -> Prop := | sp_noswap : forall x x':A * A, symprod A A R R x x' -> swapprod x x' | sp_swap : - forall (x y:A) (p:A * A), - symprod A A R R (x, y) p -> swapprod (y, x) p. + forall (x y:A) (p:A * A), + symprod A A R R (x, y) p -> swapprod (y, x) p. End Swap. Section Lexicographic_Exponentiation. - -Variable A : Set. -Variable leA : A -> A -> Prop. -Let Nil := nil (A:=A). -Let List := list A. - -Inductive Ltl : List -> List -> Prop := - | Lt_nil : forall (a:A) (x:List), Ltl Nil (a :: x) - | Lt_hd : forall a b:A, leA a b -> forall x y:list A, Ltl (a :: x) (b :: y) - | Lt_tl : forall (a:A) (x y:List), Ltl x y -> Ltl (a :: x) (a :: y). - - -Inductive Desc : List -> Prop := - | d_nil : Desc Nil - | d_one : forall x:A, Desc (x :: Nil) - | d_conc : + + Variable A : Set. + Variable leA : A -> A -> Prop. + Let Nil := nil (A:=A). + Let List := list A. + + Inductive Ltl : List -> List -> Prop := + | Lt_nil : forall (a:A) (x:List), Ltl Nil (a :: x) + | Lt_hd : forall a b:A, leA a b -> forall x y:list A, Ltl (a :: x) (b :: y) + | Lt_tl : forall (a:A) (x y:List), Ltl x y -> Ltl (a :: x) (a :: y). + + + Inductive Desc : List -> Prop := + | d_nil : Desc Nil + | d_one : forall x:A, Desc (x :: Nil) + | d_conc : forall (x y:A) (l:List), leA x y -> Desc (l ++ y :: Nil) -> Desc ((l ++ y :: Nil) ++ x :: Nil). -Definition Pow : Set := sig Desc. - -Definition lex_exp (a b:Pow) : Prop := Ltl (proj1_sig a) (proj1_sig b). + Definition Pow : Set := sig Desc. + + Definition lex_exp (a b:Pow) : Prop := Ltl (proj1_sig a) (proj1_sig b). End Lexicographic_Exponentiation. diff --git a/theories/Relations/Relations.v b/theories/Relations/Relations.v index 2df0317b..9b2f4057 100644 --- a/theories/Relations/Relations.v +++ b/theories/Relations/Relations.v @@ -6,23 +6,26 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Relations.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Relations.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Export Relation_Definitions. Require Export Relation_Operators. Require Export Operators_Properties. Lemma inverse_image_of_equivalence : - forall (A B:Set) (f:A -> B) (r:relation B), - equivalence B r -> equivalence A (fun x y:A => r (f x) (f y)). -intros; split; elim H; red in |- *; auto. -intros _ equiv_trans _ x y z H0 H1; apply equiv_trans with (f y); assumption. + forall (A B:Set) (f:A -> B) (r:relation B), + equivalence B r -> equivalence A (fun x y:A => r (f x) (f y)). +Proof. + intros; split; elim H; red in |- *; auto. + intros _ equiv_trans _ x y z H0 H1; apply equiv_trans with (f y); assumption. Qed. Lemma inverse_image_of_eq : - forall (A B:Set) (f:A -> B), equivalence A (fun x y:A => f x = f y). -split; red in |- *; - [ (* reflexivity *) reflexivity - | (* transitivity *) intros; transitivity (f y); assumption - | (* symmetry *) intros; symmetry in |- *; assumption ]. -Qed.
\ No newline at end of file + forall (A B:Set) (f:A -> B), equivalence A (fun x y:A => f x = f y). +Proof. + split; red in |- *; + [ (* reflexivity *) reflexivity + | (* transitivity *) intros; transitivity (f y); assumption + | (* symmetry *) intros; symmetry in |- *; assumption ]. +Qed. + diff --git a/theories/Relations/Rstar.v b/theories/Relations/Rstar.v index 4e62d73a..91d2aaa4 100644 --- a/theories/Relations/Rstar.v +++ b/theories/Relations/Rstar.v @@ -6,82 +6,89 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Rstar.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Rstar.v 9245 2006-10-17 12:53:34Z notin $ i*) (** Properties of a binary relation [R] on type [A] *) Section Rstar. + + Variable A : Type. + Variable R : A -> A -> Prop. -Variable A : Type. -Variable R : A -> A -> Prop. - -(** Definition of the reflexive-transitive closure [R*] of [R] *) -(** Smallest reflexive [P] containing [R o P] *) - -Definition Rstar (x y:A) := - forall P:A -> A -> Prop, - (forall u:A, P u u) -> (forall u v w:A, R u v -> P v w -> P u w) -> P x y. + (** Definition of the reflexive-transitive closure [R*] of [R] *) + (** Smallest reflexive [P] containing [R o P] *) -Theorem Rstar_reflexive : forall x:A, Rstar x x. - Proof - fun (x:A) (P:A -> A -> Prop) (h1:forall u:A, P u u) - (h2:forall u v w:A, R u v -> P v w -> P u w) => - h1 x. + Definition Rstar (x y:A) := + forall P:A -> A -> Prop, + (forall u:A, P u u) -> (forall u v w:A, R u v -> P v w -> P u w) -> P x y. -Theorem Rstar_R : forall x y z:A, R x y -> Rstar y z -> Rstar x z. - Proof - fun (x y z:A) (t1:R x y) (t2:Rstar y z) (P:A -> A -> Prop) - (h1:forall u:A, P u u) (h2:forall u v w:A, R u v -> P v w -> P u w) => - h2 x y z t1 (t2 P h1 h2). + Theorem Rstar_reflexive : forall x:A, Rstar x x. + Proof. + unfold Rstar. intros x P P_refl RoP. apply P_refl. + Qed. + + Theorem Rstar_R : forall x y z:A, R x y -> Rstar y z -> Rstar x z. + Proof. + intros x y z R_xy Rstar_yz. + unfold Rstar. + intros P P_refl RoP. apply RoP with (v:=y). + assumption. + apply Rstar_yz; assumption. + Qed. + + (** We conclude with transitivity of [Rstar] : *) + + Theorem Rstar_transitive : + forall x y z:A, Rstar x y -> Rstar y z -> Rstar x z. + Proof. + intros x y z Rstar_xy; unfold Rstar in Rstar_xy. + apply Rstar_xy; trivial. + intros u v w R_uv fz Rstar_wz. + apply Rstar_R with (y:=v); auto. + Qed. + + (** Another characterization of [R*] *) + (** Smallest reflexive [P] containing [R o R*] *) + + Definition Rstar' (x y:A) := + forall P:A -> A -> Prop, + P x x -> (forall u:A, R x u -> Rstar u y -> P x y) -> P x y. + + Theorem Rstar'_reflexive : forall x:A, Rstar' x x. + Proof. + unfold Rstar'; intros; assumption. + Qed. -(** We conclude with transitivity of [Rstar] : *) - -Theorem Rstar_transitive : - forall x y z:A, Rstar x y -> Rstar y z -> Rstar x z. - Proof - fun (x y z:A) (h:Rstar x y) => - h (fun u v:A => Rstar v z -> Rstar u z) (fun (u:A) (t:Rstar u z) => t) - (fun (u v w:A) (t1:R u v) (t2:Rstar w z -> Rstar v z) - (t3:Rstar w z) => Rstar_R u v z t1 (t2 t3)). - -(** Another characterization of [R*] *) -(** Smallest reflexive [P] containing [R o R*] *) - -Definition Rstar' (x y:A) := - forall P:A -> A -> Prop, - P x x -> (forall u:A, R x u -> Rstar u y -> P x y) -> P x y. - -Theorem Rstar'_reflexive : forall x:A, Rstar' x x. - Proof - fun (x:A) (P:A -> A -> Prop) (h:P x x) - (h':forall u:A, R x u -> Rstar u x -> P x x) => h. + Theorem Rstar'_R : forall x y z:A, R x z -> Rstar z y -> Rstar' x y. + Proof. + unfold Rstar'. intros x y z Rxz Rstar_zy P Pxx RoP. + apply RoP with (u:=z); trivial. + Qed. -Theorem Rstar'_R : forall x y z:A, R x z -> Rstar z y -> Rstar' x y. - Proof - fun (x y z:A) (t1:R x z) (t2:Rstar z y) (P:A -> A -> Prop) - (h1:P x x) (h2:forall u:A, R x u -> Rstar u y -> P x y) => - h2 z t1 t2. + (** Equivalence of the two definitions: *) + + Theorem Rstar'_Rstar : forall x y:A, Rstar' x y -> Rstar x y. + Proof. + intros x z Rstar'_xz; unfold Rstar' in Rstar'_xz. + apply Rstar'_xz. + exact (Rstar_reflexive x). + intro y; generalize x y z; exact Rstar_R. + Qed. -(** Equivalence of the two definitions: *) - -Theorem Rstar'_Rstar : forall x y:A, Rstar' x y -> Rstar x y. - Proof - fun (x y:A) (h:Rstar' x y) => - h Rstar (Rstar_reflexive x) (fun u:A => Rstar_R x u y). + Theorem Rstar_Rstar' : forall x y:A, Rstar x y -> Rstar' x y. + Proof. + intros. + apply H. + exact Rstar'_reflexive. + intros u v w R_uv Rs'_vw. apply Rstar'_R with (z:=v). + assumption. + apply Rstar'_Rstar; assumption. + Qed. + + (** Property of Commutativity of two relations *) -Theorem Rstar_Rstar' : forall x y:A, Rstar x y -> Rstar' x y. - Proof - fun (x y:A) (h:Rstar x y) => - h Rstar' (fun u:A => Rstar'_reflexive u) - (fun (u v w:A) (h1:R u v) (h2:Rstar' v w) => - Rstar'_R u w v h1 (Rstar'_Rstar v w h2)). - - -(** Property of Commutativity of two relations *) - -Definition commut (A:Set) (R1 R2:A -> A -> Prop) := - forall x y:A, - R1 y x -> forall z:A, R2 z y -> exists2 y' : A, R2 y' x & R1 z y'. - + Definition commut (A:Set) (R1 R2:A -> A -> Prop) := + forall x y:A, + R1 y x -> forall z:A, R2 z y -> exists2 y' : A, R2 y' x & R1 z y'. End Rstar. diff --git a/theories/Setoids/Setoid.v b/theories/Setoids/Setoid.v index b670fc19..84af7d5d 100644 --- a/theories/Setoids/Setoid.v +++ b/theories/Setoids/Setoid.v @@ -7,13 +7,13 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Setoid.v 8866 2006-05-28 16:21:04Z herbelin $: i*) +(*i $Id: Setoid.v 9245 2006-10-17 12:53:34Z notin $: i*) Require Export Relation_Definitions. Set Implicit Arguments. -(* DEFINITIONS OF Relation_Class AND n-ARY Morphism_Theory *) +(** * Definitions of [Relation_Class] and n-ary [Morphism_Theory] *) (* X will be used to distinguish covariant arguments whose type is an *) (* Asymmetric* relation from contravariant arguments of the same type *) @@ -46,50 +46,50 @@ Inductive Areflexive_Relation_Class : Type := Implicit Type Hole Out: Relation_Class. Definition relation_class_of_argument_class : Argument_Class -> Relation_Class. - destruct 1. - exact (SymmetricReflexive _ s r). - exact (AsymmetricReflexive tt r). - exact (SymmetricAreflexive _ s). - exact (AsymmetricAreflexive tt Aeq). - exact (Leibniz _ T). + destruct 1. + exact (SymmetricReflexive _ s r). + exact (AsymmetricReflexive tt r). + exact (SymmetricAreflexive _ s). + exact (AsymmetricAreflexive tt Aeq). + exact (Leibniz _ T). Defined. Definition carrier_of_relation_class : forall X, X_Relation_Class X -> Type. - destruct 1. - exact A. - exact A. - exact A. - exact A. - exact T. + destruct 1. + exact A. + exact A. + exact A. + exact A. + exact T. Defined. Definition relation_of_relation_class : - forall X R, @carrier_of_relation_class X R -> carrier_of_relation_class R -> Prop. - destruct R. - exact Aeq. - exact Aeq. - exact Aeq. - exact Aeq. - exact (@eq T). + forall X R, @carrier_of_relation_class X R -> carrier_of_relation_class R -> Prop. + destruct R. + exact Aeq. + exact Aeq. + exact Aeq. + exact Aeq. + exact (@eq T). Defined. Lemma about_carrier_of_relation_class_and_relation_class_of_argument_class : - forall R, - carrier_of_relation_class (relation_class_of_argument_class R) = - carrier_of_relation_class R. - destruct R; reflexivity. - Defined. + forall R, + carrier_of_relation_class (relation_class_of_argument_class R) = + carrier_of_relation_class R. + destruct R; reflexivity. +Defined. Inductive nelistT (A : Type) : Type := singl : A -> nelistT A - | cons : A -> nelistT A -> nelistT A. + | necons : A -> nelistT A -> nelistT A. Definition Arguments := nelistT Argument_Class. Implicit Type In: Arguments. Definition function_type_of_morphism_signature : - Arguments -> Relation_Class -> Type. + Arguments -> Relation_Class -> Type. intros In Out. induction In. exact (carrier_of_relation_class a -> carrier_of_relation_class Out). @@ -97,12 +97,12 @@ Definition function_type_of_morphism_signature : Defined. Definition make_compatibility_goal_aux: - forall In Out - (f g: function_type_of_morphism_signature In Out), Prop. - intros; induction In; simpl in f, g. - induction a; simpl in f, g. - exact (forall x1 x2, Aeq x1 x2 -> relation_of_relation_class Out (f x1) (g x2)). - destruct x. + forall In Out + (f g: function_type_of_morphism_signature In Out), Prop. + intros; induction In; simpl in f, g. + induction a; simpl in f, g. + exact (forall x1 x2, Aeq x1 x2 -> relation_of_relation_class Out (f x1) (g x2)). + destruct x. exact (forall x1 x2, Aeq x1 x2 -> relation_of_relation_class Out (f x1) (g x2)). exact (forall x1 x2, Aeq x2 x1 -> relation_of_relation_class Out (f x1) (g x2)). exact (forall x1 x2, Aeq x1 x2 -> relation_of_relation_class Out (f x1) (g x2)). @@ -113,35 +113,58 @@ Definition make_compatibility_goal_aux: induction a; simpl in f, g. exact (forall x1 x2, Aeq x1 x2 -> IHIn (f x1) (g x2)). destruct x. - exact (forall x1 x2, Aeq x1 x2 -> IHIn (f x1) (g x2)). - exact (forall x1 x2, Aeq x2 x1 -> IHIn (f x1) (g x2)). + exact (forall x1 x2, Aeq x1 x2 -> IHIn (f x1) (g x2)). + exact (forall x1 x2, Aeq x2 x1 -> IHIn (f x1) (g x2)). exact (forall x1 x2, Aeq x1 x2 -> IHIn (f x1) (g x2)). destruct x. - exact (forall x1 x2, Aeq x1 x2 -> IHIn (f x1) (g x2)). - exact (forall x1 x2, Aeq x2 x1 -> IHIn (f x1) (g x2)). + exact (forall x1 x2, Aeq x1 x2 -> IHIn (f x1) (g x2)). + exact (forall x1 x2, Aeq x2 x1 -> IHIn (f x1) (g x2)). exact (forall x, IHIn (f x) (g x)). Defined. Definition make_compatibility_goal := - (fun In Out f => make_compatibility_goal_aux In Out f f). + (fun In Out f => make_compatibility_goal_aux In Out f f). Record Morphism_Theory In Out : Type := - {Function : function_type_of_morphism_signature In Out; - Compat : make_compatibility_goal In Out Function}. + { Function : function_type_of_morphism_signature In Out; + Compat : make_compatibility_goal In Out Function }. + +(** The [iff] relation class *) + +Definition Iff_Relation_Class : Relation_Class. + eapply (@SymmetricReflexive unit _ iff). + exact iff_sym. + exact iff_refl. +Defined. + +(** The [impl] relation class *) + +Definition impl (A B: Prop) := A -> B. + +Theorem impl_refl: reflexive _ impl. +Proof. + hnf; unfold impl; tauto. +Qed. + +Definition Impl_Relation_Class : Relation_Class. + eapply (@AsymmetricReflexive unit tt _ impl). + exact impl_refl. +Defined. + +(** Every function is a morphism from Leibniz+ to Leibniz *) Definition list_of_Leibniz_of_list_of_types: nelistT Type -> Arguments. induction 1. exact (singl (Leibniz _ a)). - exact (cons (Leibniz _ a) IHX). + exact (necons (Leibniz _ a) IHX). Defined. -(* every function is a morphism from Leibniz+ to Leibniz *) Definition morphism_theory_of_function : - forall (In: nelistT Type) (Out: Type), - let In' := list_of_Leibniz_of_list_of_types In in - let Out' := Leibniz _ Out in - function_type_of_morphism_signature In' Out' -> - Morphism_Theory In' Out'. + forall (In: nelistT Type) (Out: Type), + let In' := list_of_Leibniz_of_list_of_types In in + let Out' := Leibniz _ Out in + function_type_of_morphism_signature In' Out' -> + Morphism_Theory In' Out'. intros. exists X. induction In; unfold make_compatibility_goal; simpl. @@ -149,33 +172,26 @@ Definition morphism_theory_of_function : intro; apply (IHIn (X x)). Defined. -(* THE iff RELATION CLASS *) - -Definition Iff_Relation_Class : Relation_Class. - eapply (@SymmetricReflexive unit _ iff). - exact iff_sym. - exact iff_refl. -Defined. - -(* THE impl RELATION CLASS *) +(** Every predicate is a morphism from Leibniz+ to Iff_Relation_Class *) -Definition impl (A B: Prop) := A -> B. - -Theorem impl_refl: reflexive _ impl. - hnf; unfold impl; tauto. -Qed. - -Definition Impl_Relation_Class : Relation_Class. - eapply (@AsymmetricReflexive unit tt _ impl). - exact impl_refl. +Definition morphism_theory_of_predicate : + forall (In: nelistT Type), + let In' := list_of_Leibniz_of_list_of_types In in + function_type_of_morphism_signature In' Iff_Relation_Class -> + Morphism_Theory In' Iff_Relation_Class. + intros. + exists X. + induction In; unfold make_compatibility_goal; simpl. + intro; apply iff_refl. + intro; apply (IHIn (X x)). Defined. -(* UTILITY FUNCTIONS TO PROVE THAT EVERY TRANSITIVE RELATION IS A MORPHISM *) +(** * Utility functions to prove that every transitive relation is a morphism *) Definition equality_morphism_of_symmetric_areflexive_transitive_relation: forall (A: Type)(Aeq: relation A)(sym: symmetric _ Aeq)(trans: transitive _ Aeq), let ASetoidClass := SymmetricAreflexive _ sym in - (Morphism_Theory (cons ASetoidClass (singl ASetoidClass)) Iff_Relation_Class). + (Morphism_Theory (necons ASetoidClass (singl ASetoidClass)) Iff_Relation_Class). intros. exists Aeq. unfold make_compatibility_goal; simpl; split; eauto. @@ -184,7 +200,7 @@ Defined. Definition equality_morphism_of_symmetric_reflexive_transitive_relation: forall (A: Type)(Aeq: relation A)(refl: reflexive _ Aeq)(sym: symmetric _ Aeq) (trans: transitive _ Aeq), let ASetoidClass := SymmetricReflexive _ sym refl in - (Morphism_Theory (cons ASetoidClass (singl ASetoidClass)) Iff_Relation_Class). + (Morphism_Theory (necons ASetoidClass (singl ASetoidClass)) Iff_Relation_Class). intros. exists Aeq. unfold make_compatibility_goal; simpl; split; eauto. @@ -194,7 +210,7 @@ Definition equality_morphism_of_asymmetric_areflexive_transitive_relation: forall (A: Type)(Aeq: relation A)(trans: transitive _ Aeq), let ASetoidClass1 := AsymmetricAreflexive Contravariant Aeq in let ASetoidClass2 := AsymmetricAreflexive Covariant Aeq in - (Morphism_Theory (cons ASetoidClass1 (singl ASetoidClass2)) Impl_Relation_Class). + (Morphism_Theory (necons ASetoidClass1 (singl ASetoidClass2)) Impl_Relation_Class). intros. exists Aeq. unfold make_compatibility_goal; simpl; unfold impl; eauto. @@ -204,120 +220,154 @@ Definition equality_morphism_of_asymmetric_reflexive_transitive_relation: forall (A: Type)(Aeq: relation A)(refl: reflexive _ Aeq)(trans: transitive _ Aeq), let ASetoidClass1 := AsymmetricReflexive Contravariant refl in let ASetoidClass2 := AsymmetricReflexive Covariant refl in - (Morphism_Theory (cons ASetoidClass1 (singl ASetoidClass2)) Impl_Relation_Class). + (Morphism_Theory (necons ASetoidClass1 (singl ASetoidClass2)) Impl_Relation_Class). intros. exists Aeq. unfold make_compatibility_goal; simpl; unfold impl; eauto. Defined. -(* iff AS A RELATION *) +(** * A few examples on [iff] *) -Add Relation Prop iff - reflexivity proved by iff_refl - symmetry proved by iff_sym - transitivity proved by iff_trans - as iff_relation. +(** [iff] as a relation *) -(* every predicate is morphism from Leibniz+ to Iff_Relation_Class *) -Definition morphism_theory_of_predicate : - forall (In: nelistT Type), - let In' := list_of_Leibniz_of_list_of_types In in - function_type_of_morphism_signature In' Iff_Relation_Class -> - Morphism_Theory In' Iff_Relation_Class. - intros. - exists X. - induction In; unfold make_compatibility_goal; simpl. - intro; apply iff_refl. - intro; apply (IHIn (X x)). -Defined. +Add Relation Prop iff + reflexivity proved by iff_refl + symmetry proved by iff_sym + transitivity proved by iff_trans +as iff_relation. -(* impl AS A RELATION *) +(** [impl] as a relation *) Theorem impl_trans: transitive _ impl. - hnf; unfold impl; tauto. +Proof. + hnf; unfold impl; tauto. Qed. Add Relation Prop impl - reflexivity proved by impl_refl - transitivity proved by impl_trans - as impl_relation. + reflexivity proved by impl_refl + transitivity proved by impl_trans +as impl_relation. + +(** [impl] is a morphism *) + +Add Morphism impl with signature iff ==> iff ==> iff as Impl_Morphism. +Proof. + unfold impl; tauto. +Qed. + +(** [and] is a morphism *) + +Add Morphism and with signature iff ==> iff ==> iff as And_Morphism. + tauto. +Qed. + +(** [or] is a morphism *) -(* THE CIC PART OF THE REFLEXIVE TACTIC (SETOID REWRITE) *) +Add Morphism or with signature iff ==> iff ==> iff as Or_Morphism. +Proof. + tauto. +Qed. + +(** [not] is a morphism *) + +Add Morphism not with signature iff ==> iff as Not_Morphism. +Proof. + tauto. +Qed. + +(** The same examples on [impl] *) + +Add Morphism and with signature impl ++> impl ++> impl as And_Morphism2. +Proof. + unfold impl; tauto. +Qed. + +Add Morphism or with signature impl ++> impl ++> impl as Or_Morphism2. +Proof. + unfold impl; tauto. +Qed. + +Add Morphism not with signature impl --> impl as Not_Morphism2. +Proof. + unfold impl; tauto. +Qed. + +(** * The CIC part of the reflexive tactic ([setoid_rewrite]) *) Inductive rewrite_direction : Type := - Left2Right - | Right2Left. + | Left2Right + | Right2Left. Implicit Type dir: rewrite_direction. Definition variance_of_argument_class : Argument_Class -> option variance. - destruct 1. - exact None. - exact (Some v). - exact None. - exact (Some v). - exact None. + destruct 1. + exact None. + exact (Some v). + exact None. + exact (Some v). + exact None. Defined. Definition opposite_direction := - fun dir => - match dir with - Left2Right => Right2Left - | Right2Left => Left2Right + fun dir => + match dir with + | Left2Right => Right2Left + | Right2Left => Left2Right end. Lemma opposite_direction_idempotent: - forall dir, (opposite_direction (opposite_direction dir)) = dir. + forall dir, (opposite_direction (opposite_direction dir)) = dir. +Proof. destruct dir; reflexivity. Qed. Inductive check_if_variance_is_respected : - option variance -> rewrite_direction -> rewrite_direction -> Prop -:= - MSNone : forall dir dir', check_if_variance_is_respected None dir dir' - | MSCovariant : forall dir, check_if_variance_is_respected (Some Covariant) dir dir - | MSContravariant : - forall dir, + option variance -> rewrite_direction -> rewrite_direction -> Prop := + | MSNone : forall dir dir', check_if_variance_is_respected None dir dir' + | MSCovariant : forall dir, check_if_variance_is_respected (Some Covariant) dir dir + | MSContravariant : + forall dir, check_if_variance_is_respected (Some Contravariant) dir (opposite_direction dir). Definition relation_class_of_reflexive_relation_class: - Reflexive_Relation_Class -> Relation_Class. - induction 1. - exact (SymmetricReflexive _ s r). - exact (AsymmetricReflexive tt r). - exact (Leibniz _ T). + Reflexive_Relation_Class -> Relation_Class. + induction 1. + exact (SymmetricReflexive _ s r). + exact (AsymmetricReflexive tt r). + exact (Leibniz _ T). Defined. Definition relation_class_of_areflexive_relation_class: - Areflexive_Relation_Class -> Relation_Class. - induction 1. - exact (SymmetricAreflexive _ s). - exact (AsymmetricAreflexive tt Aeq). + Areflexive_Relation_Class -> Relation_Class. + induction 1. + exact (SymmetricAreflexive _ s). + exact (AsymmetricAreflexive tt Aeq). Defined. Definition carrier_of_reflexive_relation_class := - fun R => carrier_of_relation_class (relation_class_of_reflexive_relation_class R). + fun R => carrier_of_relation_class (relation_class_of_reflexive_relation_class R). Definition carrier_of_areflexive_relation_class := - fun R => carrier_of_relation_class (relation_class_of_areflexive_relation_class R). + fun R => carrier_of_relation_class (relation_class_of_areflexive_relation_class R). Definition relation_of_areflexive_relation_class := - fun R => relation_of_relation_class (relation_class_of_areflexive_relation_class R). + fun R => relation_of_relation_class (relation_class_of_areflexive_relation_class R). Inductive Morphism_Context Hole dir : Relation_Class -> rewrite_direction -> Type := - App : - forall In Out dir', - Morphism_Theory In Out -> Morphism_Context_List Hole dir dir' In -> - Morphism_Context Hole dir Out dir' + | App : + forall In Out dir', + Morphism_Theory In Out -> Morphism_Context_List Hole dir dir' In -> + Morphism_Context Hole dir Out dir' | ToReplace : Morphism_Context Hole dir Hole dir | ToKeep : - forall S dir', + forall S dir', carrier_of_reflexive_relation_class S -> - Morphism_Context Hole dir (relation_class_of_reflexive_relation_class S) dir' - | ProperElementToKeep : - forall S dir' (x: carrier_of_areflexive_relation_class S), + Morphism_Context Hole dir (relation_class_of_reflexive_relation_class S) dir' + | ProperElementToKeep : + forall S dir' (x: carrier_of_areflexive_relation_class S), relation_of_areflexive_relation_class S x x -> - Morphism_Context Hole dir (relation_class_of_areflexive_relation_class S) dir' + Morphism_Context Hole dir (relation_class_of_areflexive_relation_class S) dir' with Morphism_Context_List Hole dir : rewrite_direction -> Arguments -> Type := @@ -331,53 +381,53 @@ with Morphism_Context_List Hole dir : check_if_variance_is_respected (variance_of_argument_class S) dir' dir'' -> Morphism_Context Hole dir (relation_class_of_argument_class S) dir' -> Morphism_Context_List Hole dir dir'' L -> - Morphism_Context_List Hole dir dir'' (cons S L). + Morphism_Context_List Hole dir dir'' (necons S L). Scheme Morphism_Context_rect2 := Induction for Morphism_Context Sort Type with Morphism_Context_List_rect2 := Induction for Morphism_Context_List Sort Type. Definition product_of_arguments : Arguments -> Type. - induction 1. - exact (carrier_of_relation_class a). - exact (prod (carrier_of_relation_class a) IHX). + induction 1. + exact (carrier_of_relation_class a). + exact (prod (carrier_of_relation_class a) IHX). Defined. Definition get_rewrite_direction: rewrite_direction -> Argument_Class -> rewrite_direction. - intros dir R. -destruct (variance_of_argument_class R). - destruct v. - exact dir. (* covariant *) - exact (opposite_direction dir). (* contravariant *) - exact dir. (* symmetric relation *) + intros dir R. + destruct (variance_of_argument_class R). + destruct v. + exact dir. (* covariant *) + exact (opposite_direction dir). (* contravariant *) + exact dir. (* symmetric relation *) Defined. Definition directed_relation_of_relation_class: - forall dir (R: Relation_Class), - carrier_of_relation_class R -> carrier_of_relation_class R -> Prop. - destruct 1. - exact (@relation_of_relation_class unit). - intros; exact (relation_of_relation_class _ X0 X). + forall dir (R: Relation_Class), + carrier_of_relation_class R -> carrier_of_relation_class R -> Prop. + destruct 1. + exact (@relation_of_relation_class unit). + intros; exact (relation_of_relation_class _ X0 X). Defined. Definition directed_relation_of_argument_class: - forall dir (R: Argument_Class), - carrier_of_relation_class R -> carrier_of_relation_class R -> Prop. + forall dir (R: Argument_Class), + carrier_of_relation_class R -> carrier_of_relation_class R -> Prop. intros dir R. rewrite <- - (about_carrier_of_relation_class_and_relation_class_of_argument_class R). + (about_carrier_of_relation_class_and_relation_class_of_argument_class R). exact (directed_relation_of_relation_class dir (relation_class_of_argument_class R)). Defined. Definition relation_of_product_of_arguments: - forall dir In, - product_of_arguments In -> product_of_arguments In -> Prop. - induction In. - simpl. - exact (directed_relation_of_argument_class (get_rewrite_direction dir a) a). - - simpl; intros. - destruct X; destruct X0. + forall dir In, + product_of_arguments In -> product_of_arguments In -> Prop. + induction In. + simpl. + exact (directed_relation_of_argument_class (get_rewrite_direction dir a) a). + + simpl; intros. + destruct X; destruct X0. apply and. exact (directed_relation_of_argument_class (get_rewrite_direction dir a) a c c0). @@ -385,32 +435,32 @@ Definition relation_of_product_of_arguments: Defined. Definition apply_morphism: - forall In Out (m: function_type_of_morphism_signature In Out) - (args: product_of_arguments In), carrier_of_relation_class Out. - intros. - induction In. - exact (m args). - simpl in m, args. - destruct args. - exact (IHIn (m c) p). + forall In Out (m: function_type_of_morphism_signature In Out) + (args: product_of_arguments In), carrier_of_relation_class Out. + intros. + induction In. + exact (m args). + simpl in m, args. + destruct args. + exact (IHIn (m c) p). Defined. Theorem apply_morphism_compatibility_Right2Left: - forall In Out (m1 m2: function_type_of_morphism_signature In Out) - (args1 args2: product_of_arguments In), - make_compatibility_goal_aux _ _ m1 m2 -> - relation_of_product_of_arguments Right2Left _ args1 args2 -> - directed_relation_of_relation_class Right2Left _ - (apply_morphism _ _ m2 args1) - (apply_morphism _ _ m1 args2). + forall In Out (m1 m2: function_type_of_morphism_signature In Out) + (args1 args2: product_of_arguments In), + make_compatibility_goal_aux _ _ m1 m2 -> + relation_of_product_of_arguments Right2Left _ args1 args2 -> + directed_relation_of_relation_class Right2Left _ + (apply_morphism _ _ m2 args1) + (apply_morphism _ _ m1 args2). induction In; intros. simpl in m1, m2, args1, args2, H0 |- *. destruct a; simpl in H; hnf in H0. - apply H; exact H0. - destruct v; simpl in H0; apply H; exact H0. - apply H; exact H0. - destruct v; simpl in H0; apply H; exact H0. - rewrite H0; apply H; exact H0. + apply H; exact H0. + destruct v; simpl in H0; apply H; exact H0. + apply H; exact H0. + destruct v; simpl in H0; apply H; exact H0. + rewrite H0; apply H; exact H0. simpl in m1, m2, args1, args2, H0 |- *. destruct args1; destruct args2; simpl. @@ -443,46 +493,47 @@ Theorem apply_morphism_compatibility_Right2Left: Qed. Theorem apply_morphism_compatibility_Left2Right: - forall In Out (m1 m2: function_type_of_morphism_signature In Out) - (args1 args2: product_of_arguments In), - make_compatibility_goal_aux _ _ m1 m2 -> - relation_of_product_of_arguments Left2Right _ args1 args2 -> - directed_relation_of_relation_class Left2Right _ - (apply_morphism _ _ m1 args1) - (apply_morphism _ _ m2 args2). + forall In Out (m1 m2: function_type_of_morphism_signature In Out) + (args1 args2: product_of_arguments In), + make_compatibility_goal_aux _ _ m1 m2 -> + relation_of_product_of_arguments Left2Right _ args1 args2 -> + directed_relation_of_relation_class Left2Right _ + (apply_morphism _ _ m1 args1) + (apply_morphism _ _ m2 args2). +Proof. induction In; intros. simpl in m1, m2, args1, args2, H0 |- *. destruct a; simpl in H; hnf in H0. + apply H; exact H0. + destruct v; simpl in H0; apply H; exact H0. + apply H; exact H0. + destruct v; simpl in H0; apply H; exact H0. + rewrite H0; apply H; exact H0. + + simpl in m1, m2, args1, args2, H0 |- *. + destruct args1; destruct args2; simpl. + destruct H0. + simpl in H. + destruct a; simpl in H. + apply IHIn. + apply H; exact H0. + exact H1. + destruct v. + apply IHIn. apply H; exact H0. - destruct v; simpl in H0; apply H; exact H0. - apply H; exact H0. - destruct v; simpl in H0; apply H; exact H0. - rewrite H0; apply H; exact H0. - - simpl in m1, m2, args1, args2, H0 |- *. - destruct args1; destruct args2; simpl. - destruct H0. - simpl in H. - destruct a; simpl in H. - apply IHIn. - apply H; exact H0. - exact H1. - destruct v. - apply IHIn. - apply H; exact H0. - exact H1. - apply IHIn. - apply H; exact H0. exact H1. - apply IHIn. - apply H; exact H0. - exact H1. - apply IHIn. - destruct v; simpl in H, H0; apply H; exact H0. + apply IHIn. + apply H; exact H0. + exact H1. + apply IHIn. + apply H; exact H0. exact H1. - rewrite H0; apply IHIn. - apply H. - exact H1. + apply IHIn. + destruct v; simpl in H, H0; apply H; exact H0. + exact H1. + rewrite H0; apply IHIn. + apply H. + exact H1. Qed. Definition interp : @@ -508,83 +559,84 @@ Definition interp : exact X0. Defined. -(*CSC: interp and interp_relation_class_list should be mutually defined, since +(* CSC: interp and interp_relation_class_list should be mutually defined, since the proof term of each one contains the proof term of the other one. However I cannot do that interactively (I should write the Fix by hand) *) Definition interp_relation_class_list : - forall Hole dir dir' (L: Arguments), carrier_of_relation_class Hole -> - Morphism_Context_List Hole dir dir' L -> product_of_arguments L. - intros Hole dir dir' L H t. - elim t using - (@Morphism_Context_List_rect2 Hole dir (fun S _ _ => carrier_of_relation_class S) - (fun _ L fcl => product_of_arguments L)); - intros. - exact (apply_morphism _ _ (Function m) X). - exact H. - exact c. - exact x. - simpl; - rewrite <- - (about_carrier_of_relation_class_and_relation_class_of_argument_class S); - exact X. - split. - rewrite <- - (about_carrier_of_relation_class_and_relation_class_of_argument_class S); - exact X. - exact X0. + forall Hole dir dir' (L: Arguments), carrier_of_relation_class Hole -> + Morphism_Context_List Hole dir dir' L -> product_of_arguments L. + intros Hole dir dir' L H t. + elim t using + (@Morphism_Context_List_rect2 Hole dir (fun S _ _ => carrier_of_relation_class S) + (fun _ L fcl => product_of_arguments L)); + intros. + exact (apply_morphism _ _ (Function m) X). + exact H. + exact c. + exact x. + simpl; + rewrite <- + (about_carrier_of_relation_class_and_relation_class_of_argument_class S); + exact X. + split. + rewrite <- + (about_carrier_of_relation_class_and_relation_class_of_argument_class S); + exact X. + exact X0. Defined. Theorem setoid_rewrite: - forall Hole dir Out dir' (E1 E2: carrier_of_relation_class Hole) - (E: Morphism_Context Hole dir Out dir'), - (directed_relation_of_relation_class dir Hole E1 E2) -> + forall Hole dir Out dir' (E1 E2: carrier_of_relation_class Hole) + (E: Morphism_Context Hole dir Out dir'), + (directed_relation_of_relation_class dir Hole E1 E2) -> (directed_relation_of_relation_class dir' Out (interp E1 E) (interp E2 E)). - intros. - elim E using - (@Morphism_Context_rect2 Hole dir - (fun S dir'' E => directed_relation_of_relation_class dir'' S (interp E1 E) (interp E2 E)) - (fun dir'' L fcl => +Proof. + intros. + elim E using + (@Morphism_Context_rect2 Hole dir + (fun S dir'' E => directed_relation_of_relation_class dir'' S (interp E1 E) (interp E2 E)) + (fun dir'' L fcl => relation_of_product_of_arguments dir'' _ - (interp_relation_class_list E1 fcl) - (interp_relation_class_list E2 fcl))); intros. - change (directed_relation_of_relation_class dir'0 Out0 + (interp_relation_class_list E1 fcl) + (interp_relation_class_list E2 fcl))); intros. + change (directed_relation_of_relation_class dir'0 Out0 (apply_morphism _ _ (Function m) (interp_relation_class_list E1 m0)) (apply_morphism _ _ (Function m) (interp_relation_class_list E2 m0))). - destruct dir'0. - apply apply_morphism_compatibility_Left2Right. - exact (Compat m). - exact H0. - apply apply_morphism_compatibility_Right2Left. - exact (Compat m). - exact H0. - - exact H. - - unfold interp, Morphism_Context_rect2. - (*CSC: reflexivity used here*) - destruct S; destruct dir'0; simpl; (apply r || reflexivity). - - destruct dir'0; exact r. + destruct dir'0. + apply apply_morphism_compatibility_Left2Right. + exact (Compat m). + exact H0. + apply apply_morphism_compatibility_Right2Left. + exact (Compat m). + exact H0. + + exact H. + + unfold interp, Morphism_Context_rect2. + (* CSC: reflexivity used here *) + destruct S; destruct dir'0; simpl; (apply r || reflexivity). + + destruct dir'0; exact r. destruct S; unfold directed_relation_of_argument_class; simpl in H0 |- *; - unfold get_rewrite_direction; simpl. - destruct dir'0; destruct dir''; - (exact H0 || - unfold directed_relation_of_argument_class; simpl; apply s; exact H0). - (* the following mess with generalize/clear/intros is to help Coq resolving *) - (* second order unification problems. *) - generalize m c H0; clear H0 m c; inversion c; - generalize m c; clear m c; rewrite <- H1; rewrite <- H2; intros; - (exact H3 || rewrite (opposite_direction_idempotent dir'0); apply H3). - destruct dir'0; destruct dir''; - (exact H0 || - unfold directed_relation_of_argument_class; simpl; apply s; exact H0). -(* the following mess with generalize/clear/intros is to help Coq resolving *) - (* second order unification problems. *) - generalize m c H0; clear H0 m c; inversion c; - generalize m c; clear m c; rewrite <- H1; rewrite <- H2; intros; - (exact H3 || rewrite (opposite_direction_idempotent dir'0); apply H3). - destruct dir'0; destruct dir''; (exact H0 || hnf; symmetry; exact H0). + unfold get_rewrite_direction; simpl. + destruct dir'0; destruct dir''; + (exact H0 || + unfold directed_relation_of_argument_class; simpl; apply s; exact H0). + (* the following mess with generalize/clear/intros is to help Coq resolving *) + (* second order unification problems. *) + generalize m c H0; clear H0 m c; inversion c; + generalize m c; clear m c; rewrite <- H1; rewrite <- H2; intros; + (exact H3 || rewrite (opposite_direction_idempotent dir'0); apply H3). + destruct dir'0; destruct dir''; + (exact H0 || + unfold directed_relation_of_argument_class; simpl; apply s; exact H0). + (* the following mess with generalize/clear/intros is to help Coq resolving *) + (* second order unification problems. *) + generalize m c H0; clear H0 m c; inversion c; + generalize m c; clear m c; rewrite <- H1; rewrite <- H2; intros; + (exact H3 || rewrite (opposite_direction_idempotent dir'0); apply H3). + destruct dir'0; destruct dir''; (exact H0 || hnf; symmetry; exact H0). change (directed_relation_of_argument_class (get_rewrite_direction dir'' S) S @@ -592,96 +644,57 @@ Theorem setoid_rewrite: (about_carrier_of_relation_class_and_relation_class_of_argument_class S)) (eq_rect _ (fun T : Type => T) (interp E2 m) _ (about_carrier_of_relation_class_and_relation_class_of_argument_class S)) /\ - relation_of_product_of_arguments dir'' _ + relation_of_product_of_arguments dir'' _ (interp_relation_class_list E1 m0) (interp_relation_class_list E2 m0)). - split. - clear m0 H1; destruct S; simpl in H0 |- *; unfold get_rewrite_direction; simpl. - destruct dir''; destruct dir'0; (exact H0 || hnf; apply s; exact H0). - inversion c. - rewrite <- H3; exact H0. - rewrite (opposite_direction_idempotent dir'0); exact H0. - destruct dir''; destruct dir'0; (exact H0 || hnf; apply s; exact H0). - inversion c. - rewrite <- H3; exact H0. - rewrite (opposite_direction_idempotent dir'0); exact H0. - destruct dir''; destruct dir'0; (exact H0 || hnf; symmetry; exact H0). - exact H1. -Qed. - -(* BEGIN OF UTILITY/BACKWARD COMPATIBILITY PART *) + split. + clear m0 H1; destruct S; simpl in H0 |- *; unfold get_rewrite_direction; simpl. + destruct dir''; destruct dir'0; (exact H0 || hnf; apply s; exact H0). + inversion c. + rewrite <- H3; exact H0. + rewrite (opposite_direction_idempotent dir'0); exact H0. + destruct dir''; destruct dir'0; (exact H0 || hnf; apply s; exact H0). + inversion c. + rewrite <- H3; exact H0. + rewrite (opposite_direction_idempotent dir'0); exact H0. + destruct dir''; destruct dir'0; (exact H0 || hnf; symmetry; exact H0). + exact H1. + Qed. + +(** * Miscelenous *) + +(** For backwark compatibility *) Record Setoid_Theory (A: Type) (Aeq: relation A) : Prop := - {Seq_refl : forall x:A, Aeq x x; - Seq_sym : forall x y:A, Aeq x y -> Aeq y x; - Seq_trans : forall x y z:A, Aeq x y -> Aeq y z -> Aeq x z}. - -(* END OF UTILITY/BACKWARD COMPATIBILITY PART *) - -(* A FEW EXAMPLES ON iff *) - -(* impl IS A MORPHISM *) + { Seq_refl : forall x:A, Aeq x x; + Seq_sym : forall x y:A, Aeq x y -> Aeq y x; + Seq_trans : forall x y z:A, Aeq x y -> Aeq y z -> Aeq x z }. -Add Morphism impl with signature iff ==> iff ==> iff as Impl_Morphism. -unfold impl; tauto. -Qed. - -(* and IS A MORPHISM *) - -Add Morphism and with signature iff ==> iff ==> iff as And_Morphism. - tauto. -Qed. - -(* or IS A MORPHISM *) - -Add Morphism or with signature iff ==> iff ==> iff as Or_Morphism. - tauto. -Qed. - -(* not IS A MORPHISM *) - -Add Morphism not with signature iff ==> iff as Not_Morphism. - tauto. -Qed. - -(* THE SAME EXAMPLES ON impl *) - -Add Morphism and with signature impl ++> impl ++> impl as And_Morphism2. - unfold impl; tauto. -Qed. - -Add Morphism or with signature impl ++> impl ++> impl as Or_Morphism2. - unfold impl; tauto. -Qed. - -Add Morphism not with signature impl --> impl as Not_Morphism2. - unfold impl; tauto. -Qed. - -(* FOR BACKWARD COMPATIBILITY *) Implicit Arguments Setoid_Theory []. Implicit Arguments Seq_refl []. Implicit Arguments Seq_sym []. Implicit Arguments Seq_trans []. -(* Some tactics for manipulating Setoid Theory not officially - declared as Setoid. *) +(** Some tactics for manipulating Setoid Theory not officially + declared as Setoid. *) Ltac trans_st x := match goal with - | H : Setoid_Theory _ ?eqA |- ?eqA _ _ => - apply (Seq_trans _ _ H) with x; auto - end. + | H : Setoid_Theory _ ?eqA |- ?eqA _ _ => + apply (Seq_trans _ _ H) with x; auto + end. Ltac sym_st := match goal with - | H : Setoid_Theory _ ?eqA |- ?eqA _ _ => - apply (Seq_sym _ _ H); auto - end. + | H : Setoid_Theory _ ?eqA |- ?eqA _ _ => + apply (Seq_sym _ _ H); auto + end. Ltac refl_st := match goal with - | H : Setoid_Theory _ ?eqA |- ?eqA _ _ => - apply (Seq_refl _ _ H); auto - end. + | H : Setoid_Theory _ ?eqA |- ?eqA _ _ => + apply (Seq_refl _ _ H); auto + end. Definition gen_st : forall A : Set, Setoid_Theory _ (@eq A). -Proof. constructor; congruence. Qed. - +Proof. + constructor; congruence. +Qed. + diff --git a/theories/Sets/Classical_sets.v b/theories/Sets/Classical_sets.v index 382b5d72..e6755898 100644 --- a/theories/Sets/Classical_sets.v +++ b/theories/Sets/Classical_sets.v @@ -24,109 +24,104 @@ (* in Summer 1995. Several developments by E. Ledinot were an inspiration. *) (****************************************************************************) -(*i $Id: Classical_sets.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Classical_sets.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Export Ensembles. Require Export Constructive_sets. Require Export Classical_Type. -(* Hints Unfold not . *) - Section Ensembles_classical. -Variable U : Type. - -Lemma not_included_empty_Inhabited : - forall A:Ensemble U, ~ Included U A (Empty_set U) -> Inhabited U A. -Proof. -intros A NI. -elim (not_all_ex_not U (fun x:U => ~ In U A x)). -intros x H; apply Inhabited_intro with x. -apply NNPP; auto with sets. -red in |- *; intro. -apply NI; red in |- *. -intros x H'; elim (H x); trivial with sets. -Qed. -Hint Resolve not_included_empty_Inhabited. - -Lemma not_empty_Inhabited : - forall A:Ensemble U, A <> Empty_set U -> Inhabited U A. -Proof. -intros; apply not_included_empty_Inhabited. -red in |- *; auto with sets. -Qed. - -Lemma Inhabited_Setminus : - forall X Y:Ensemble U, - Included U X Y -> ~ Included U Y X -> Inhabited U (Setminus U Y X). -Proof. -intros X Y I NI. -elim (not_all_ex_not U (fun x:U => In U Y x -> In U X x) NI). -intros x YX. -apply Inhabited_intro with x. -apply Setminus_intro. -apply not_imply_elim with (In U X x); trivial with sets. -auto with sets. -Qed. -Hint Resolve Inhabited_Setminus. - -Lemma Strict_super_set_contains_new_element : - forall X Y:Ensemble U, - Included U X Y -> X <> Y -> Inhabited U (Setminus U Y X). -Proof. -auto 7 with sets. -Qed. -Hint Resolve Strict_super_set_contains_new_element. - -Lemma Subtract_intro : - forall (A:Ensemble U) (x y:U), In U A y -> x <> y -> In U (Subtract U A x) y. -Proof. -unfold Subtract at 1 in |- *; auto with sets. -Qed. -Hint Resolve Subtract_intro. - -Lemma Subtract_inv : - forall (A:Ensemble U) (x y:U), In U (Subtract U A x) y -> In U A y /\ x <> y. -Proof. -intros A x y H'; elim H'; auto with sets. -Qed. - -Lemma Included_Strict_Included : - forall X Y:Ensemble U, Included U X Y -> Strict_Included U X Y \/ X = Y. -Proof. -intros X Y H'; try assumption. -elim (classic (X = Y)); auto with sets. -Qed. - -Lemma Strict_Included_inv : - forall X Y:Ensemble U, - Strict_Included U X Y -> Included U X Y /\ Inhabited U (Setminus U Y X). -Proof. -intros X Y H'; red in H'. -split; [ tauto | idtac ]. -elim H'; intros H'0 H'1; try exact H'1; clear H'. -apply Strict_super_set_contains_new_element; auto with sets. -Qed. - -Lemma not_SIncl_empty : - forall X:Ensemble U, ~ Strict_Included U X (Empty_set U). -Proof. -intro X; red in |- *; intro H'; try exact H'. -lapply (Strict_Included_inv X (Empty_set U)); auto with sets. -intro H'0; elim H'0; intros H'1 H'2; elim H'2; clear H'0. -intros x H'0; elim H'0. -intro H'3; elim H'3. -Qed. - -Lemma Complement_Complement : - forall A:Ensemble U, Complement U (Complement U A) = A. -Proof. -unfold Complement in |- *; intros; apply Extensionality_Ensembles; - auto with sets. -red in |- *; split; auto with sets. -red in |- *; intros; apply NNPP; auto with sets. -Qed. + Variable U : Type. + + Lemma not_included_empty_Inhabited : + forall A:Ensemble U, ~ Included U A (Empty_set U) -> Inhabited U A. + Proof. + intros A NI. + elim (not_all_ex_not U (fun x:U => ~ In U A x)). + intros x H; apply Inhabited_intro with x. + apply NNPP; auto with sets. + red in |- *; intro. + apply NI; red in |- *. + intros x H'; elim (H x); trivial with sets. + Qed. + + Lemma not_empty_Inhabited : + forall A:Ensemble U, A <> Empty_set U -> Inhabited U A. + Proof. + intros; apply not_included_empty_Inhabited. + red in |- *; auto with sets. + Qed. + + Lemma Inhabited_Setminus : + forall X Y:Ensemble U, + Included U X Y -> ~ Included U Y X -> Inhabited U (Setminus U Y X). + Proof. + intros X Y I NI. + elim (not_all_ex_not U (fun x:U => In U Y x -> In U X x) NI). + intros x YX. + apply Inhabited_intro with x. + apply Setminus_intro. + apply not_imply_elim with (In U X x); trivial with sets. + auto with sets. + Qed. + + Lemma Strict_super_set_contains_new_element : + forall X Y:Ensemble U, + Included U X Y -> X <> Y -> Inhabited U (Setminus U Y X). + Proof. + auto 7 using Inhabited_Setminus with sets. + Qed. + + Lemma Subtract_intro : + forall (A:Ensemble U) (x y:U), In U A y -> x <> y -> In U (Subtract U A x) y. + Proof. + unfold Subtract at 1 in |- *; auto with sets. + Qed. + Hint Resolve Subtract_intro : sets. + + Lemma Subtract_inv : + forall (A:Ensemble U) (x y:U), In U (Subtract U A x) y -> In U A y /\ x <> y. + Proof. + intros A x y H'; elim H'; auto with sets. + Qed. + + Lemma Included_Strict_Included : + forall X Y:Ensemble U, Included U X Y -> Strict_Included U X Y \/ X = Y. + Proof. + intros X Y H'; try assumption. + elim (classic (X = Y)); auto with sets. + Qed. + + Lemma Strict_Included_inv : + forall X Y:Ensemble U, + Strict_Included U X Y -> Included U X Y /\ Inhabited U (Setminus U Y X). + Proof. + intros X Y H'; red in H'. + split; [ tauto | idtac ]. + elim H'; intros H'0 H'1; try exact H'1; clear H'. + apply Strict_super_set_contains_new_element; auto with sets. + Qed. + + Lemma not_SIncl_empty : + forall X:Ensemble U, ~ Strict_Included U X (Empty_set U). + Proof. + intro X; red in |- *; intro H'; try exact H'. + lapply (Strict_Included_inv X (Empty_set U)); auto with sets. + intro H'0; elim H'0; intros H'1 H'2; elim H'2; clear H'0. + intros x H'0; elim H'0. + intro H'3; elim H'3. + Qed. + + Lemma Complement_Complement : + forall A:Ensemble U, Complement U (Complement U A) = A. + Proof. + unfold Complement in |- *; intros; apply Extensionality_Ensembles; + auto with sets. + red in |- *; split; auto with sets. + red in |- *; intros; apply NNPP; auto with sets. + Qed. End Ensembles_classical. -Hint Resolve Strict_super_set_contains_new_element Subtract_intro - not_SIncl_empty: sets v62.
\ No newline at end of file + Hint Resolve Strict_super_set_contains_new_element Subtract_intro + not_SIncl_empty: sets v62. diff --git a/theories/Sets/Constructive_sets.v b/theories/Sets/Constructive_sets.v index 7e4471a0..ad81316d 100644 --- a/theories/Sets/Constructive_sets.v +++ b/theories/Sets/Constructive_sets.v @@ -24,136 +24,123 @@ (* in Summer 1995. Several developments by E. Ledinot were an inspiration. *) (****************************************************************************) -(*i $Id: Constructive_sets.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Constructive_sets.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Export Ensembles. Section Ensembles_facts. -Variable U : Type. - -Lemma Extension : forall B C:Ensemble U, B = C -> Same_set U B C. -Proof. -intros B C H'; rewrite H'; auto with sets. -Qed. - -Lemma Noone_in_empty : forall x:U, ~ In U (Empty_set U) x. -Proof. -red in |- *; destruct 1. -Qed. -Hint Resolve Noone_in_empty. - -Lemma Included_Empty : forall A:Ensemble U, Included U (Empty_set U) A. -Proof. -intro; red in |- *. -intros x H; elim (Noone_in_empty x); auto with sets. -Qed. -Hint Resolve Included_Empty. - -Lemma Add_intro1 : - forall (A:Ensemble U) (x y:U), In U A y -> In U (Add U A x) y. -Proof. -unfold Add at 1 in |- *; auto with sets. -Qed. -Hint Resolve Add_intro1. - -Lemma Add_intro2 : forall (A:Ensemble U) (x:U), In U (Add U A x) x. -Proof. -unfold Add at 1 in |- *; auto with sets. -Qed. -Hint Resolve Add_intro2. - -Lemma Inhabited_add : forall (A:Ensemble U) (x:U), Inhabited U (Add U A x). -Proof. -intros A x. -apply Inhabited_intro with (x := x); auto with sets. -Qed. -Hint Resolve Inhabited_add. - -Lemma Inhabited_not_empty : - forall X:Ensemble U, Inhabited U X -> X <> Empty_set U. -Proof. -intros X H'; elim H'. -intros x H'0; red in |- *; intro H'1. -absurd (In U X x); auto with sets. -rewrite H'1; auto with sets. -Qed. -Hint Resolve Inhabited_not_empty. - -Lemma Add_not_Empty : forall (A:Ensemble U) (x:U), Add U A x <> Empty_set U. -Proof. -auto with sets. -Qed. -Hint Resolve Add_not_Empty. - -Lemma not_Empty_Add : forall (A:Ensemble U) (x:U), Empty_set U <> Add U A x. -Proof. -intros; red in |- *; intro H; generalize (Add_not_Empty A x); auto with sets. -Qed. -Hint Resolve not_Empty_Add. - -Lemma Singleton_inv : forall x y:U, In U (Singleton U x) y -> x = y. -Proof. -intros x y H'; elim H'; trivial with sets. -Qed. -Hint Resolve Singleton_inv. - -Lemma Singleton_intro : forall x y:U, x = y -> In U (Singleton U x) y. -Proof. -intros x y H'; rewrite H'; trivial with sets. -Qed. -Hint Resolve Singleton_intro. - -Lemma Union_inv : - forall (B C:Ensemble U) (x:U), In U (Union U B C) x -> In U B x \/ In U C x. -Proof. -intros B C x H'; elim H'; auto with sets. -Qed. - -Lemma Add_inv : - forall (A:Ensemble U) (x y:U), In U (Add U A x) y -> In U A y \/ x = y. -Proof. -intros A x y H'; elim H'; auto with sets. -Qed. - -Lemma Intersection_inv : - forall (B C:Ensemble U) (x:U), - In U (Intersection U B C) x -> In U B x /\ In U C x. -Proof. -intros B C x H'; elim H'; auto with sets. -Qed. -Hint Resolve Intersection_inv. - -Lemma Couple_inv : forall x y z:U, In U (Couple U x y) z -> z = x \/ z = y. -Proof. -intros x y z H'; elim H'; auto with sets. -Qed. -Hint Resolve Couple_inv. - -Lemma Setminus_intro : - forall (A B:Ensemble U) (x:U), - In U A x -> ~ In U B x -> In U (Setminus U A B) x. -Proof. -unfold Setminus at 1 in |- *; red in |- *; auto with sets. -Qed. -Hint Resolve Setminus_intro. + Variable U : Type. + + Lemma Extension : forall B C:Ensemble U, B = C -> Same_set U B C. + Proof. + intros B C H'; rewrite H'; auto with sets. + Qed. + + Lemma Noone_in_empty : forall x:U, ~ In U (Empty_set U) x. + Proof. + red in |- *; destruct 1. + Qed. + + Lemma Included_Empty : forall A:Ensemble U, Included U (Empty_set U) A. + Proof. + intro; red in |- *. + intros x H; elim (Noone_in_empty x); auto with sets. + Qed. + + Lemma Add_intro1 : + forall (A:Ensemble U) (x y:U), In U A y -> In U (Add U A x) y. + Proof. + unfold Add at 1 in |- *; auto with sets. + Qed. + + Lemma Add_intro2 : forall (A:Ensemble U) (x:U), In U (Add U A x) x. + Proof. + unfold Add at 1 in |- *; auto with sets. + Qed. + + Lemma Inhabited_add : forall (A:Ensemble U) (x:U), Inhabited U (Add U A x). + Proof. + intros A x. + apply Inhabited_intro with (x := x); auto using Add_intro2 with sets. + Qed. + + Lemma Inhabited_not_empty : + forall X:Ensemble U, Inhabited U X -> X <> Empty_set U. + Proof. + intros X H'; elim H'. + intros x H'0; red in |- *; intro H'1. + absurd (In U X x); auto with sets. + rewrite H'1; auto using Noone_in_empty with sets. + Qed. + + Lemma Add_not_Empty : forall (A:Ensemble U) (x:U), Add U A x <> Empty_set U. + Proof. + intros A x; apply Inhabited_not_empty; apply Inhabited_add. + Qed. + + Lemma not_Empty_Add : forall (A:Ensemble U) (x:U), Empty_set U <> Add U A x. + Proof. + intros; red in |- *; intro H; generalize (Add_not_Empty A x); auto with sets. + Qed. + + Lemma Singleton_inv : forall x y:U, In U (Singleton U x) y -> x = y. + Proof. + intros x y H'; elim H'; trivial with sets. + Qed. + + Lemma Singleton_intro : forall x y:U, x = y -> In U (Singleton U x) y. + Proof. + intros x y H'; rewrite H'; trivial with sets. + Qed. + + Lemma Union_inv : + forall (B C:Ensemble U) (x:U), In U (Union U B C) x -> In U B x \/ In U C x. + Proof. + intros B C x H'; elim H'; auto with sets. + Qed. + + Lemma Add_inv : + forall (A:Ensemble U) (x y:U), In U (Add U A x) y -> In U A y \/ x = y. + Proof. + intros A x y H'; induction H'. + left; assumption. + right; apply Singleton_inv; assumption. + Qed. + + Lemma Intersection_inv : + forall (B C:Ensemble U) (x:U), + In U (Intersection U B C) x -> In U B x /\ In U C x. + Proof. + intros B C x H'; elim H'; auto with sets. + Qed. + + Lemma Couple_inv : forall x y z:U, In U (Couple U x y) z -> z = x \/ z = y. + Proof. + intros x y z H'; elim H'; auto with sets. + Qed. + + Lemma Setminus_intro : + forall (A B:Ensemble U) (x:U), + In U A x -> ~ In U B x -> In U (Setminus U A B) x. + Proof. + unfold Setminus at 1 in |- *; red in |- *; auto with sets. + Qed. -Lemma Strict_Included_intro : - forall X Y:Ensemble U, Included U X Y /\ X <> Y -> Strict_Included U X Y. -Proof. -auto with sets. -Qed. -Hint Resolve Strict_Included_intro. - -Lemma Strict_Included_strict : forall X:Ensemble U, ~ Strict_Included U X X. -Proof. -intro X; red in |- *; intro H'; elim H'. -intros H'0 H'1; elim H'1; auto with sets. -Qed. -Hint Resolve Strict_Included_strict. + Lemma Strict_Included_intro : + forall X Y:Ensemble U, Included U X Y /\ X <> Y -> Strict_Included U X Y. + Proof. + auto with sets. + Qed. + + Lemma Strict_Included_strict : forall X:Ensemble U, ~ Strict_Included U X X. + Proof. + intro X; red in |- *; intro H'; elim H'. + intros H'0 H'1; elim H'1; auto with sets. + Qed. End Ensembles_facts. Hint Resolve Singleton_inv Singleton_intro Add_intro1 Add_intro2 Intersection_inv Couple_inv Setminus_intro Strict_Included_intro Strict_Included_strict Noone_in_empty Inhabited_not_empty Add_not_Empty - not_Empty_Add Inhabited_add Included_Empty: sets v62.
\ No newline at end of file + not_Empty_Add Inhabited_add Included_Empty: sets v62. diff --git a/theories/Sets/Cpo.v b/theories/Sets/Cpo.v index 0b2cf3e3..1e1b70d5 100644 --- a/theories/Sets/Cpo.v +++ b/theories/Sets/Cpo.v @@ -24,86 +24,87 @@ (* in Summer 1995. Several developments by E. Ledinot were an inspiration. *) (****************************************************************************) -(*i $Id: Cpo.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Cpo.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Export Ensembles. Require Export Relations_1. Require Export Partial_Order. Section Bounds. -Variable U : Type. -Variable D : PO U. + Variable U : Type. + Variable D : PO U. -Let C := Carrier_of U D. + Let C := Carrier_of U D. + + Let R := Rel_of U D. -Let R := Rel_of U D. - -Inductive Upper_Bound (B:Ensemble U) (x:U) : Prop := + Inductive Upper_Bound (B:Ensemble U) (x:U) : Prop := Upper_Bound_definition : - In U C x -> (forall y:U, In U B y -> R y x) -> Upper_Bound B x. + In U C x -> (forall y:U, In U B y -> R y x) -> Upper_Bound B x. -Inductive Lower_Bound (B:Ensemble U) (x:U) : Prop := + Inductive Lower_Bound (B:Ensemble U) (x:U) : Prop := Lower_Bound_definition : - In U C x -> (forall y:U, In U B y -> R x y) -> Lower_Bound B x. - -Inductive Lub (B:Ensemble U) (x:U) : Prop := + In U C x -> (forall y:U, In U B y -> R x y) -> Lower_Bound B x. + + Inductive Lub (B:Ensemble U) (x:U) : Prop := Lub_definition : - Upper_Bound B x -> (forall y:U, Upper_Bound B y -> R x y) -> Lub B x. + Upper_Bound B x -> (forall y:U, Upper_Bound B y -> R x y) -> Lub B x. -Inductive Glb (B:Ensemble U) (x:U) : Prop := + Inductive Glb (B:Ensemble U) (x:U) : Prop := Glb_definition : - Lower_Bound B x -> (forall y:U, Lower_Bound B y -> R y x) -> Glb B x. + Lower_Bound B x -> (forall y:U, Lower_Bound B y -> R y x) -> Glb B x. -Inductive Bottom (bot:U) : Prop := + Inductive Bottom (bot:U) : Prop := Bottom_definition : - In U C bot -> (forall y:U, In U C y -> R bot y) -> Bottom bot. - -Inductive Totally_ordered (B:Ensemble U) : Prop := + In U C bot -> (forall y:U, In U C y -> R bot y) -> Bottom bot. + + Inductive Totally_ordered (B:Ensemble U) : Prop := Totally_ordered_definition : - (Included U B C -> - forall x y:U, Included U (Couple U x y) B -> R x y \/ R y x) -> - Totally_ordered B. + (Included U B C -> + forall x y:U, Included U (Couple U x y) B -> R x y \/ R y x) -> + Totally_ordered B. -Definition Compatible : Relation U := - fun x y:U => - In U C x -> - In U C y -> exists z : _, In U C z /\ Upper_Bound (Couple U x y) z. - -Inductive Directed (X:Ensemble U) : Prop := - Definition_of_Directed : - Included U X C -> - Inhabited U X -> - (forall x1 x2:U, - Included U (Couple U x1 x2) X -> - exists x3 : _, In U X x3 /\ Upper_Bound (Couple U x1 x2) x3) -> - Directed X. + Definition Compatible : Relation U := + fun x y:U => + In U C x -> + In U C y -> exists z : _, In U C z /\ Upper_Bound (Couple U x y) z. -Inductive Complete : Prop := + Inductive Directed (X:Ensemble U) : Prop := + Definition_of_Directed : + Included U X C -> + Inhabited U X -> + (forall x1 x2:U, + Included U (Couple U x1 x2) X -> + exists x3 : _, In U X x3 /\ Upper_Bound (Couple U x1 x2) x3) -> + Directed X. + + Inductive Complete : Prop := Definition_of_Complete : - (exists bot : _, Bottom bot) -> - (forall X:Ensemble U, Directed X -> exists bsup : _, Lub X bsup) -> - Complete. + (exists bot : _, Bottom bot) -> + (forall X:Ensemble U, Directed X -> exists bsup : _, Lub X bsup) -> + Complete. -Inductive Conditionally_complete : Prop := + Inductive Conditionally_complete : Prop := Definition_of_Conditionally_complete : - (forall X:Ensemble U, - Included U X C -> - (exists maj : _, Upper_Bound X maj) -> - exists bsup : _, Lub X bsup) -> Conditionally_complete. + (forall X:Ensemble U, + Included U X C -> + (exists maj : _, Upper_Bound X maj) -> + exists bsup : _, Lub X bsup) -> Conditionally_complete. End Bounds. + Hint Resolve Totally_ordered_definition Upper_Bound_definition Lower_Bound_definition Lub_definition Glb_definition Bottom_definition Definition_of_Complete Definition_of_Complete Definition_of_Conditionally_complete. Section Specific_orders. -Variable U : Type. - -Record Cpo : Type := Definition_of_cpo - {PO_of_cpo : PO U; Cpo_cond : Complete U PO_of_cpo}. - -Record Chain : Type := Definition_of_chain - {PO_of_chain : PO U; - Chain_cond : Totally_ordered U PO_of_chain (Carrier_of U PO_of_chain)}. + Variable U : Type. + + Record Cpo : Type := Definition_of_cpo + {PO_of_cpo : PO U; Cpo_cond : Complete U PO_of_cpo}. + + Record Chain : Type := Definition_of_chain + {PO_of_chain : PO U; + Chain_cond : Totally_ordered U PO_of_chain (Carrier_of U PO_of_chain)}. End Specific_orders.
\ No newline at end of file diff --git a/theories/Sets/Ensembles.v b/theories/Sets/Ensembles.v index d71c96b0..c38a2fe1 100644 --- a/theories/Sets/Ensembles.v +++ b/theories/Sets/Ensembles.v @@ -24,72 +24,71 @@ (* in Summer 1995. Several developments by E. Ledinot were an inspiration. *) (****************************************************************************) -(*i $Id: Ensembles.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Ensembles.v 9245 2006-10-17 12:53:34Z notin $ i*) Section Ensembles. -Variable U : Type. - -Definition Ensemble := U -> Prop. - -Definition In (A:Ensemble) (x:U) : Prop := A x. - -Definition Included (B C:Ensemble) : Prop := forall x:U, In B x -> In C x. - -Inductive Empty_set : Ensemble :=. - -Inductive Full_set : Ensemble := + Variable U : Type. + + Definition Ensemble := U -> Prop. + + Definition In (A:Ensemble) (x:U) : Prop := A x. + + Definition Included (B C:Ensemble) : Prop := forall x:U, In B x -> In C x. + + Inductive Empty_set : Ensemble :=. + + Inductive Full_set : Ensemble := Full_intro : forall x:U, In Full_set x. (** NB: The following definition builds-in equality of elements in [U] as - Leibniz equality. + Leibniz equality. - This may have to be changed if we replace [U] by a Setoid on [U] - with its own equality [eqs], with - [In_singleton: (y: U)(eqs x y) -> (In (Singleton x) y)]. *) + This may have to be changed if we replace [U] by a Setoid on [U] + with its own equality [eqs], with + [In_singleton: (y: U)(eqs x y) -> (In (Singleton x) y)]. *) -Inductive Singleton (x:U) : Ensemble := + Inductive Singleton (x:U) : Ensemble := In_singleton : In (Singleton x) x. -Inductive Union (B C:Ensemble) : Ensemble := - | Union_introl : forall x:U, In B x -> In (Union B C) x - | Union_intror : forall x:U, In C x -> In (Union B C) x. - -Definition Add (B:Ensemble) (x:U) : Ensemble := Union B (Singleton x). + Inductive Union (B C:Ensemble) : Ensemble := + | Union_introl : forall x:U, In B x -> In (Union B C) x + | Union_intror : forall x:U, In C x -> In (Union B C) x. -Inductive Intersection (B C:Ensemble) : Ensemble := + Definition Add (B:Ensemble) (x:U) : Ensemble := Union B (Singleton x). + + Inductive Intersection (B C:Ensemble) : Ensemble := Intersection_intro : - forall x:U, In B x -> In C x -> In (Intersection B C) x. - -Inductive Couple (x y:U) : Ensemble := - | Couple_l : In (Couple x y) x - | Couple_r : In (Couple x y) y. - -Inductive Triple (x y z:U) : Ensemble := - | Triple_l : In (Triple x y z) x - | Triple_m : In (Triple x y z) y - | Triple_r : In (Triple x y z) z. - -Definition Complement (A:Ensemble) : Ensemble := fun x:U => ~ In A x. - -Definition Setminus (B C:Ensemble) : Ensemble := - fun x:U => In B x /\ ~ In C x. - -Definition Subtract (B:Ensemble) (x:U) : Ensemble := Setminus B (Singleton x). - -Inductive Disjoint (B C:Ensemble) : Prop := + forall x:U, In B x -> In C x -> In (Intersection B C) x. + + Inductive Couple (x y:U) : Ensemble := + | Couple_l : In (Couple x y) x + | Couple_r : In (Couple x y) y. + + Inductive Triple (x y z:U) : Ensemble := + | Triple_l : In (Triple x y z) x + | Triple_m : In (Triple x y z) y + | Triple_r : In (Triple x y z) z. + + Definition Complement (A:Ensemble) : Ensemble := fun x:U => ~ In A x. + + Definition Setminus (B C:Ensemble) : Ensemble := + fun x:U => In B x /\ ~ In C x. + + Definition Subtract (B:Ensemble) (x:U) : Ensemble := Setminus B (Singleton x). + + Inductive Disjoint (B C:Ensemble) : Prop := Disjoint_intro : (forall x:U, ~ In (Intersection B C) x) -> Disjoint B C. -Inductive Inhabited (B:Ensemble) : Prop := + Inductive Inhabited (B:Ensemble) : Prop := Inhabited_intro : forall x:U, In B x -> Inhabited B. + + Definition Strict_Included (B C:Ensemble) : Prop := Included B C /\ B <> C. + + Definition Same_set (B C:Ensemble) : Prop := Included B C /\ Included C B. + + (** Extensionality Axiom *) -Definition Strict_Included (B C:Ensemble) : Prop := Included B C /\ B <> C. - -Definition Same_set (B C:Ensemble) : Prop := Included B C /\ Included C B. - -(** Extensionality Axiom *) - -Axiom Extensionality_Ensembles : forall A B:Ensemble, Same_set A B -> A = B. -Hint Resolve Extensionality_Ensembles. + Axiom Extensionality_Ensembles : forall A B:Ensemble, Same_set A B -> A = B. End Ensembles. @@ -98,4 +97,4 @@ Hint Unfold In Included Same_set Strict_Included Add Setminus Subtract: sets Hint Resolve Union_introl Union_intror Intersection_intro In_singleton Couple_l Couple_r Triple_l Triple_m Triple_r Disjoint_intro - Extensionality_Ensembles: sets v62.
\ No newline at end of file + Extensionality_Ensembles: sets v62. diff --git a/theories/Sets/Finite_sets.v b/theories/Sets/Finite_sets.v index 47b41ec3..f5eae4ed 100644 --- a/theories/Sets/Finite_sets.v +++ b/theories/Sets/Finite_sets.v @@ -24,22 +24,22 @@ (* in Summer 1995. Several developments by E. Ledinot were an inspiration. *) (****************************************************************************) -(*i $Id: Finite_sets.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Finite_sets.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Ensembles. Section Ensembles_finis. -Variable U : Type. + Variable U : Type. -Inductive Finite : Ensemble U -> Prop := - | Empty_is_finite : Finite (Empty_set U) - | Union_is_finite : + Inductive Finite : Ensemble U -> Prop := + | Empty_is_finite : Finite (Empty_set U) + | Union_is_finite : forall A:Ensemble U, Finite A -> forall x:U, ~ In U A x -> Finite (Add U A x). -Inductive cardinal : Ensemble U -> nat -> Prop := - | card_empty : cardinal (Empty_set U) 0 - | card_add : + Inductive cardinal : Ensemble U -> nat -> Prop := + | card_empty : cardinal (Empty_set U) 0 + | card_add : forall (A:Ensemble U) (n:nat), cardinal A n -> forall x:U, ~ In U A x -> cardinal (Add U A x) (S n). @@ -51,31 +51,31 @@ Hint Resolve card_empty card_add: sets v62. Require Import Constructive_sets. Section Ensembles_finis_facts. -Variable U : Type. + Variable U : Type. + + Lemma cardinal_invert : + forall (X:Ensemble U) (p:nat), + cardinal U X p -> + match p with + | O => X = Empty_set U + | S n => + exists A : _, + (exists x : _, X = Add U A x /\ ~ In U A x /\ cardinal U A n) + end. + Proof. + induction 1; simpl in |- *; auto. + exists A; exists x; auto. + Qed. -Lemma cardinal_invert : - forall (X:Ensemble U) (p:nat), - cardinal U X p -> - match p with - | O => X = Empty_set U - | S n => - exists A : _, - (exists x : _, X = Add U A x /\ ~ In U A x /\ cardinal U A n) - end. -Proof. -induction 1; simpl in |- *; auto. -exists A; exists x; auto. -Qed. - -Lemma cardinal_elim : - forall (X:Ensemble U) (p:nat), - cardinal U X p -> - match p with - | O => X = Empty_set U - | S n => Inhabited U X - end. -Proof. -intros X p C; elim C; simpl in |- *; trivial with sets. -Qed. + Lemma cardinal_elim : + forall (X:Ensemble U) (p:nat), + cardinal U X p -> + match p with + | O => X = Empty_set U + | S n => Inhabited U X + end. + Proof. + intros X p C; elim C; simpl in |- *; trivial with sets. + Qed. End Ensembles_finis_facts. diff --git a/theories/Sets/Finite_sets_facts.v b/theories/Sets/Finite_sets_facts.v index ddbf62e4..91717f9e 100644 --- a/theories/Sets/Finite_sets_facts.v +++ b/theories/Sets/Finite_sets_facts.v @@ -24,7 +24,7 @@ (* in Summer 1995. Several developments by E. Ledinot were an inspiration. *) (****************************************************************************) -(*i $Id: Finite_sets_facts.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Finite_sets_facts.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Export Finite_sets. Require Export Constructive_sets. @@ -37,311 +37,308 @@ Require Export Gt. Require Export Lt. Section Finite_sets_facts. -Variable U : Type. + Variable U : Type. -Lemma finite_cardinal : - forall X:Ensemble U, Finite U X -> exists n : nat, cardinal U X n. -Proof. -induction 1 as [| A _ [n H]]. -exists 0; auto with sets. -exists (S n); auto with sets. -Qed. + Lemma finite_cardinal : + forall X:Ensemble U, Finite U X -> exists n : nat, cardinal U X n. + Proof. + induction 1 as [| A _ [n H]]. + exists 0; auto with sets. + exists (S n); auto with sets. + Qed. -Lemma cardinal_finite : - forall (X:Ensemble U) (n:nat), cardinal U X n -> Finite U X. -Proof. -induction 1; auto with sets. -Qed. + Lemma cardinal_finite : + forall (X:Ensemble U) (n:nat), cardinal U X n -> Finite U X. + Proof. + induction 1; auto with sets. + Qed. -Theorem Add_preserves_Finite : - forall (X:Ensemble U) (x:U), Finite U X -> Finite U (Add U X x). -Proof. -intros X x H'. -elim (classic (In U X x)); intro H'0; auto with sets. -rewrite (Non_disjoint_union U X x); auto with sets. -Qed. -Hint Resolve Add_preserves_Finite. + Theorem Add_preserves_Finite : + forall (X:Ensemble U) (x:U), Finite U X -> Finite U (Add U X x). + Proof. + intros X x H'. + elim (classic (In U X x)); intro H'0; auto with sets. + rewrite (Non_disjoint_union U X x); auto with sets. + Qed. -Theorem Singleton_is_finite : forall x:U, Finite U (Singleton U x). -Proof. -intro x; rewrite <- (Empty_set_zero U (Singleton U x)). -change (Finite U (Add U (Empty_set U) x)) in |- *; auto with sets. -Qed. -Hint Resolve Singleton_is_finite. + Theorem Singleton_is_finite : forall x:U, Finite U (Singleton U x). + Proof. + intro x; rewrite <- (Empty_set_zero U (Singleton U x)). + change (Finite U (Add U (Empty_set U) x)) in |- *; auto with sets. + Qed. -Theorem Union_preserves_Finite : - forall X Y:Ensemble U, Finite U X -> Finite U Y -> Finite U (Union U X Y). -Proof. -intros X Y H'; elim H'. -rewrite (Empty_set_zero U Y); auto with sets. -intros A H'0 H'1 x H'2 H'3. -rewrite (Union_commutative U (Add U A x) Y). -rewrite <- (Union_add U Y A x). -rewrite (Union_commutative U Y A); auto with sets. -Qed. + Theorem Union_preserves_Finite : + forall X Y:Ensemble U, Finite U X -> Finite U Y -> Finite U (Union U X Y). + Proof. + intros X Y H; induction H as [|A Fin_A Hind x]. + rewrite (Empty_set_zero U Y). trivial. + intros. + rewrite (Union_commutative U (Add U A x) Y). + rewrite <- (Union_add U Y A x). + rewrite (Union_commutative U Y A). + apply Add_preserves_Finite. + apply Hind. assumption. + Qed. -Lemma Finite_downward_closed : - forall A:Ensemble U, - Finite U A -> forall X:Ensemble U, Included U X A -> Finite U X. -Proof. -intros A H'; elim H'; auto with sets. -intros X H'0. -rewrite (less_than_empty U X H'0); auto with sets. -intros; elim Included_Add with U X A0 x; auto with sets. -destruct 1 as [A' [H5 H6]]. -rewrite H5; auto with sets. -Qed. + Lemma Finite_downward_closed : + forall A:Ensemble U, + Finite U A -> forall X:Ensemble U, Included U X A -> Finite U X. + Proof. + intros A H'; elim H'; auto with sets. + intros X H'0. + rewrite (less_than_empty U X H'0); auto with sets. + intros; elim Included_Add with U X A0 x; auto with sets. + destruct 1 as [A' [H5 H6]]. + rewrite H5; auto with sets. + Qed. -Lemma Intersection_preserves_finite : - forall A:Ensemble U, - Finite U A -> forall X:Ensemble U, Finite U (Intersection U X A). -Proof. -intros A H' X; apply Finite_downward_closed with A; auto with sets. -Qed. + Lemma Intersection_preserves_finite : + forall A:Ensemble U, + Finite U A -> forall X:Ensemble U, Finite U (Intersection U X A). + Proof. + intros A H' X; apply Finite_downward_closed with A; auto with sets. + Qed. + + Lemma cardinalO_empty : + forall X:Ensemble U, cardinal U X 0 -> X = Empty_set U. + Proof. + intros X H; apply (cardinal_invert U X 0); trivial with sets. + Qed. -Lemma cardinalO_empty : - forall X:Ensemble U, cardinal U X 0 -> X = Empty_set U. -Proof. -intros X H; apply (cardinal_invert U X 0); trivial with sets. -Qed. -Hint Resolve cardinalO_empty. + Lemma inh_card_gt_O : + forall X:Ensemble U, Inhabited U X -> forall n:nat, cardinal U X n -> n > 0. + Proof. + induction 1 as [x H']. + intros n H'0. + elim (gt_O_eq n); auto with sets. + intro H'1; generalize H'; generalize H'0. + rewrite <- H'1; intro H'2. + rewrite (cardinalO_empty X); auto with sets. + intro H'3; elim H'3. + Qed. -Lemma inh_card_gt_O : - forall X:Ensemble U, Inhabited U X -> forall n:nat, cardinal U X n -> n > 0. -Proof. -induction 1 as [x H']. -intros n H'0. -elim (gt_O_eq n); auto with sets. -intro H'1; generalize H'; generalize H'0. -rewrite <- H'1; intro H'2. -rewrite (cardinalO_empty X); auto with sets. -intro H'3; elim H'3. -Qed. + Lemma card_soustr_1 : + forall (X:Ensemble U) (n:nat), + cardinal U X n -> + forall x:U, In U X x -> cardinal U (Subtract U X x) (pred n). + Proof. + intros X n H'; elim H'. + intros x H'0; elim H'0. + clear H' n X. + intros X n H' H'0 x H'1 x0 H'2. + elim (classic (In U X x0)). + intro H'4; rewrite (add_soustr_xy U X x x0). + elim (classic (x = x0)). + intro H'5. + absurd (In U X x0); auto with sets. + rewrite <- H'5; auto with sets. + intro H'3; try assumption. + cut (S (pred n) = pred (S n)). + intro H'5; rewrite <- H'5. + apply card_add; auto with sets. + red in |- *; intro H'6; elim H'6. + intros H'7 H'8; try assumption. + elim H'1; auto with sets. + unfold pred at 2 in |- *; symmetry in |- *. + apply S_pred with (m := 0). + change (n > 0) in |- *. + apply inh_card_gt_O with (X := X); auto with sets. + apply Inhabited_intro with (x := x0); auto with sets. + red in |- *; intro H'3. + apply H'1. + elim H'3; auto with sets. + rewrite H'3; auto with sets. + elim (classic (x = x0)). + intro H'3; rewrite <- H'3. + cut (Subtract U (Add U X x) x = X); auto with sets. + intro H'4; rewrite H'4; auto with sets. + intros H'3 H'4; try assumption. + absurd (In U (Add U X x) x0); auto with sets. + red in |- *; intro H'5; try exact H'5. + lapply (Add_inv U X x x0); tauto. + Qed. -Lemma card_soustr_1 : - forall (X:Ensemble U) (n:nat), - cardinal U X n -> - forall x:U, In U X x -> cardinal U (Subtract U X x) (pred n). -Proof. -intros X n H'; elim H'. -intros x H'0; elim H'0. -clear H' n X. -intros X n H' H'0 x H'1 x0 H'2. -elim (classic (In U X x0)). -intro H'4; rewrite (add_soustr_xy U X x x0). -elim (classic (x = x0)). -intro H'5. -absurd (In U X x0); auto with sets. -rewrite <- H'5; auto with sets. -intro H'3; try assumption. -cut (S (pred n) = pred (S n)). -intro H'5; rewrite <- H'5. -apply card_add; auto with sets. -red in |- *; intro H'6; elim H'6. -intros H'7 H'8; try assumption. -elim H'1; auto with sets. -unfold pred at 2 in |- *; symmetry in |- *. -apply S_pred with (m := 0). -change (n > 0) in |- *. -apply inh_card_gt_O with (X := X); auto with sets. -apply Inhabited_intro with (x := x0); auto with sets. -red in |- *; intro H'3. -apply H'1. -elim H'3; auto with sets. -rewrite H'3; auto with sets. -elim (classic (x = x0)). -intro H'3; rewrite <- H'3. -cut (Subtract U (Add U X x) x = X); auto with sets. -intro H'4; rewrite H'4; auto with sets. -intros H'3 H'4; try assumption. -absurd (In U (Add U X x) x0); auto with sets. -red in |- *; intro H'5; try exact H'5. -lapply (Add_inv U X x x0); tauto. -Qed. + Lemma cardinal_is_functional : + forall (X:Ensemble U) (c1:nat), + cardinal U X c1 -> + forall (Y:Ensemble U) (c2:nat), cardinal U Y c2 -> X = Y -> c1 = c2. + Proof. + intros X c1 H'; elim H'. + intros Y c2 H'0; elim H'0; auto with sets. + intros A n H'1 H'2 x H'3 H'5. + elim (not_Empty_Add U A x); auto with sets. + clear H' c1 X. + intros X n H' H'0 x H'1 Y c2 H'2. + elim H'2. + intro H'3. + elim (not_Empty_Add U X x); auto with sets. + clear H'2 c2 Y. + intros X0 c2 H'2 H'3 x0 H'4 H'5. + elim (classic (In U X0 x)). + intro H'6; apply f_equal with nat. + apply H'0 with (Y := Subtract U (Add U X0 x0) x). + elimtype (pred (S c2) = c2); auto with sets. + apply card_soustr_1; auto with sets. + rewrite <- H'5. + apply Sub_Add_new; auto with sets. + elim (classic (x = x0)). + intros H'6 H'7; apply f_equal with nat. + apply H'0 with (Y := X0); auto with sets. + apply Simplify_add with (x := x); auto with sets. + pattern x at 2 in |- *; rewrite H'6; auto with sets. + intros H'6 H'7. + absurd (Add U X x = Add U X0 x0); auto with sets. + clear H'0 H' H'3 n H'5 H'4 H'2 H'1 c2. + red in |- *; intro H'. + lapply (Extension U (Add U X x) (Add U X0 x0)); auto with sets. + clear H'. + intro H'; red in H'. + elim H'; intros H'0 H'1; red in H'0; clear H' H'1. + absurd (In U (Add U X0 x0) x); auto with sets. + lapply (Add_inv U X0 x0 x); [ intuition | apply (H'0 x); apply Add_intro2 ]. + Qed. -Lemma cardinal_is_functional : - forall (X:Ensemble U) (c1:nat), - cardinal U X c1 -> - forall (Y:Ensemble U) (c2:nat), cardinal U Y c2 -> X = Y -> c1 = c2. -Proof. -intros X c1 H'; elim H'. -intros Y c2 H'0; elim H'0; auto with sets. -intros A n H'1 H'2 x H'3 H'5. -elim (not_Empty_Add U A x); auto with sets. -clear H' c1 X. -intros X n H' H'0 x H'1 Y c2 H'2. -elim H'2. -intro H'3. -elim (not_Empty_Add U X x); auto with sets. -clear H'2 c2 Y. -intros X0 c2 H'2 H'3 x0 H'4 H'5. -elim (classic (In U X0 x)). -intro H'6; apply f_equal with nat. -apply H'0 with (Y := Subtract U (Add U X0 x0) x). -elimtype (pred (S c2) = c2); auto with sets. -apply card_soustr_1; auto with sets. -rewrite <- H'5. -apply Sub_Add_new; auto with sets. -elim (classic (x = x0)). -intros H'6 H'7; apply f_equal with nat. -apply H'0 with (Y := X0); auto with sets. -apply Simplify_add with (x := x); auto with sets. -pattern x at 2 in |- *; rewrite H'6; auto with sets. -intros H'6 H'7. -absurd (Add U X x = Add U X0 x0); auto with sets. -clear H'0 H' H'3 n H'5 H'4 H'2 H'1 c2. -red in |- *; intro H'. -lapply (Extension U (Add U X x) (Add U X0 x0)); auto with sets. -clear H'. -intro H'; red in H'. -elim H'; intros H'0 H'1; red in H'0; clear H' H'1. -absurd (In U (Add U X0 x0) x); auto with sets. -lapply (Add_inv U X0 x0 x); [ intuition | apply (H'0 x); apply Add_intro2 ]. -Qed. + Lemma cardinal_Empty : forall m:nat, cardinal U (Empty_set U) m -> 0 = m. + Proof. + intros m Cm; generalize (cardinal_invert U (Empty_set U) m Cm). + elim m; auto with sets. + intros; elim H0; intros; elim H1; intros; elim H2; intros. + elim (not_Empty_Add U x x0 H3). + Qed. -Lemma cardinal_Empty : forall m:nat, cardinal U (Empty_set U) m -> 0 = m. -Proof. -intros m Cm; generalize (cardinal_invert U (Empty_set U) m Cm). -elim m; auto with sets. -intros; elim H0; intros; elim H1; intros; elim H2; intros. -elim (not_Empty_Add U x x0 H3). -Qed. + Lemma cardinal_unicity : + forall (X:Ensemble U) (n:nat), + cardinal U X n -> forall m:nat, cardinal U X m -> n = m. + Proof. + intros; apply cardinal_is_functional with X X; auto with sets. + Qed. + + Lemma card_Add_gen : + forall (A:Ensemble U) (x:U) (n n':nat), + cardinal U A n -> cardinal U (Add U A x) n' -> n' <= S n. + Proof. + intros A x n n' H'. + elim (classic (In U A x)). + intro H'0. + rewrite (Non_disjoint_union U A x H'0). + intro H'1; cut (n = n'). + intro E; rewrite E; auto with sets. + apply cardinal_unicity with A; auto with sets. + intros H'0 H'1. + cut (n' = S n). + intro E; rewrite E; auto with sets. + apply cardinal_unicity with (Add U A x); auto with sets. + Qed. -Lemma cardinal_unicity : - forall (X:Ensemble U) (n:nat), - cardinal U X n -> forall m:nat, cardinal U X m -> n = m. -Proof. -intros; apply cardinal_is_functional with X X; auto with sets. -Qed. + Lemma incl_st_card_lt : + forall (X:Ensemble U) (c1:nat), + cardinal U X c1 -> + forall (Y:Ensemble U) (c2:nat), + cardinal U Y c2 -> Strict_Included U X Y -> c2 > c1. + Proof. + intros X c1 H'; elim H'. + intros Y c2 H'0; elim H'0; auto with sets arith. + intro H'1. + elim (Strict_Included_strict U (Empty_set U)); auto with sets arith. + clear H' c1 X. + intros X n H' H'0 x H'1 Y c2 H'2. + elim H'2. + intro H'3; elim (not_SIncl_empty U (Add U X x)); auto with sets arith. + clear H'2 c2 Y. + intros X0 c2 H'2 H'3 x0 H'4 H'5; elim (classic (In U X0 x)). + intro H'6; apply gt_n_S. + apply H'0 with (Y := Subtract U (Add U X0 x0) x). + elimtype (pred (S c2) = c2); auto with sets arith. + apply card_soustr_1; auto with sets arith. + apply incl_st_add_soustr; auto with sets arith. + elim (classic (x = x0)). + intros H'6 H'7; apply gt_n_S. + apply H'0 with (Y := X0); auto with sets arith. + apply sincl_add_x with (x := x0). + rewrite <- H'6; auto with sets arith. + pattern x0 at 1 in |- *; rewrite <- H'6; trivial with sets arith. + intros H'6 H'7; red in H'5. + elim H'5; intros H'8 H'9; try exact H'8; clear H'5. + red in H'8. + generalize (H'8 x). + intro H'5; lapply H'5; auto with sets arith. + intro H; elim Add_inv with U X0 x0 x; auto with sets arith. + intro; absurd (In U X0 x); auto with sets arith. + intro; absurd (x = x0); auto with sets arith. + Qed. -Lemma card_Add_gen : - forall (A:Ensemble U) (x:U) (n n':nat), - cardinal U A n -> cardinal U (Add U A x) n' -> n' <= S n. -Proof. -intros A x n n' H'. -elim (classic (In U A x)). -intro H'0. -rewrite (Non_disjoint_union U A x H'0). -intro H'1; cut (n = n'). -intro E; rewrite E; auto with sets. -apply cardinal_unicity with A; auto with sets. -intros H'0 H'1. -cut (n' = S n). -intro E; rewrite E; auto with sets. -apply cardinal_unicity with (Add U A x); auto with sets. -Qed. + Lemma incl_card_le : + forall (X Y:Ensemble U) (n m:nat), + cardinal U X n -> cardinal U Y m -> Included U X Y -> n <= m. + Proof. + intros; elim Included_Strict_Included with U X Y; auto with sets arith; intro. + cut (m > n); auto with sets arith. + apply incl_st_card_lt with (X := X) (Y := Y); auto with sets arith. + generalize H0; rewrite <- H2; intro. + cut (n = m). + intro E; rewrite E; auto with sets arith. + apply cardinal_unicity with X; auto with sets arith. + Qed. + + Lemma G_aux : + forall P:Ensemble U -> Prop, + (forall X:Ensemble U, + Finite U X -> + (forall Y:Ensemble U, Strict_Included U Y X -> P Y) -> P X) -> + P (Empty_set U). + Proof. + intros P H'; try assumption. + apply H'; auto with sets. + clear H'; auto with sets. + intros Y H'; try assumption. + red in H'. + elim H'; intros H'0 H'1; try exact H'1; clear H'. + lapply (less_than_empty U Y); [ intro H'3; try exact H'3 | assumption ]. + elim H'1; auto with sets. + Qed. -Lemma incl_st_card_lt : - forall (X:Ensemble U) (c1:nat), - cardinal U X c1 -> - forall (Y:Ensemble U) (c2:nat), - cardinal U Y c2 -> Strict_Included U X Y -> c2 > c1. -Proof. -intros X c1 H'; elim H'. -intros Y c2 H'0; elim H'0; auto with sets arith. -intro H'1. -elim (Strict_Included_strict U (Empty_set U)); auto with sets arith. -clear H' c1 X. -intros X n H' H'0 x H'1 Y c2 H'2. -elim H'2. -intro H'3; elim (not_SIncl_empty U (Add U X x)); auto with sets arith. -clear H'2 c2 Y. -intros X0 c2 H'2 H'3 x0 H'4 H'5; elim (classic (In U X0 x)). -intro H'6; apply gt_n_S. -apply H'0 with (Y := Subtract U (Add U X0 x0) x). -elimtype (pred (S c2) = c2); auto with sets arith. -apply card_soustr_1; auto with sets arith. -apply incl_st_add_soustr; auto with sets arith. -elim (classic (x = x0)). -intros H'6 H'7; apply gt_n_S. -apply H'0 with (Y := X0); auto with sets arith. -apply sincl_add_x with (x := x0). -rewrite <- H'6; auto with sets arith. -pattern x0 at 1 in |- *; rewrite <- H'6; trivial with sets arith. -intros H'6 H'7; red in H'5. -elim H'5; intros H'8 H'9; try exact H'8; clear H'5. -red in H'8. -generalize (H'8 x). -intro H'5; lapply H'5; auto with sets arith. -intro H; elim Add_inv with U X0 x0 x; auto with sets arith. -intro; absurd (In U X0 x); auto with sets arith. -intro; absurd (x = x0); auto with sets arith. -Qed. + Lemma Generalized_induction_on_finite_sets : + forall P:Ensemble U -> Prop, + (forall X:Ensemble U, + Finite U X -> + (forall Y:Ensemble U, Strict_Included U Y X -> P Y) -> P X) -> + forall X:Ensemble U, Finite U X -> P X. + Proof. + intros P H'0 X H'1. + generalize P H'0; clear H'0 P. + elim H'1. + intros P H'0. + apply G_aux; auto with sets. + clear H'1 X. + intros A H' H'0 x H'1 P H'3. + cut (forall Y:Ensemble U, Included U Y (Add U A x) -> P Y); auto with sets. + generalize H'1. + apply H'0. + intros X K H'5 L Y H'6; apply H'3; auto with sets. + apply Finite_downward_closed with (A := Add U X x); auto with sets. + intros Y0 H'7. + elim (Strict_inclusion_is_transitive_with_inclusion U Y0 Y (Add U X x)); + auto with sets. + intros H'2 H'4. + elim (Included_Add U Y0 X x); + [ intro H'14 + | intro H'14; elim H'14; intros A' E; elim E; intros H'15 H'16; clear E H'14 + | idtac ]; auto with sets. + elim (Included_Strict_Included U Y0 X); auto with sets. + intro H'9; apply H'5 with (Y := Y0); auto with sets. + intro H'9; rewrite H'9. + apply H'3; auto with sets. + intros Y1 H'8; elim H'8. + intros H'10 H'11; apply H'5 with (Y := Y1); auto with sets. + elim (Included_Strict_Included U A' X); auto with sets. + intro H'8; apply H'5 with (Y := A'); auto with sets. + rewrite <- H'15; auto with sets. + intro H'8. + elim H'7. + intros H'9 H'10; apply H'10 || elim H'10; try assumption. + generalize H'6. + rewrite <- H'8. + rewrite <- H'15; auto with sets. + Qed. -Lemma incl_card_le : - forall (X Y:Ensemble U) (n m:nat), - cardinal U X n -> cardinal U Y m -> Included U X Y -> n <= m. -Proof. -intros; elim Included_Strict_Included with U X Y; auto with sets arith; intro. -cut (m > n); auto with sets arith. -apply incl_st_card_lt with (X := X) (Y := Y); auto with sets arith. -generalize H0; rewrite <- H2; intro. -cut (n = m). -intro E; rewrite E; auto with sets arith. -apply cardinal_unicity with X; auto with sets arith. -Qed. - -Lemma G_aux : - forall P:Ensemble U -> Prop, - (forall X:Ensemble U, - Finite U X -> - (forall Y:Ensemble U, Strict_Included U Y X -> P Y) -> P X) -> - P (Empty_set U). -Proof. -intros P H'; try assumption. -apply H'; auto with sets. -clear H'; auto with sets. -intros Y H'; try assumption. -red in H'. -elim H'; intros H'0 H'1; try exact H'1; clear H'. -lapply (less_than_empty U Y); [ intro H'3; try exact H'3 | assumption ]. -elim H'1; auto with sets. -Qed. - -Hint Unfold not. - -Lemma Generalized_induction_on_finite_sets : - forall P:Ensemble U -> Prop, - (forall X:Ensemble U, - Finite U X -> - (forall Y:Ensemble U, Strict_Included U Y X -> P Y) -> P X) -> - forall X:Ensemble U, Finite U X -> P X. -Proof. -intros P H'0 X H'1. -generalize P H'0; clear H'0 P. -elim H'1. -intros P H'0. -apply G_aux; auto with sets. -clear H'1 X. -intros A H' H'0 x H'1 P H'3. -cut (forall Y:Ensemble U, Included U Y (Add U A x) -> P Y); auto with sets. -generalize H'1. -apply H'0. -intros X K H'5 L Y H'6; apply H'3; auto with sets. -apply Finite_downward_closed with (A := Add U X x); auto with sets. -intros Y0 H'7. -elim (Strict_inclusion_is_transitive_with_inclusion U Y0 Y (Add U X x)); - auto with sets. -intros H'2 H'4. -elim (Included_Add U Y0 X x); - [ intro H'14 - | intro H'14; elim H'14; intros A' E; elim E; intros H'15 H'16; clear E H'14 - | idtac ]; auto with sets. -elim (Included_Strict_Included U Y0 X); auto with sets. -intro H'9; apply H'5 with (Y := Y0); auto with sets. -intro H'9; rewrite H'9. -apply H'3; auto with sets. -intros Y1 H'8; elim H'8. -intros H'10 H'11; apply H'5 with (Y := Y1); auto with sets. -elim (Included_Strict_Included U A' X); auto with sets. -intro H'8; apply H'5 with (Y := A'); auto with sets. -rewrite <- H'15; auto with sets. -intro H'8. -elim H'7. -intros H'9 H'10; apply H'10 || elim H'10; try assumption. -generalize H'6. -rewrite <- H'8. -rewrite <- H'15; auto with sets. -Qed. - -End Finite_sets_facts.
\ No newline at end of file +End Finite_sets_facts. diff --git a/theories/Sets/Image.v b/theories/Sets/Image.v index c97aa127..d3591acf 100644 --- a/theories/Sets/Image.v +++ b/theories/Sets/Image.v @@ -24,7 +24,7 @@ (* in Summer 1995. Several developments by E. Ledinot were an inspiration. *) (****************************************************************************) -(*i $Id: Image.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Image.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Export Finite_sets. Require Export Constructive_sets. @@ -39,167 +39,167 @@ Require Export Le. Require Export Finite_sets_facts. Section Image. -Variables U V : Type. - -Inductive Im (X:Ensemble U) (f:U -> V) : Ensemble V := + Variables U V : Type. + + Inductive Im (X:Ensemble U) (f:U -> V) : Ensemble V := Im_intro : forall x:U, In _ X x -> forall y:V, y = f x -> In _ (Im X f) y. + + Lemma Im_def : + forall (X:Ensemble U) (f:U -> V) (x:U), In _ X x -> In _ (Im X f) (f x). + Proof. + intros X f x H'; try assumption. + apply Im_intro with (x := x); auto with sets. + Qed. + + Lemma Im_add : + forall (X:Ensemble U) (x:U) (f:U -> V), + Im (Add _ X x) f = Add _ (Im X f) (f x). + Proof. + intros X x f. + apply Extensionality_Ensembles. + split; red in |- *; intros x0 H'. + elim H'; intros. + rewrite H0. + elim Add_inv with U X x x1; auto using Im_def with sets. + destruct 1; auto using Im_def with sets. + elim Add_inv with V (Im X f) (f x) x0. + destruct 1 as [x0 H y H0]. + rewrite H0; auto using Im_def with sets. + destruct 1; auto using Im_def with sets. + trivial. + Qed. + + Lemma image_empty : forall f:U -> V, Im (Empty_set U) f = Empty_set V. + Proof. + intro f; try assumption. + apply Extensionality_Ensembles. + split; auto with sets. + red in |- *. + intros x H'; elim H'. + intros x0 H'0; elim H'0; auto with sets. + Qed. + + Lemma finite_image : + forall (X:Ensemble U) (f:U -> V), Finite _ X -> Finite _ (Im X f). + Proof. + intros X f H'; elim H'. + rewrite (image_empty f); auto with sets. + intros A H'0 H'1 x H'2; clear H' X. + rewrite (Im_add A x f); auto with sets. + apply Add_preserves_Finite; auto with sets. + Qed. + + Lemma Im_inv : + forall (X:Ensemble U) (f:U -> V) (y:V), + In _ (Im X f) y -> exists x : U, In _ X x /\ f x = y. + Proof. + intros X f y H'; elim H'. + intros x H'0 y0 H'1; rewrite H'1. + exists x; auto with sets. + Qed. + + Definition injective (f:U -> V) := forall x y:U, f x = f y -> x = y. + + Lemma not_injective_elim : + forall f:U -> V, + ~ injective f -> exists x : _, (exists y : _, f x = f y /\ x <> y). + Proof. + unfold injective in |- *; intros f H. + cut (exists x : _, ~ (forall y:U, f x = f y -> x = y)). + 2: apply not_all_ex_not with (P := fun x:U => forall y:U, f x = f y -> x = y); + trivial with sets. + destruct 1 as [x C]; exists x. + cut (exists y : _, ~ (f x = f y -> x = y)). + 2: apply not_all_ex_not with (P := fun y:U => f x = f y -> x = y); + trivial with sets. + destruct 1 as [y D]; exists y. + apply imply_to_and; trivial with sets. + Qed. + + Lemma cardinal_Im_intro : + forall (A:Ensemble U) (f:U -> V) (n:nat), + cardinal _ A n -> exists p : nat, cardinal _ (Im A f) p. + Proof. + intros. + apply finite_cardinal; apply finite_image. + apply cardinal_finite with n; trivial with sets. + Qed. + + Lemma In_Image_elim : + forall (A:Ensemble U) (f:U -> V), + injective f -> forall x:U, In _ (Im A f) (f x) -> In _ A x. + Proof. + intros. + elim Im_inv with A f (f x); trivial with sets. + intros z C; elim C; intros InAz E. + elim (H z x E); trivial with sets. + Qed. + + Lemma injective_preserves_cardinal : + forall (A:Ensemble U) (f:U -> V) (n:nat), + injective f -> + cardinal _ A n -> forall n':nat, cardinal _ (Im A f) n' -> n' = n. + Proof. + induction 2 as [| A n H'0 H'1 x H'2]; auto with sets. + rewrite (image_empty f). + intros n' CE. + apply cardinal_unicity with V (Empty_set V); auto with sets. + intro n'. + rewrite (Im_add A x f). + intro H'3. + elim cardinal_Im_intro with A f n; trivial with sets. + intros i CI. + lapply (H'1 i); trivial with sets. + cut (~ In _ (Im A f) (f x)). + intros H0 H1. + apply cardinal_unicity with V (Add _ (Im A f) (f x)); trivial with sets. + apply card_add; auto with sets. + rewrite <- H1; trivial with sets. + red in |- *; intro; apply H'2. + apply In_Image_elim with f; trivial with sets. + Qed. + + Lemma cardinal_decreases : + forall (A:Ensemble U) (f:U -> V) (n:nat), + cardinal U A n -> forall n':nat, cardinal V (Im A f) n' -> n' <= n. + Proof. + induction 1 as [| A n H'0 H'1 x H'2]; auto with sets. + rewrite (image_empty f); intros. + cut (n' = 0). + intro E; rewrite E; trivial with sets. + apply cardinal_unicity with V (Empty_set V); auto with sets. + intro n'. + rewrite (Im_add A x f). + elim cardinal_Im_intro with A f n; trivial with sets. + intros p C H'3. + apply le_trans with (S p). + apply card_Add_gen with V (Im A f) (f x); trivial with sets. + apply le_n_S; auto with sets. + Qed. + + Theorem Pigeonhole : + forall (A:Ensemble U) (f:U -> V) (n:nat), + cardinal U A n -> + forall n':nat, cardinal V (Im A f) n' -> n' < n -> ~ injective f. + Proof. + unfold not in |- *; intros A f n CAn n' CIfn' ltn'n I. + cut (n' = n). + intro E; generalize ltn'n; rewrite E; exact (lt_irrefl n). + apply injective_preserves_cardinal with (A := A) (f := f) (n := n); + trivial with sets. + Qed. + + Lemma Pigeonhole_principle : + forall (A:Ensemble U) (f:U -> V) (n:nat), + cardinal _ A n -> + forall n':nat, + cardinal _ (Im A f) n' -> + n' < n -> exists x : _, (exists y : _, f x = f y /\ x <> y). + Proof. + intros; apply not_injective_elim. + apply Pigeonhole with A n n'; trivial with sets. + Qed. -Lemma Im_def : - forall (X:Ensemble U) (f:U -> V) (x:U), In _ X x -> In _ (Im X f) (f x). -Proof. -intros X f x H'; try assumption. -apply Im_intro with (x := x); auto with sets. -Qed. -Hint Resolve Im_def. - -Lemma Im_add : - forall (X:Ensemble U) (x:U) (f:U -> V), - Im (Add _ X x) f = Add _ (Im X f) (f x). -Proof. -intros X x f. -apply Extensionality_Ensembles. -split; red in |- *; intros x0 H'. -elim H'; intros. -rewrite H0. -elim Add_inv with U X x x1; auto with sets. -destruct 1; auto with sets. -elim Add_inv with V (Im X f) (f x) x0; auto with sets. -destruct 1 as [x0 H y H0]. -rewrite H0; auto with sets. -destruct 1; auto with sets. -Qed. - -Lemma image_empty : forall f:U -> V, Im (Empty_set U) f = Empty_set V. -Proof. -intro f; try assumption. -apply Extensionality_Ensembles. -split; auto with sets. -red in |- *. -intros x H'; elim H'. -intros x0 H'0; elim H'0; auto with sets. -Qed. -Hint Resolve image_empty. - -Lemma finite_image : - forall (X:Ensemble U) (f:U -> V), Finite _ X -> Finite _ (Im X f). -Proof. -intros X f H'; elim H'. -rewrite (image_empty f); auto with sets. -intros A H'0 H'1 x H'2; clear H' X. -rewrite (Im_add A x f); auto with sets. -apply Add_preserves_Finite; auto with sets. -Qed. -Hint Resolve finite_image. - -Lemma Im_inv : - forall (X:Ensemble U) (f:U -> V) (y:V), - In _ (Im X f) y -> exists x : U, In _ X x /\ f x = y. -Proof. -intros X f y H'; elim H'. -intros x H'0 y0 H'1; rewrite H'1. -exists x; auto with sets. -Qed. - -Definition injective (f:U -> V) := forall x y:U, f x = f y -> x = y. - -Lemma not_injective_elim : - forall f:U -> V, - ~ injective f -> exists x : _, (exists y : _, f x = f y /\ x <> y). -Proof. -unfold injective in |- *; intros f H. -cut (exists x : _, ~ (forall y:U, f x = f y -> x = y)). -2: apply not_all_ex_not with (P := fun x:U => forall y:U, f x = f y -> x = y); - trivial with sets. -destruct 1 as [x C]; exists x. -cut (exists y : _, ~ (f x = f y -> x = y)). -2: apply not_all_ex_not with (P := fun y:U => f x = f y -> x = y); - trivial with sets. -destruct 1 as [y D]; exists y. -apply imply_to_and; trivial with sets. -Qed. - -Lemma cardinal_Im_intro : - forall (A:Ensemble U) (f:U -> V) (n:nat), - cardinal _ A n -> exists p : nat, cardinal _ (Im A f) p. -Proof. -intros. -apply finite_cardinal; apply finite_image. -apply cardinal_finite with n; trivial with sets. -Qed. - -Lemma In_Image_elim : - forall (A:Ensemble U) (f:U -> V), - injective f -> forall x:U, In _ (Im A f) (f x) -> In _ A x. -Proof. -intros. -elim Im_inv with A f (f x); trivial with sets. -intros z C; elim C; intros InAz E. -elim (H z x E); trivial with sets. -Qed. - -Lemma injective_preserves_cardinal : - forall (A:Ensemble U) (f:U -> V) (n:nat), - injective f -> - cardinal _ A n -> forall n':nat, cardinal _ (Im A f) n' -> n' = n. -Proof. -induction 2 as [| A n H'0 H'1 x H'2]; auto with sets. -rewrite (image_empty f). -intros n' CE. -apply cardinal_unicity with V (Empty_set V); auto with sets. -intro n'. -rewrite (Im_add A x f). -intro H'3. -elim cardinal_Im_intro with A f n; trivial with sets. -intros i CI. -lapply (H'1 i); trivial with sets. -cut (~ In _ (Im A f) (f x)). -intros H0 H1. -apply cardinal_unicity with V (Add _ (Im A f) (f x)); trivial with sets. -apply card_add; auto with sets. -rewrite <- H1; trivial with sets. -red in |- *; intro; apply H'2. -apply In_Image_elim with f; trivial with sets. -Qed. - -Lemma cardinal_decreases : - forall (A:Ensemble U) (f:U -> V) (n:nat), - cardinal U A n -> forall n':nat, cardinal V (Im A f) n' -> n' <= n. -Proof. -induction 1 as [| A n H'0 H'1 x H'2]; auto with sets. -rewrite (image_empty f); intros. -cut (n' = 0). -intro E; rewrite E; trivial with sets. -apply cardinal_unicity with V (Empty_set V); auto with sets. -intro n'. -rewrite (Im_add A x f). -elim cardinal_Im_intro with A f n; trivial with sets. -intros p C H'3. -apply le_trans with (S p). -apply card_Add_gen with V (Im A f) (f x); trivial with sets. -apply le_n_S; auto with sets. -Qed. - -Theorem Pigeonhole : - forall (A:Ensemble U) (f:U -> V) (n:nat), - cardinal U A n -> - forall n':nat, cardinal V (Im A f) n' -> n' < n -> ~ injective f. -Proof. -unfold not in |- *; intros A f n CAn n' CIfn' ltn'n I. -cut (n' = n). -intro E; generalize ltn'n; rewrite E; exact (lt_irrefl n). -apply injective_preserves_cardinal with (A := A) (f := f) (n := n); - trivial with sets. -Qed. - -Lemma Pigeonhole_principle : - forall (A:Ensemble U) (f:U -> V) (n:nat), - cardinal _ A n -> - forall n':nat, - cardinal _ (Im A f) n' -> - n' < n -> exists x : _, (exists y : _, f x = f y /\ x <> y). -Proof. -intros; apply not_injective_elim. -apply Pigeonhole with A n n'; trivial with sets. -Qed. End Image. + Hint Resolve Im_def image_empty finite_image: sets v62.
\ No newline at end of file diff --git a/theories/Sets/Infinite_sets.v b/theories/Sets/Infinite_sets.v index 806e9dde..47554ac4 100644 --- a/theories/Sets/Infinite_sets.v +++ b/theories/Sets/Infinite_sets.v @@ -24,7 +24,7 @@ (* in Summer 1995. Several developments by E. Ledinot were an inspiration. *) (****************************************************************************) -(*i $Id: Infinite_sets.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Infinite_sets.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Export Finite_sets. Require Export Constructive_sets. @@ -40,205 +40,205 @@ Require Export Finite_sets_facts. Require Export Image. Section Approx. -Variable U : Type. + Variable U : Type. -Inductive Approximant (A X:Ensemble U) : Prop := + Inductive Approximant (A X:Ensemble U) : Prop := Defn_of_Approximant : Finite U X -> Included U X A -> Approximant A X. End Approx. Hint Resolve Defn_of_Approximant. Section Infinite_sets. -Variable U : Type. - -Lemma make_new_approximant : - forall A X:Ensemble U, - ~ Finite U A -> Approximant U A X -> Inhabited U (Setminus U A X). -Proof. -intros A X H' H'0. -elim H'0; intros H'1 H'2. -apply Strict_super_set_contains_new_element; auto with sets. -red in |- *; intro H'3; apply H'. -rewrite <- H'3; auto with sets. -Qed. - -Lemma approximants_grow : - forall A X:Ensemble U, - ~ Finite U A -> - forall n:nat, - cardinal U X n -> - Included U X A -> exists Y : _, cardinal U Y (S n) /\ Included U Y A. -Proof. -intros A X H' n H'0; elim H'0; auto with sets. -intro H'1. -cut (Inhabited U (Setminus U A (Empty_set U))). -intro H'2; elim H'2. -intros x H'3. -exists (Add U (Empty_set U) x); auto with sets. -split. -apply card_add; auto with sets. -cut (In U A x). -intro H'4; red in |- *; auto with sets. -intros x0 H'5; elim H'5; auto with sets. -intros x1 H'6; elim H'6; auto with sets. -elim H'3; auto with sets. -apply make_new_approximant; auto with sets. -intros A0 n0 H'1 H'2 x H'3 H'5. -lapply H'2; [ intro H'6; elim H'6; clear H'2 | clear H'2 ]; auto with sets. -intros x0 H'2; try assumption. -elim H'2; intros H'7 H'8; try exact H'8; clear H'2. -elim (make_new_approximant A x0); auto with sets. -intros x1 H'2; try assumption. -exists (Add U x0 x1); auto with sets. -split. -apply card_add; auto with sets. -elim H'2; auto with sets. -red in |- *. -intros x2 H'9; elim H'9; auto with sets. -intros x3 H'10; elim H'10; auto with sets. -elim H'2; auto with sets. -auto with sets. -apply Defn_of_Approximant; auto with sets. -apply cardinal_finite with (n := S n0); auto with sets. -Qed. - -Lemma approximants_grow' : - forall A X:Ensemble U, - ~ Finite U A -> - forall n:nat, - cardinal U X n -> - Approximant U A X -> - exists Y : _, cardinal U Y (S n) /\ Approximant U A Y. -Proof. -intros A X H' n H'0 H'1; try assumption. -elim H'1. -intros H'2 H'3. -elimtype (exists Y : _, cardinal U Y (S n) /\ Included U Y A). -intros x H'4; elim H'4; intros H'5 H'6; try exact H'5; clear H'4. -exists x; auto with sets. -split; [ auto with sets | idtac ]. -apply Defn_of_Approximant; auto with sets. -apply cardinal_finite with (n := S n); auto with sets. -apply approximants_grow with (X := X); auto with sets. -Qed. - -Lemma approximant_can_be_any_size : - forall A X:Ensemble U, - ~ Finite U A -> - forall n:nat, exists Y : _, cardinal U Y n /\ Approximant U A Y. -Proof. -intros A H' H'0 n; elim n. -exists (Empty_set U); auto with sets. -intros n0 H'1; elim H'1. -intros x H'2. -apply approximants_grow' with (X := x); tauto. -Qed. - -Variable V : Type. - -Theorem Image_set_continuous : - forall (A:Ensemble U) (f:U -> V) (X:Ensemble V), - Finite V X -> - Included V X (Im U V A f) -> - exists n : _, - (exists Y : _, (cardinal U Y n /\ Included U Y A) /\ Im U V Y f = X). -Proof. -intros A f X H'; elim H'. -intro H'0; exists 0. -exists (Empty_set U); auto with sets. -intros A0 H'0 H'1 x H'2 H'3; try assumption. -lapply H'1; - [ intro H'4; elim H'4; intros n E; elim E; clear H'4 H'1 | clear H'1 ]; - auto with sets. -intros x0 H'1; try assumption. -exists (S n); try assumption. -elim H'1; intros H'4 H'5; elim H'4; intros H'6 H'7; try exact H'6; - clear H'4 H'1. -clear E. -generalize H'2. -rewrite <- H'5. -intro H'1; try assumption. -red in H'3. -generalize (H'3 x). -intro H'4; lapply H'4; [ intro H'8; try exact H'8; clear H'4 | clear H'4 ]; - auto with sets. -specialize 5Im_inv with (U := U) (V := V) (X := A) (f := f) (y := x); - intro H'11; lapply H'11; [ intro H'13; elim H'11; clear H'11 | clear H'11 ]; - auto with sets. -intros x1 H'4; try assumption. -apply ex_intro with (x := Add U x0 x1). -split; [ split; [ try assumption | idtac ] | idtac ]. -apply card_add; auto with sets. -red in |- *; intro H'9; try exact H'9. -apply H'1. -elim H'4; intros H'10 H'11; rewrite <- H'11; clear H'4; auto with sets. -elim H'4; intros H'9 H'10; try exact H'9; clear H'4; auto with sets. -red in |- *; auto with sets. -intros x2 H'4; elim H'4; auto with sets. -intros x3 H'11; elim H'11; auto with sets. -elim H'4; intros H'9 H'10; rewrite <- H'10; clear H'4; auto with sets. -apply Im_add; auto with sets. -Qed. - -Theorem Image_set_continuous' : - forall (A:Ensemble U) (f:U -> V) (X:Ensemble V), - Approximant V (Im U V A f) X -> - exists Y : _, Approximant U A Y /\ Im U V Y f = X. -Proof. -intros A f X H'; try assumption. -cut - (exists n : _, - (exists Y : _, (cardinal U Y n /\ Included U Y A) /\ Im U V Y f = X)). -intro H'0; elim H'0; intros n E; elim E; clear H'0. -intros x H'0; try assumption. -elim H'0; intros H'1 H'2; elim H'1; intros H'3 H'4; try exact H'3; - clear H'1 H'0; auto with sets. -exists x. -split; [ idtac | try assumption ]. -apply Defn_of_Approximant; auto with sets. -apply cardinal_finite with (n := n); auto with sets. -apply Image_set_continuous; auto with sets. -elim H'; auto with sets. -elim H'; auto with sets. -Qed. - -Theorem Pigeonhole_bis : - forall (A:Ensemble U) (f:U -> V), - ~ Finite U A -> Finite V (Im U V A f) -> ~ injective U V f. -Proof. -intros A f H'0 H'1; try assumption. -elim (Image_set_continuous' A f (Im U V A f)); auto with sets. -intros x H'2; elim H'2; intros H'3 H'4; try exact H'3; clear H'2. -elim (make_new_approximant A x); auto with sets. -intros x0 H'2; elim H'2. -intros H'5 H'6. -elim (finite_cardinal V (Im U V A f)); auto with sets. -intros n E. -elim (finite_cardinal U x); auto with sets. -intros n0 E0. -apply Pigeonhole with (A := Add U x x0) (n := S n0) (n' := n). -apply card_add; auto with sets. -rewrite (Im_add U V x x0 f); auto with sets. -cut (In V (Im U V x f) (f x0)). -intro H'8. -rewrite (Non_disjoint_union V (Im U V x f) (f x0)); auto with sets. -rewrite H'4; auto with sets. -elim (Extension V (Im U V x f) (Im U V A f)); auto with sets. -apply le_lt_n_Sm. -apply cardinal_decreases with (U := U) (V := V) (A := x) (f := f); - auto with sets. -rewrite H'4; auto with sets. -elim H'3; auto with sets. -Qed. - -Theorem Pigeonhole_ter : - forall (A:Ensemble U) (f:U -> V) (n:nat), - injective U V f -> Finite V (Im U V A f) -> Finite U A. -Proof. -intros A f H' H'0 H'1. -apply NNPP. -red in |- *; intro H'2. -elim (Pigeonhole_bis A f); auto with sets. -Qed. + Variable U : Type. + + Lemma make_new_approximant : + forall A X:Ensemble U, + ~ Finite U A -> Approximant U A X -> Inhabited U (Setminus U A X). + Proof. + intros A X H' H'0. + elim H'0; intros H'1 H'2. + apply Strict_super_set_contains_new_element; auto with sets. + red in |- *; intro H'3; apply H'. + rewrite <- H'3; auto with sets. + Qed. + + Lemma approximants_grow : + forall A X:Ensemble U, + ~ Finite U A -> + forall n:nat, + cardinal U X n -> + Included U X A -> exists Y : _, cardinal U Y (S n) /\ Included U Y A. + Proof. + intros A X H' n H'0; elim H'0; auto with sets. + intro H'1. + cut (Inhabited U (Setminus U A (Empty_set U))). + intro H'2; elim H'2. + intros x H'3. + exists (Add U (Empty_set U) x); auto with sets. + split. + apply card_add; auto with sets. + cut (In U A x). + intro H'4; red in |- *; auto with sets. + intros x0 H'5; elim H'5; auto with sets. + intros x1 H'6; elim H'6; auto with sets. + elim H'3; auto with sets. + apply make_new_approximant; auto with sets. + intros A0 n0 H'1 H'2 x H'3 H'5. + lapply H'2; [ intro H'6; elim H'6; clear H'2 | clear H'2 ]; auto with sets. + intros x0 H'2; try assumption. + elim H'2; intros H'7 H'8; try exact H'8; clear H'2. + elim (make_new_approximant A x0); auto with sets. + intros x1 H'2; try assumption. + exists (Add U x0 x1); auto with sets. + split. + apply card_add; auto with sets. + elim H'2; auto with sets. + red in |- *. + intros x2 H'9; elim H'9; auto with sets. + intros x3 H'10; elim H'10; auto with sets. + elim H'2; auto with sets. + auto with sets. + apply Defn_of_Approximant; auto with sets. + apply cardinal_finite with (n := S n0); auto with sets. + Qed. + + Lemma approximants_grow' : + forall A X:Ensemble U, + ~ Finite U A -> + forall n:nat, + cardinal U X n -> + Approximant U A X -> + exists Y : _, cardinal U Y (S n) /\ Approximant U A Y. + Proof. + intros A X H' n H'0 H'1; try assumption. + elim H'1. + intros H'2 H'3. + elimtype (exists Y : _, cardinal U Y (S n) /\ Included U Y A). + intros x H'4; elim H'4; intros H'5 H'6; try exact H'5; clear H'4. + exists x; auto with sets. + split; [ auto with sets | idtac ]. + apply Defn_of_Approximant; auto with sets. + apply cardinal_finite with (n := S n); auto with sets. + apply approximants_grow with (X := X); auto with sets. + Qed. + + Lemma approximant_can_be_any_size : + forall A X:Ensemble U, + ~ Finite U A -> + forall n:nat, exists Y : _, cardinal U Y n /\ Approximant U A Y. + Proof. + intros A H' H'0 n; elim n. + exists (Empty_set U); auto with sets. + intros n0 H'1; elim H'1. + intros x H'2. + apply approximants_grow' with (X := x); tauto. + Qed. + + Variable V : Type. + + Theorem Image_set_continuous : + forall (A:Ensemble U) (f:U -> V) (X:Ensemble V), + Finite V X -> + Included V X (Im U V A f) -> + exists n : _, + (exists Y : _, (cardinal U Y n /\ Included U Y A) /\ Im U V Y f = X). + Proof. + intros A f X H'; elim H'. + intro H'0; exists 0. + exists (Empty_set U); auto with sets. + intros A0 H'0 H'1 x H'2 H'3; try assumption. + lapply H'1; + [ intro H'4; elim H'4; intros n E; elim E; clear H'4 H'1 | clear H'1 ]; + auto with sets. + intros x0 H'1; try assumption. + exists (S n); try assumption. + elim H'1; intros H'4 H'5; elim H'4; intros H'6 H'7; try exact H'6; + clear H'4 H'1. + clear E. + generalize H'2. + rewrite <- H'5. + intro H'1; try assumption. + red in H'3. + generalize (H'3 x). + intro H'4; lapply H'4; [ intro H'8; try exact H'8; clear H'4 | clear H'4 ]; + auto with sets. + specialize 5Im_inv with (U := U) (V := V) (X := A) (f := f) (y := x); + intro H'11; lapply H'11; [ intro H'13; elim H'11; clear H'11 | clear H'11 ]; + auto with sets. + intros x1 H'4; try assumption. + apply ex_intro with (x := Add U x0 x1). + split; [ split; [ try assumption | idtac ] | idtac ]. + apply card_add; auto with sets. + red in |- *; intro H'9; try exact H'9. + apply H'1. + elim H'4; intros H'10 H'11; rewrite <- H'11; clear H'4; auto with sets. + elim H'4; intros H'9 H'10; try exact H'9; clear H'4; auto with sets. + red in |- *; auto with sets. + intros x2 H'4; elim H'4; auto with sets. + intros x3 H'11; elim H'11; auto with sets. + elim H'4; intros H'9 H'10; rewrite <- H'10; clear H'4; auto with sets. + apply Im_add; auto with sets. + Qed. + + Theorem Image_set_continuous' : + forall (A:Ensemble U) (f:U -> V) (X:Ensemble V), + Approximant V (Im U V A f) X -> + exists Y : _, Approximant U A Y /\ Im U V Y f = X. + Proof. + intros A f X H'; try assumption. + cut + (exists n : _, + (exists Y : _, (cardinal U Y n /\ Included U Y A) /\ Im U V Y f = X)). + intro H'0; elim H'0; intros n E; elim E; clear H'0. + intros x H'0; try assumption. + elim H'0; intros H'1 H'2; elim H'1; intros H'3 H'4; try exact H'3; + clear H'1 H'0; auto with sets. + exists x. + split; [ idtac | try assumption ]. + apply Defn_of_Approximant; auto with sets. + apply cardinal_finite with (n := n); auto with sets. + apply Image_set_continuous; auto with sets. + elim H'; auto with sets. + elim H'; auto with sets. + Qed. + + Theorem Pigeonhole_bis : + forall (A:Ensemble U) (f:U -> V), + ~ Finite U A -> Finite V (Im U V A f) -> ~ injective U V f. + Proof. + intros A f H'0 H'1; try assumption. + elim (Image_set_continuous' A f (Im U V A f)); auto with sets. + intros x H'2; elim H'2; intros H'3 H'4; try exact H'3; clear H'2. + elim (make_new_approximant A x); auto with sets. + intros x0 H'2; elim H'2. + intros H'5 H'6. + elim (finite_cardinal V (Im U V A f)); auto with sets. + intros n E. + elim (finite_cardinal U x); auto with sets. + intros n0 E0. + apply Pigeonhole with (A := Add U x x0) (n := S n0) (n' := n). + apply card_add; auto with sets. + rewrite (Im_add U V x x0 f); auto with sets. + cut (In V (Im U V x f) (f x0)). + intro H'8. + rewrite (Non_disjoint_union V (Im U V x f) (f x0)); auto with sets. + rewrite H'4; auto with sets. + elim (Extension V (Im U V x f) (Im U V A f)); auto with sets. + apply le_lt_n_Sm. + apply cardinal_decreases with (U := U) (V := V) (A := x) (f := f); + auto with sets. + rewrite H'4; auto with sets. + elim H'3; auto with sets. + Qed. + + Theorem Pigeonhole_ter : + forall (A:Ensemble U) (f:U -> V) (n:nat), + injective U V f -> Finite V (Im U V A f) -> Finite U A. + Proof. + intros A f H' H'0 H'1. + apply NNPP. + red in |- *; intro H'2. + elim (Pigeonhole_bis A f); auto with sets. + Qed. End Infinite_sets. diff --git a/theories/Sets/Integers.v b/theories/Sets/Integers.v index cfadd81c..c969ad9c 100644 --- a/theories/Sets/Integers.v +++ b/theories/Sets/Integers.v @@ -24,7 +24,7 @@ (* in Summer 1995. Several developments by E. Ledinot were an inspiration. *) (****************************************************************************) -(*i $Id: Integers.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Integers.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Export Finite_sets. Require Export Constructive_sets. @@ -45,120 +45,117 @@ Require Export Partial_Order. Require Export Cpo. Section Integers_sect. - -Inductive Integers : Ensemble nat := + + Inductive Integers : Ensemble nat := Integers_defn : forall x:nat, In nat Integers x. -Hint Resolve Integers_defn. - -Lemma le_reflexive : Reflexive nat le. -Proof. -red in |- *; auto with arith. -Qed. - -Lemma le_antisym : Antisymmetric nat le. -Proof. -red in |- *; intros x y H H'; rewrite (le_antisym x y); auto. -Qed. - -Lemma le_trans : Transitive nat le. -Proof. -red in |- *; intros; apply le_trans with y; auto. -Qed. -Hint Resolve le_reflexive le_antisym le_trans. - -Lemma le_Order : Order nat le. -Proof. -auto with sets arith. -Qed. -Hint Resolve le_Order. - -Lemma triv_nat : forall n:nat, In nat Integers n. -Proof. -auto with sets arith. -Qed. -Hint Resolve triv_nat. - -Definition nat_po : PO nat. -apply Definition_of_PO with (Carrier_of := Integers) (Rel_of := le); - auto with sets arith. -apply Inhabited_intro with (x := 0); auto with sets arith. -Defined. -Hint Unfold nat_po. - -Lemma le_total_order : Totally_ordered nat nat_po Integers. -Proof. -apply Totally_ordered_definition. -simpl in |- *. -intros H' x y H'0. -specialize 2le_or_lt with (n := x) (m := y); intro H'2; elim H'2. -intro H'1; left; auto with sets arith. -intro H'1; right. -cut (y <= x); auto with sets arith. -Qed. -Hint Resolve le_total_order. - -Lemma Finite_subset_has_lub : - forall X:Ensemble nat, - Finite nat X -> exists m : nat, Upper_Bound nat nat_po X m. -Proof. -intros X H'; elim H'. -exists 0. -apply Upper_Bound_definition; auto with sets arith. -intros y H'0; elim H'0; auto with sets arith. -intros A H'0 H'1 x H'2; try assumption. -elim H'1; intros x0 H'3; clear H'1. -elim le_total_order. -simpl in |- *. -intro H'1; try assumption. -lapply H'1; [ intro H'4; idtac | try assumption ]; auto with sets arith. -generalize (H'4 x0 x). -clear H'4. -clear H'1. -intro H'1; lapply H'1; - [ intro H'4; elim H'4; - [ intro H'5; try exact H'5; clear H'4 H'1 | intro H'5; clear H'4 H'1 ] - | clear H'1 ]. -exists x. -apply Upper_Bound_definition; auto with sets arith; simpl in |- *. -intros y H'1; elim H'1. -generalize le_trans. -intro H'4; red in H'4. -intros x1 H'6; try assumption. -apply H'4 with (y := x0); auto with sets arith. -elim H'3; simpl in |- *; auto with sets arith. -intros x1 H'4; elim H'4; auto with sets arith. -exists x0. -apply Upper_Bound_definition; auto with sets arith; simpl in |- *. -intros y H'1; elim H'1. -intros x1 H'4; try assumption. -elim H'3; simpl in |- *; auto with sets arith. -intros x1 H'4; elim H'4; auto with sets arith. -red in |- *. -intros x1 H'1; elim H'1; auto with sets arith. -Qed. - -Lemma Integers_has_no_ub : - ~ (exists m : nat, Upper_Bound nat nat_po Integers m). -Proof. -red in |- *; intro H'; elim H'. -intros x H'0. -elim H'0; intros H'1 H'2. -cut (In nat Integers (S x)). -intro H'3. -specialize 1H'2 with (y := S x); intro H'4; lapply H'4; - [ intro H'5; clear H'4 | try assumption; clear H'4 ]. -simpl in H'5. -absurd (S x <= x); auto with arith. -auto with sets arith. -Qed. -Lemma Integers_infinite : ~ Finite nat Integers. -Proof. -generalize Integers_has_no_ub. -intro H'; red in |- *; intro H'0; try exact H'0. -apply H'. -apply Finite_subset_has_lub; auto with sets arith. -Qed. + Lemma le_reflexive : Reflexive nat le. + Proof. + red in |- *; auto with arith. + Qed. + + Lemma le_antisym : Antisymmetric nat le. + Proof. + red in |- *; intros x y H H'; rewrite (le_antisym x y); auto. + Qed. + + Lemma le_trans : Transitive nat le. + Proof. + red in |- *; intros; apply le_trans with y; auto. + Qed. + + Lemma le_Order : Order nat le. + Proof. + split; [exact le_reflexive | exact le_trans | exact le_antisym]. + Qed. + + Lemma triv_nat : forall n:nat, In nat Integers n. + Proof. + exact Integers_defn. + Qed. + + Definition nat_po : PO nat. + apply Definition_of_PO with (Carrier_of := Integers) (Rel_of := le); + auto with sets arith. + apply Inhabited_intro with (x := 0). + apply Integers_defn. + exact le_Order. + Defined. + + Lemma le_total_order : Totally_ordered nat nat_po Integers. + Proof. + apply Totally_ordered_definition. + simpl in |- *. + intros H' x y H'0. + specialize 2le_or_lt with (n := x) (m := y); intro H'2; elim H'2. + intro H'1; left; auto with sets arith. + intro H'1; right. + cut (y <= x); auto with sets arith. + Qed. + + Lemma Finite_subset_has_lub : + forall X:Ensemble nat, + Finite nat X -> exists m : nat, Upper_Bound nat nat_po X m. + Proof. + intros X H'; elim H'. + exists 0. + apply Upper_Bound_definition. + unfold nat_po. simpl. apply triv_nat. + intros y H'0; elim H'0; auto with sets arith. + intros A H'0 H'1 x H'2; try assumption. + elim H'1; intros x0 H'3; clear H'1. + elim le_total_order. + simpl in |- *. + intro H'1; try assumption. + lapply H'1; [ intro H'4; idtac | try assumption ]; auto with sets arith. + generalize (H'4 x0 x). + clear H'4. + clear H'1. + intro H'1; lapply H'1; + [ intro H'4; elim H'4; + [ intro H'5; try exact H'5; clear H'4 H'1 | intro H'5; clear H'4 H'1 ] + | clear H'1 ]. + exists x. + apply Upper_Bound_definition. simpl in |- *. apply triv_nat. + intros y H'1; elim H'1. + generalize le_trans. + intro H'4; red in H'4. + intros x1 H'6; try assumption. + apply H'4 with (y := x0). elim H'3; simpl in |- *; auto with sets arith. trivial. + intros x1 H'4; elim H'4. unfold nat_po; simpl; trivial. + exists x0. + apply Upper_Bound_definition. + unfold nat_po. simpl. apply triv_nat. + intros y H'1; elim H'1. + intros x1 H'4; try assumption. + elim H'3; simpl in |- *; auto with sets arith. + intros x1 H'4; elim H'4; auto with sets arith. + red in |- *. + intros x1 H'1; elim H'1; apply triv_nat. + Qed. + + Lemma Integers_has_no_ub : + ~ (exists m : nat, Upper_Bound nat nat_po Integers m). + Proof. + red in |- *; intro H'; elim H'. + intros x H'0. + elim H'0; intros H'1 H'2. + cut (In nat Integers (S x)). + intro H'3. + specialize 1H'2 with (y := S x); intro H'4; lapply H'4; + [ intro H'5; clear H'4 | try assumption; clear H'4 ]. + simpl in H'5. + absurd (S x <= x); auto with arith. + apply triv_nat. + Qed. + + Lemma Integers_infinite : ~ Finite nat Integers. + Proof. + generalize Integers_has_no_ub. + intro H'; red in |- *; intro H'0; try exact H'0. + apply H'. + apply Finite_subset_has_lub; auto with sets arith. + Qed. End Integers_sect. diff --git a/theories/Sets/Multiset.v b/theories/Sets/Multiset.v index cdc8520c..7084a82d 100644 --- a/theories/Sets/Multiset.v +++ b/theories/Sets/Multiset.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Multiset.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Multiset.v 9245 2006-10-17 12:53:34Z notin $ i*) (* G. Huet 1-9-95 *) @@ -16,162 +16,156 @@ Set Implicit Arguments. Section multiset_defs. -Variable A : Set. -Variable eqA : A -> A -> Prop. -Hypothesis Aeq_dec : forall x y:A, {eqA x y} + {~ eqA x y}. + Variable A : Set. + Variable eqA : A -> A -> Prop. + Hypothesis Aeq_dec : forall x y:A, {eqA x y} + {~ eqA x y}. -Inductive multiset : Set := + Inductive multiset : Set := Bag : (A -> nat) -> multiset. - -Definition EmptyBag := Bag (fun a:A => 0). -Definition SingletonBag (a:A) := - Bag (fun a':A => match Aeq_dec a a' with - | left _ => 1 - | right _ => 0 - end). - -Definition multiplicity (m:multiset) (a:A) : nat := let (f) := m in f a. - -(** multiset equality *) -Definition meq (m1 m2:multiset) := - forall a:A, multiplicity m1 a = multiplicity m2 a. - -Hint Unfold meq multiplicity. - -Lemma meq_refl : forall x:multiset, meq x x. -Proof. -destruct x; auto. -Qed. -Hint Resolve meq_refl. - -Lemma meq_trans : forall x y z:multiset, meq x y -> meq y z -> meq x z. -Proof. -unfold meq in |- *. -destruct x; destruct y; destruct z. -intros; rewrite H; auto. -Qed. - -Lemma meq_sym : forall x y:multiset, meq x y -> meq y x. -Proof. -unfold meq in |- *. -destruct x; destruct y; auto. -Qed. -Hint Immediate meq_sym. - -(** multiset union *) -Definition munion (m1 m2:multiset) := - Bag (fun a:A => multiplicity m1 a + multiplicity m2 a). - -Lemma munion_empty_left : forall x:multiset, meq x (munion EmptyBag x). -Proof. -unfold meq in |- *; unfold munion in |- *; simpl in |- *; auto. -Qed. -Hint Resolve munion_empty_left. - -Lemma munion_empty_right : forall x:multiset, meq x (munion x EmptyBag). -Proof. -unfold meq in |- *; unfold munion in |- *; simpl in |- *; auto. -Qed. - - -Require Import Plus. (* comm. and ass. of plus *) - -Lemma munion_comm : forall x y:multiset, meq (munion x y) (munion y x). -Proof. -unfold meq in |- *; unfold multiplicity in |- *; unfold munion in |- *. -destruct x; destruct y; auto with arith. -Qed. -Hint Resolve munion_comm. - -Lemma munion_ass : - forall x y z:multiset, meq (munion (munion x y) z) (munion x (munion y z)). -Proof. -unfold meq in |- *; unfold munion in |- *; unfold multiplicity in |- *. -destruct x; destruct y; destruct z; auto with arith. -Qed. -Hint Resolve munion_ass. - -Lemma meq_left : - forall x y z:multiset, meq x y -> meq (munion x z) (munion y z). -Proof. -unfold meq in |- *; unfold munion in |- *; unfold multiplicity in |- *. -destruct x; destruct y; destruct z. -intros; elim H; auto with arith. -Qed. -Hint Resolve meq_left. - -Lemma meq_right : - forall x y z:multiset, meq x y -> meq (munion z x) (munion z y). -Proof. -unfold meq in |- *; unfold munion in |- *; unfold multiplicity in |- *. -destruct x; destruct y; destruct z. -intros; elim H; auto. -Qed. -Hint Resolve meq_right. - - -(** Here we should make multiset an abstract datatype, by hiding [Bag], - [munion], [multiplicity]; all further properties are proved abstractly *) - -Lemma munion_rotate : - forall x y z:multiset, meq (munion x (munion y z)) (munion z (munion x y)). -Proof. -intros; apply (op_rotate multiset munion meq); auto. -exact meq_trans. -Qed. - -Lemma meq_congr : - forall x y z t:multiset, meq x y -> meq z t -> meq (munion x z) (munion y t). -Proof. -intros; apply (cong_congr multiset munion meq); auto. -exact meq_trans. -Qed. - -Lemma munion_perm_left : - forall x y z:multiset, meq (munion x (munion y z)) (munion y (munion x z)). -Proof. -intros; apply (perm_left multiset munion meq); auto. -exact meq_trans. -Qed. - -Lemma multiset_twist1 : - forall x y z t:multiset, - meq (munion x (munion (munion y z) t)) (munion (munion y (munion x t)) z). -Proof. -intros; apply (twist multiset munion meq); auto. -exact meq_trans. -Qed. - -Lemma multiset_twist2 : - forall x y z t:multiset, - meq (munion x (munion (munion y z) t)) (munion (munion y (munion x z)) t). -Proof. -intros; apply meq_trans with (munion (munion x (munion y z)) t). -apply meq_sym; apply munion_ass. -apply meq_left; apply munion_perm_left. -Qed. - -(** specific for treesort *) - -Lemma treesort_twist1 : - forall x y z t u:multiset, - meq u (munion y z) -> - meq (munion x (munion u t)) (munion (munion y (munion x t)) z). -Proof. -intros; apply meq_trans with (munion x (munion (munion y z) t)). -apply meq_right; apply meq_left; trivial. -apply multiset_twist1. -Qed. - -Lemma treesort_twist2 : - forall x y z t u:multiset, - meq u (munion y z) -> - meq (munion x (munion u t)) (munion (munion y (munion x z)) t). -Proof. -intros; apply meq_trans with (munion x (munion (munion y z) t)). -apply meq_right; apply meq_left; trivial. -apply multiset_twist2. -Qed. + + Definition EmptyBag := Bag (fun a:A => 0). + Definition SingletonBag (a:A) := + Bag (fun a':A => match Aeq_dec a a' with + | left _ => 1 + | right _ => 0 + end). + + Definition multiplicity (m:multiset) (a:A) : nat := let (f) := m in f a. + + (** multiset equality *) + Definition meq (m1 m2:multiset) := + forall a:A, multiplicity m1 a = multiplicity m2 a. + + Lemma meq_refl : forall x:multiset, meq x x. + Proof. + destruct x; unfold meq; reflexivity. + Qed. + + Lemma meq_trans : forall x y z:multiset, meq x y -> meq y z -> meq x z. + Proof. + unfold meq in |- *. + destruct x; destruct y; destruct z. + intros; rewrite H; auto. + Qed. + + Lemma meq_sym : forall x y:multiset, meq x y -> meq y x. + Proof. + unfold meq in |- *. + destruct x; destruct y; auto. + Qed. + + (** multiset union *) + Definition munion (m1 m2:multiset) := + Bag (fun a:A => multiplicity m1 a + multiplicity m2 a). + + Lemma munion_empty_left : forall x:multiset, meq x (munion EmptyBag x). + Proof. + unfold meq in |- *; unfold munion in |- *; simpl in |- *; auto. + Qed. + + Lemma munion_empty_right : forall x:multiset, meq x (munion x EmptyBag). + Proof. + unfold meq in |- *; unfold munion in |- *; simpl in |- *; auto. + Qed. + + + Require Plus. (* comm. and ass. of plus *) + + Lemma munion_comm : forall x y:multiset, meq (munion x y) (munion y x). + Proof. + unfold meq in |- *; unfold multiplicity in |- *; unfold munion in |- *. + destruct x; destruct y; auto with arith. + Qed. + + Lemma munion_ass : + forall x y z:multiset, meq (munion (munion x y) z) (munion x (munion y z)). + Proof. + unfold meq in |- *; unfold munion in |- *; unfold multiplicity in |- *. + destruct x; destruct y; destruct z; auto with arith. + Qed. + + Lemma meq_left : + forall x y z:multiset, meq x y -> meq (munion x z) (munion y z). + Proof. + unfold meq in |- *; unfold munion in |- *; unfold multiplicity in |- *. + destruct x; destruct y; destruct z. + intros; elim H; auto with arith. + Qed. + + Lemma meq_right : + forall x y z:multiset, meq x y -> meq (munion z x) (munion z y). + Proof. + unfold meq in |- *; unfold munion in |- *; unfold multiplicity in |- *. + destruct x; destruct y; destruct z. + intros; elim H; auto. + Qed. + + (** Here we should make multiset an abstract datatype, by hiding [Bag], + [munion], [multiplicity]; all further properties are proved abstractly *) + + Lemma munion_rotate : + forall x y z:multiset, meq (munion x (munion y z)) (munion z (munion x y)). + Proof. + intros; apply (op_rotate multiset munion meq). + apply munion_comm. + apply munion_ass. + exact meq_trans. + exact meq_sym. + trivial. + Qed. + + Lemma meq_congr : + forall x y z t:multiset, meq x y -> meq z t -> meq (munion x z) (munion y t). + Proof. + intros; apply (cong_congr multiset munion meq); auto using meq_left, meq_right. + exact meq_trans. + Qed. + + Lemma munion_perm_left : + forall x y z:multiset, meq (munion x (munion y z)) (munion y (munion x z)). + Proof. + intros; apply (perm_left multiset munion meq); auto using munion_comm, munion_ass, meq_left, meq_right, meq_sym. + exact meq_trans. + Qed. + + Lemma multiset_twist1 : + forall x y z t:multiset, + meq (munion x (munion (munion y z) t)) (munion (munion y (munion x t)) z). + Proof. + intros; apply (twist multiset munion meq); auto using munion_comm, munion_ass, meq_sym, meq_left, meq_right. + exact meq_trans. + Qed. + + Lemma multiset_twist2 : + forall x y z t:multiset, + meq (munion x (munion (munion y z) t)) (munion (munion y (munion x z)) t). + Proof. + intros; apply meq_trans with (munion (munion x (munion y z)) t). + apply meq_sym; apply munion_ass. + apply meq_left; apply munion_perm_left. + Qed. + + (** specific for treesort *) + + Lemma treesort_twist1 : + forall x y z t u:multiset, + meq u (munion y z) -> + meq (munion x (munion u t)) (munion (munion y (munion x t)) z). + Proof. + intros; apply meq_trans with (munion x (munion (munion y z) t)). + apply meq_right; apply meq_left; trivial. + apply multiset_twist1. + Qed. + + Lemma treesort_twist2 : + forall x y z t u:multiset, + meq u (munion y z) -> + meq (munion x (munion u t)) (munion (munion y (munion x z)) t). + Proof. + intros; apply meq_trans with (munion x (munion (munion y z) t)). + apply meq_right; apply meq_left; trivial. + apply multiset_twist2. + Qed. (*i theory of minter to do similarly @@ -188,4 +182,4 @@ Unset Implicit Arguments. Hint Unfold meq multiplicity: v62 datatypes. Hint Resolve munion_empty_right munion_comm munion_ass meq_left meq_right munion_empty_left: v62 datatypes. -Hint Immediate meq_sym: v62 datatypes.
\ No newline at end of file +Hint Immediate meq_sym: v62 datatypes. diff --git a/theories/Sets/Partial_Order.v b/theories/Sets/Partial_Order.v index 9924ba66..6210913c 100644 --- a/theories/Sets/Partial_Order.v +++ b/theories/Sets/Partial_Order.v @@ -24,32 +24,32 @@ (* in Summer 1995. Several developments by E. Ledinot were an inspiration. *) (****************************************************************************) -(*i $Id: Partial_Order.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Partial_Order.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Export Ensembles. Require Export Relations_1. Section Partial_orders. -Variable U : Type. - -Definition Carrier := Ensemble U. - -Definition Rel := Relation U. - -Record PO : Type := Definition_of_PO - {Carrier_of : Ensemble U; - Rel_of : Relation U; - PO_cond1 : Inhabited U Carrier_of; - PO_cond2 : Order U Rel_of}. -Variable p : PO. - -Definition Strict_Rel_of : Rel := fun x y:U => Rel_of p x y /\ x <> y. - -Inductive covers (y x:U) : Prop := + Variable U : Type. + + Definition Carrier := Ensemble U. + + Definition Rel := Relation U. + + Record PO : Type := Definition_of_PO + { Carrier_of : Ensemble U; + Rel_of : Relation U; + PO_cond1 : Inhabited U Carrier_of; + PO_cond2 : Order U Rel_of }. + Variable p : PO. + + Definition Strict_Rel_of : Rel := fun x y:U => Rel_of p x y /\ x <> y. + + Inductive covers (y x:U) : Prop := Definition_of_covers : - Strict_Rel_of x y -> - ~ (exists z : _, Strict_Rel_of x z /\ Strict_Rel_of z y) -> - covers y x. + Strict_Rel_of x y -> + ~ (exists z : _, Strict_Rel_of x z /\ Strict_Rel_of z y) -> + covers y x. End Partial_orders. @@ -58,43 +58,45 @@ Hint Resolve Definition_of_covers: sets v62. Section Partial_order_facts. -Variable U : Type. -Variable D : PO U. - -Lemma Strict_Rel_Transitive_with_Rel : - forall x y z:U, - Strict_Rel_of U D x y -> Rel_of U D y z -> Strict_Rel_of U D x z. -unfold Strict_Rel_of at 1 in |- *. -red in |- *. -elim D; simpl in |- *. -intros C R H' H'0; elim H'0. -intros H'1 H'2 H'3 x y z H'4 H'5; split. -apply H'2 with (y := y); tauto. -red in |- *; intro H'6. -elim H'4; intros H'7 H'8; apply H'8; clear H'4. -apply H'3; auto. -rewrite H'6; tauto. -Qed. + Variable U : Type. + Variable D : PO U. + + Lemma Strict_Rel_Transitive_with_Rel : + forall x y z:U, + Strict_Rel_of U D x y -> Rel_of U D y z -> Strict_Rel_of U D x z. + Proof. + unfold Strict_Rel_of at 1 in |- *. + red in |- *. + elim D; simpl in |- *. + intros C R H' H'0; elim H'0. + intros H'1 H'2 H'3 x y z H'4 H'5; split. + apply H'2 with (y := y); tauto. + red in |- *; intro H'6. + elim H'4; intros H'7 H'8; apply H'8; clear H'4. + apply H'3; auto. + rewrite H'6; tauto. + Qed. -Lemma Strict_Rel_Transitive_with_Rel_left : - forall x y z:U, - Rel_of U D x y -> Strict_Rel_of U D y z -> Strict_Rel_of U D x z. -unfold Strict_Rel_of at 1 in |- *. -red in |- *. -elim D; simpl in |- *. -intros C R H' H'0; elim H'0. -intros H'1 H'2 H'3 x y z H'4 H'5; split. -apply H'2 with (y := y); tauto. -red in |- *; intro H'6. -elim H'5; intros H'7 H'8; apply H'8; clear H'5. -apply H'3; auto. -rewrite <- H'6; auto. -Qed. + Lemma Strict_Rel_Transitive_with_Rel_left : + forall x y z:U, + Rel_of U D x y -> Strict_Rel_of U D y z -> Strict_Rel_of U D x z. + Proof. + unfold Strict_Rel_of at 1 in |- *. + red in |- *. + elim D; simpl in |- *. + intros C R H' H'0; elim H'0. + intros H'1 H'2 H'3 x y z H'4 H'5; split. + apply H'2 with (y := y); tauto. + red in |- *; intro H'6. + elim H'5; intros H'7 H'8; apply H'8; clear H'5. + apply H'3; auto. + rewrite <- H'6; auto. + Qed. -Lemma Strict_Rel_Transitive : Transitive U (Strict_Rel_of U D). -red in |- *. -intros x y z H' H'0. -apply Strict_Rel_Transitive_with_Rel with (y := y); - [ intuition | unfold Strict_Rel_of in H', H'0; intuition ]. -Qed. + Lemma Strict_Rel_Transitive : Transitive U (Strict_Rel_of U D). + red in |- *. + intros x y z H' H'0. + apply Strict_Rel_Transitive_with_Rel with (y := y); + [ intuition | unfold Strict_Rel_of in H', H'0; intuition ]. + Qed. End Partial_order_facts.
\ No newline at end of file diff --git a/theories/Sets/Permut.v b/theories/Sets/Permut.v index 2b6c899f..a7c3db3a 100644 --- a/theories/Sets/Permut.v +++ b/theories/Sets/Permut.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Permut.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Permut.v 9245 2006-10-17 12:53:34Z notin $ i*) (* G. Huet 1-9-95 *) @@ -15,77 +15,75 @@ Section Axiomatisation. -Variable U : Set. - -Variable op : U -> U -> U. - -Variable cong : U -> U -> Prop. - -Hypothesis op_comm : forall x y:U, cong (op x y) (op y x). -Hypothesis op_ass : forall x y z:U, cong (op (op x y) z) (op x (op y z)). - -Hypothesis cong_left : forall x y z:U, cong x y -> cong (op x z) (op y z). -Hypothesis cong_right : forall x y z:U, cong x y -> cong (op z x) (op z y). -Hypothesis cong_trans : forall x y z:U, cong x y -> cong y z -> cong x z. -Hypothesis cong_sym : forall x y:U, cong x y -> cong y x. - -(** Remark. we do not need: [Hypothesis cong_refl : (x:U)(cong x x)]. *) - -Lemma cong_congr : - forall x y z t:U, cong x y -> cong z t -> cong (op x z) (op y t). -Proof. -intros; apply cong_trans with (op y z). -apply cong_left; trivial. -apply cong_right; trivial. -Qed. - -Lemma comm_right : forall x y z:U, cong (op x (op y z)) (op x (op z y)). -Proof. -intros; apply cong_right; apply op_comm. -Qed. - -Lemma comm_left : forall x y z:U, cong (op (op x y) z) (op (op y x) z). -Proof. -intros; apply cong_left; apply op_comm. -Qed. - -Lemma perm_right : forall x y z:U, cong (op (op x y) z) (op (op x z) y). -Proof. -intros. -apply cong_trans with (op x (op y z)). -apply op_ass. -apply cong_trans with (op x (op z y)). -apply cong_right; apply op_comm. -apply cong_sym; apply op_ass. -Qed. - -Lemma perm_left : forall x y z:U, cong (op x (op y z)) (op y (op x z)). -Proof. -intros. -apply cong_trans with (op (op x y) z). -apply cong_sym; apply op_ass. -apply cong_trans with (op (op y x) z). -apply cong_left; apply op_comm. -apply op_ass. -Qed. - -Lemma op_rotate : forall x y z t:U, cong (op x (op y z)) (op z (op x y)). -Proof. -intros; apply cong_trans with (op (op x y) z). -apply cong_sym; apply op_ass. -apply op_comm. -Qed. - -(* Needed for treesort ... *) -Lemma twist : - forall x y z t:U, cong (op x (op (op y z) t)) (op (op y (op x t)) z). -Proof. -intros. -apply cong_trans with (op x (op (op y t) z)). -apply cong_right; apply perm_right. -apply cong_trans with (op (op x (op y t)) z). -apply cong_sym; apply op_ass. -apply cong_left; apply perm_left. -Qed. + Variable U : Set. + Variable op : U -> U -> U. + Variable cong : U -> U -> Prop. + + Hypothesis op_comm : forall x y:U, cong (op x y) (op y x). + Hypothesis op_ass : forall x y z:U, cong (op (op x y) z) (op x (op y z)). + + Hypothesis cong_left : forall x y z:U, cong x y -> cong (op x z) (op y z). + Hypothesis cong_right : forall x y z:U, cong x y -> cong (op z x) (op z y). + Hypothesis cong_trans : forall x y z:U, cong x y -> cong y z -> cong x z. + Hypothesis cong_sym : forall x y:U, cong x y -> cong y x. + + (** Remark. we do not need: [Hypothesis cong_refl : (x:U)(cong x x)]. *) + + Lemma cong_congr : + forall x y z t:U, cong x y -> cong z t -> cong (op x z) (op y t). + Proof. + intros; apply cong_trans with (op y z). + apply cong_left; trivial. + apply cong_right; trivial. + Qed. + + Lemma comm_right : forall x y z:U, cong (op x (op y z)) (op x (op z y)). + Proof. + intros; apply cong_right; apply op_comm. + Qed. + + Lemma comm_left : forall x y z:U, cong (op (op x y) z) (op (op y x) z). + Proof. + intros; apply cong_left; apply op_comm. + Qed. + + Lemma perm_right : forall x y z:U, cong (op (op x y) z) (op (op x z) y). + Proof. + intros. + apply cong_trans with (op x (op y z)). + apply op_ass. + apply cong_trans with (op x (op z y)). + apply cong_right; apply op_comm. + apply cong_sym; apply op_ass. + Qed. + + Lemma perm_left : forall x y z:U, cong (op x (op y z)) (op y (op x z)). + Proof. + intros. + apply cong_trans with (op (op x y) z). + apply cong_sym; apply op_ass. + apply cong_trans with (op (op y x) z). + apply cong_left; apply op_comm. + apply op_ass. + Qed. + + Lemma op_rotate : forall x y z t:U, cong (op x (op y z)) (op z (op x y)). + Proof. + intros; apply cong_trans with (op (op x y) z). + apply cong_sym; apply op_ass. + apply op_comm. + Qed. + + (** Needed for treesort ... *) + Lemma twist : + forall x y z t:U, cong (op x (op (op y z) t)) (op (op y (op x t)) z). + Proof. + intros. + apply cong_trans with (op x (op (op y t) z)). + apply cong_right; apply perm_right. + apply cong_trans with (op (op x (op y t)) z). + apply cong_sym; apply op_ass. + apply cong_left; apply perm_left. + Qed. End Axiomatisation.
\ No newline at end of file diff --git a/theories/Sets/Powerset_Classical_facts.v b/theories/Sets/Powerset_Classical_facts.v index 210017d4..47857705 100644 --- a/theories/Sets/Powerset_Classical_facts.v +++ b/theories/Sets/Powerset_Classical_facts.v @@ -24,7 +24,7 @@ (* in Summer 1995. Several developments by E. Ledinot were an inspiration. *) (****************************************************************************) -(*i $Id: Powerset_Classical_facts.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Powerset_Classical_facts.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Export Ensembles. Require Export Constructive_sets. @@ -39,298 +39,294 @@ Require Export Classical_sets. Section Sets_as_an_algebra. -Variable U : Type. + Variable U : Type. + + Lemma sincl_add_x : + forall (A B:Ensemble U) (x:U), + ~ In U A x -> + Strict_Included U (Add U A x) (Add U B x) -> Strict_Included U A B. + Proof. + intros A B x H' H'0; red in |- *. + lapply (Strict_Included_inv U (Add U A x) (Add U B x)); auto with sets. + clear H'0; intro H'0; split. + apply incl_add_x with (x := x); tauto. + elim H'0; intros H'1 H'2; elim H'2; clear H'0 H'2. + intros x0 H'0. + red in |- *; intro H'2. + elim H'0; clear H'0. + rewrite <- H'2; auto with sets. + Qed. -Lemma sincl_add_x : - forall (A B:Ensemble U) (x:U), - ~ In U A x -> - Strict_Included U (Add U A x) (Add U B x) -> Strict_Included U A B. -Proof. -intros A B x H' H'0; red in |- *. -lapply (Strict_Included_inv U (Add U A x) (Add U B x)); auto with sets. -clear H'0; intro H'0; split. -apply incl_add_x with (x := x); tauto. -elim H'0; intros H'1 H'2; elim H'2; clear H'0 H'2. -intros x0 H'0. -red in |- *; intro H'2. -elim H'0; clear H'0. -rewrite <- H'2; auto with sets. -Qed. + Lemma incl_soustr_in : + forall (X:Ensemble U) (x:U), In U X x -> Included U (Subtract U X x) X. + Proof. + intros X x H'; red in |- *. + intros x0 H'0; elim H'0; auto with sets. + Qed. + + Lemma incl_soustr : + forall (X Y:Ensemble U) (x:U), + Included U X Y -> Included U (Subtract U X x) (Subtract U Y x). + Proof. + intros X Y x H'; red in |- *. + intros x0 H'0; elim H'0. + intros H'1 H'2. + apply Subtract_intro; auto with sets. + Qed. + + Lemma incl_soustr_add_l : + forall (X:Ensemble U) (x:U), Included U (Subtract U (Add U X x) x) X. + Proof. + intros X x; red in |- *. + intros x0 H'; elim H'; auto with sets. + intro H'0; elim H'0; auto with sets. + intros t H'1 H'2; elim H'2; auto with sets. + Qed. -Lemma incl_soustr_in : - forall (X:Ensemble U) (x:U), In U X x -> Included U (Subtract U X x) X. -Proof. -intros X x H'; red in |- *. -intros x0 H'0; elim H'0; auto with sets. -Qed. -Hint Resolve incl_soustr_in: sets v62. - -Lemma incl_soustr : - forall (X Y:Ensemble U) (x:U), - Included U X Y -> Included U (Subtract U X x) (Subtract U Y x). -Proof. -intros X Y x H'; red in |- *. -intros x0 H'0; elim H'0. -intros H'1 H'2. -apply Subtract_intro; auto with sets. -Qed. -Hint Resolve incl_soustr: sets v62. - - -Lemma incl_soustr_add_l : - forall (X:Ensemble U) (x:U), Included U (Subtract U (Add U X x) x) X. -Proof. -intros X x; red in |- *. -intros x0 H'; elim H'; auto with sets. -intro H'0; elim H'0; auto with sets. -intros t H'1 H'2; elim H'2; auto with sets. -Qed. -Hint Resolve incl_soustr_add_l: sets v62. + Lemma incl_soustr_add_r : + forall (X:Ensemble U) (x:U), + ~ In U X x -> Included U X (Subtract U (Add U X x) x). + Proof. + intros X x H'; red in |- *. + intros x0 H'0; try assumption. + apply Subtract_intro; auto with sets. + red in |- *; intro H'1; apply H'; rewrite H'1; auto with sets. + Qed. + Hint Resolve incl_soustr_add_r: sets v62. + + Lemma add_soustr_2 : + forall (X:Ensemble U) (x:U), + In U X x -> Included U X (Add U (Subtract U X x) x). + Proof. + intros X x H'; red in |- *. + intros x0 H'0; try assumption. + elim (classic (x = x0)); intro K; auto with sets. + elim K; auto with sets. + Qed. + + Lemma add_soustr_1 : + forall (X:Ensemble U) (x:U), + In U X x -> Included U (Add U (Subtract U X x) x) X. + Proof. + intros X x H'; red in |- *. + intros x0 H'0; elim H'0; auto with sets. + intros y H'1; elim H'1; auto with sets. + intros t H'1; try assumption. + rewrite <- (Singleton_inv U x t); auto with sets. + Qed. + + Lemma add_soustr_xy : + forall (X:Ensemble U) (x y:U), + x <> y -> Subtract U (Add U X x) y = Add U (Subtract U X y) x. + Proof. + intros X x y H'; apply Extensionality_Ensembles. + split; red in |- *. + intros x0 H'0; elim H'0; auto with sets. + intro H'1; elim H'1. + intros u H'2 H'3; try assumption. + apply Add_intro1. + apply Subtract_intro; auto with sets. + intros t H'2 H'3; try assumption. + elim (Singleton_inv U x t); auto with sets. + intros u H'2; try assumption. + elim (Add_inv U (Subtract U X y) x u); auto with sets. + intro H'0; elim H'0; auto with sets. + intro H'0; rewrite <- H'0; auto with sets. + Qed. + + Lemma incl_st_add_soustr : + forall (X Y:Ensemble U) (x:U), + ~ In U X x -> + Strict_Included U (Add U X x) Y -> Strict_Included U X (Subtract U Y x). + Proof. + intros X Y x H' H'0; apply sincl_add_x with (x := x); auto using add_soustr_1 with sets. + split. + elim H'0. + intros H'1 H'2. + generalize (Inclusion_is_transitive U). + intro H'4; red in H'4. + apply H'4 with (y := Y); auto using add_soustr_2 with sets. + red in H'0. + elim H'0; intros H'1 H'2; try exact H'1; clear H'0. (* PB *) + red in |- *; intro H'0; apply H'2. + rewrite H'0; auto 8 using add_soustr_xy, add_soustr_1, add_soustr_2 with sets. + Qed. + + Lemma Sub_Add_new : + forall (X:Ensemble U) (x:U), ~ In U X x -> X = Subtract U (Add U X x) x. + Proof. + auto using incl_soustr_add_l with sets. + Qed. + + Lemma Simplify_add : + forall (X X0:Ensemble U) (x:U), + ~ In U X x -> ~ In U X0 x -> Add U X x = Add U X0 x -> X = X0. + Proof. + intros X X0 x H' H'0 H'1; try assumption. + rewrite (Sub_Add_new X x); auto with sets. + rewrite (Sub_Add_new X0 x); auto with sets. + rewrite H'1; auto with sets. + Qed. + + Lemma Included_Add : + forall (X A:Ensemble U) (x:U), + Included U X (Add U A x) -> + Included U X A \/ (exists A' : _, X = Add U A' x /\ Included U A' A). + Proof. + intros X A x H'0; try assumption. + elim (classic (In U X x)). + intro H'1; right; try assumption. + exists (Subtract U X x). + split; auto using incl_soustr_in, add_soustr_xy, add_soustr_1, add_soustr_2 with sets. + red in H'0. + red in |- *. + intros x0 H'2; try assumption. + lapply (Subtract_inv U X x x0); auto with sets. + intro H'3; elim H'3; intros K K'; clear H'3. + lapply (H'0 x0); auto with sets. + intro H'3; try assumption. + lapply (Add_inv U A x x0); auto with sets. + intro H'4; elim H'4; + [ intro H'5; try exact H'5; clear H'4 | intro H'5; clear H'4 ]. + elim K'; auto with sets. + intro H'1; left; try assumption. + red in H'0. + red in |- *. + intros x0 H'2; try assumption. + lapply (H'0 x0); auto with sets. + intro H'3; try assumption. + lapply (Add_inv U A x x0); auto with sets. + intro H'4; elim H'4; + [ intro H'5; try exact H'5; clear H'4 | intro H'5; clear H'4 ]. + absurd (In U X x0); auto with sets. + rewrite <- H'5; auto with sets. + Qed. + + Lemma setcover_inv : + forall A x y:Ensemble U, + covers (Ensemble U) (Power_set_PO U A) y x -> + Strict_Included U x y /\ + (forall z:Ensemble U, Included U x z -> Included U z y -> x = z \/ z = y). + Proof. + intros A x y H'; elim H'. + unfold Strict_Rel_of in |- *; simpl in |- *. + intros H'0 H'1; split; [ auto with sets | idtac ]. + intros z H'2 H'3; try assumption. + elim (classic (x = z)); auto with sets. + intro H'4; right; try assumption. + elim (classic (z = y)); auto with sets. + intro H'5; try assumption. + elim H'1. + exists z; auto with sets. + Qed. + + Theorem Add_covers : + forall A a:Ensemble U, + Included U a A -> + forall x:U, + In U A x -> + ~ In U a x -> covers (Ensemble U) (Power_set_PO U A) (Add U a x) a. + Proof. + intros A a H' x H'0 H'1; try assumption. + apply setcover_intro; auto with sets. + red in |- *. + split; [ idtac | red in |- *; intro H'2; try exact H'2 ]; auto with sets. + apply H'1. + rewrite H'2; auto with sets. + red in |- *; intro H'2; elim H'2; clear H'2. + intros z H'2; elim H'2; intros H'3 H'4; try exact H'3; clear H'2. + lapply (Strict_Included_inv U a z); auto with sets; clear H'3. + intro H'2; elim H'2; intros H'3 H'5; elim H'5; clear H'2 H'5. + intros x0 H'2; elim H'2. + intros H'5 H'6; try assumption. + generalize H'4; intro K. + red in H'4. + elim H'4; intros H'8 H'9; red in H'8; clear H'4. + lapply (H'8 x0); auto with sets. + intro H'7; try assumption. + elim (Add_inv U a x x0); auto with sets. + intro H'15. + cut (Included U (Add U a x) z). + intro H'10; try assumption. + red in K. + elim K; intros H'11 H'12; apply H'12; clear K; auto with sets. + rewrite H'15. + red in |- *. + intros x1 H'10; elim H'10; auto with sets. + intros x2 H'11; elim H'11; auto with sets. + Qed. + + Theorem covers_Add : + forall A a a':Ensemble U, + Included U a A -> + Included U a' A -> + covers (Ensemble U) (Power_set_PO U A) a' a -> + exists x : _, a' = Add U a x /\ In U A x /\ ~ In U a x. + Proof. + intros A a a' H' H'0 H'1; try assumption. + elim (setcover_inv A a a'); auto with sets. + intros H'6 H'7. + clear H'1. + elim (Strict_Included_inv U a a'); auto with sets. + intros H'5 H'8; elim H'8. + intros x H'1; elim H'1. + intros H'2 H'3; try assumption. + exists x. + split; [ try assumption | idtac ]. + clear H'8 H'1. + elim (H'7 (Add U a x)); auto with sets. + intro H'1. + absurd (a = Add U a x); auto with sets. + red in |- *; intro H'8; try exact H'8. + apply H'3. + rewrite H'8; auto with sets. + auto with sets. + red in |- *. + intros x0 H'1; elim H'1; auto with sets. + intros x1 H'8; elim H'8; auto with sets. + split; [ idtac | try assumption ]. + red in H'0; auto with sets. + Qed. -Lemma incl_soustr_add_r : - forall (X:Ensemble U) (x:U), - ~ In U X x -> Included U X (Subtract U (Add U X x) x). -Proof. -intros X x H'; red in |- *. -intros x0 H'0; try assumption. -apply Subtract_intro; auto with sets. -red in |- *; intro H'1; apply H'; rewrite H'1; auto with sets. -Qed. -Hint Resolve incl_soustr_add_r: sets v62. - -Lemma add_soustr_2 : - forall (X:Ensemble U) (x:U), - In U X x -> Included U X (Add U (Subtract U X x) x). -Proof. -intros X x H'; red in |- *. -intros x0 H'0; try assumption. -elim (classic (x = x0)); intro K; auto with sets. -elim K; auto with sets. -Qed. - -Lemma add_soustr_1 : - forall (X:Ensemble U) (x:U), - In U X x -> Included U (Add U (Subtract U X x) x) X. -Proof. -intros X x H'; red in |- *. -intros x0 H'0; elim H'0; auto with sets. -intros y H'1; elim H'1; auto with sets. -intros t H'1; try assumption. -rewrite <- (Singleton_inv U x t); auto with sets. -Qed. -Hint Resolve add_soustr_1 add_soustr_2: sets v62. - -Lemma add_soustr_xy : - forall (X:Ensemble U) (x y:U), - x <> y -> Subtract U (Add U X x) y = Add U (Subtract U X y) x. -Proof. -intros X x y H'; apply Extensionality_Ensembles. -split; red in |- *. -intros x0 H'0; elim H'0; auto with sets. -intro H'1; elim H'1. -intros u H'2 H'3; try assumption. -apply Add_intro1. -apply Subtract_intro; auto with sets. -intros t H'2 H'3; try assumption. -elim (Singleton_inv U x t); auto with sets. -intros u H'2; try assumption. -elim (Add_inv U (Subtract U X y) x u); auto with sets. -intro H'0; elim H'0; auto with sets. -intro H'0; rewrite <- H'0; auto with sets. -Qed. -Hint Resolve add_soustr_xy: sets v62. - -Lemma incl_st_add_soustr : - forall (X Y:Ensemble U) (x:U), - ~ In U X x -> - Strict_Included U (Add U X x) Y -> Strict_Included U X (Subtract U Y x). -Proof. -intros X Y x H' H'0; apply sincl_add_x with (x := x); auto with sets. -split. -elim H'0. -intros H'1 H'2. -generalize (Inclusion_is_transitive U). -intro H'4; red in H'4. -apply H'4 with (y := Y); auto with sets. -red in H'0. -elim H'0; intros H'1 H'2; try exact H'1; clear H'0. (* PB *) -red in |- *; intro H'0; apply H'2. -rewrite H'0; auto 8 with sets. -Qed. - -Lemma Sub_Add_new : - forall (X:Ensemble U) (x:U), ~ In U X x -> X = Subtract U (Add U X x) x. -Proof. -auto with sets. -Qed. - -Lemma Simplify_add : - forall (X X0:Ensemble U) (x:U), - ~ In U X x -> ~ In U X0 x -> Add U X x = Add U X0 x -> X = X0. -Proof. -intros X X0 x H' H'0 H'1; try assumption. -rewrite (Sub_Add_new X x); auto with sets. -rewrite (Sub_Add_new X0 x); auto with sets. -rewrite H'1; auto with sets. -Qed. - -Lemma Included_Add : - forall (X A:Ensemble U) (x:U), - Included U X (Add U A x) -> - Included U X A \/ (exists A' : _, X = Add U A' x /\ Included U A' A). -Proof. -intros X A x H'0; try assumption. -elim (classic (In U X x)). -intro H'1; right; try assumption. -exists (Subtract U X x). -split; auto with sets. -red in H'0. -red in |- *. -intros x0 H'2; try assumption. -lapply (Subtract_inv U X x x0); auto with sets. -intro H'3; elim H'3; intros K K'; clear H'3. -lapply (H'0 x0); auto with sets. -intro H'3; try assumption. -lapply (Add_inv U A x x0); auto with sets. -intro H'4; elim H'4; - [ intro H'5; try exact H'5; clear H'4 | intro H'5; clear H'4 ]. -elim K'; auto with sets. -intro H'1; left; try assumption. -red in H'0. -red in |- *. -intros x0 H'2; try assumption. -lapply (H'0 x0); auto with sets. -intro H'3; try assumption. -lapply (Add_inv U A x x0); auto with sets. -intro H'4; elim H'4; - [ intro H'5; try exact H'5; clear H'4 | intro H'5; clear H'4 ]. -absurd (In U X x0); auto with sets. -rewrite <- H'5; auto with sets. -Qed. - -Lemma setcover_inv : - forall A x y:Ensemble U, - covers (Ensemble U) (Power_set_PO U A) y x -> - Strict_Included U x y /\ - (forall z:Ensemble U, Included U x z -> Included U z y -> x = z \/ z = y). -Proof. -intros A x y H'; elim H'. -unfold Strict_Rel_of in |- *; simpl in |- *. -intros H'0 H'1; split; [ auto with sets | idtac ]. -intros z H'2 H'3; try assumption. -elim (classic (x = z)); auto with sets. -intro H'4; right; try assumption. -elim (classic (z = y)); auto with sets. -intro H'5; try assumption. -elim H'1. -exists z; auto with sets. -Qed. - -Theorem Add_covers : - forall A a:Ensemble U, - Included U a A -> - forall x:U, - In U A x -> - ~ In U a x -> covers (Ensemble U) (Power_set_PO U A) (Add U a x) a. -Proof. -intros A a H' x H'0 H'1; try assumption. -apply setcover_intro; auto with sets. -red in |- *. -split; [ idtac | red in |- *; intro H'2; try exact H'2 ]; auto with sets. -apply H'1. -rewrite H'2; auto with sets. -red in |- *; intro H'2; elim H'2; clear H'2. -intros z H'2; elim H'2; intros H'3 H'4; try exact H'3; clear H'2. -lapply (Strict_Included_inv U a z); auto with sets; clear H'3. -intro H'2; elim H'2; intros H'3 H'5; elim H'5; clear H'2 H'5. -intros x0 H'2; elim H'2. -intros H'5 H'6; try assumption. -generalize H'4; intro K. -red in H'4. -elim H'4; intros H'8 H'9; red in H'8; clear H'4. -lapply (H'8 x0); auto with sets. -intro H'7; try assumption. -elim (Add_inv U a x x0); auto with sets. -intro H'15. -cut (Included U (Add U a x) z). -intro H'10; try assumption. -red in K. -elim K; intros H'11 H'12; apply H'12; clear K; auto with sets. -rewrite H'15. -red in |- *. -intros x1 H'10; elim H'10; auto with sets. -intros x2 H'11; elim H'11; auto with sets. -Qed. - -Theorem covers_Add : - forall A a a':Ensemble U, - Included U a A -> - Included U a' A -> - covers (Ensemble U) (Power_set_PO U A) a' a -> - exists x : _, a' = Add U a x /\ In U A x /\ ~ In U a x. -Proof. -intros A a a' H' H'0 H'1; try assumption. -elim (setcover_inv A a a'); auto with sets. -intros H'6 H'7. -clear H'1. -elim (Strict_Included_inv U a a'); auto with sets. -intros H'5 H'8; elim H'8. -intros x H'1; elim H'1. -intros H'2 H'3; try assumption. -exists x. -split; [ try assumption | idtac ]. -clear H'8 H'1. -elim (H'7 (Add U a x)); auto with sets. -intro H'1. -absurd (a = Add U a x); auto with sets. -red in |- *; intro H'8; try exact H'8. -apply H'3. -rewrite H'8; auto with sets. -auto with sets. -red in |- *. -intros x0 H'1; elim H'1; auto with sets. -intros x1 H'8; elim H'8; auto with sets. -split; [ idtac | try assumption ]. -red in H'0; auto with sets. -Qed. - -Theorem covers_is_Add : - forall A a a':Ensemble U, - Included U a A -> - Included U a' A -> - (covers (Ensemble U) (Power_set_PO U A) a' a <-> - (exists x : _, a' = Add U a x /\ In U A x /\ ~ In U a x)). -Proof. -intros A a a' H' H'0; split; intro K. -apply covers_Add with (A := A); auto with sets. -elim K. -intros x H'1; elim H'1; intros H'2 H'3; rewrite H'2; clear H'1. -apply Add_covers; intuition. -Qed. - -Theorem Singleton_atomic : - forall (x:U) (A:Ensemble U), - In U A x -> - covers (Ensemble U) (Power_set_PO U A) (Singleton U x) (Empty_set U). -intros x A H'. -rewrite <- (Empty_set_zero' U x). -apply Add_covers; auto with sets. -Qed. - -Lemma less_than_singleton : - forall (X:Ensemble U) (x:U), - Strict_Included U X (Singleton U x) -> X = Empty_set U. -intros X x H'; try assumption. -red in H'. -lapply (Singleton_atomic x (Full_set U)); - [ intro H'2; try exact H'2 | apply Full_intro ]. -elim H'; intros H'0 H'1; try exact H'1; clear H'. -elim (setcover_inv (Full_set U) (Empty_set U) (Singleton U x)); - [ intros H'6 H'7; try exact H'7 | idtac ]; auto with sets. -elim (H'7 X); [ intro H'5; try exact H'5 | intro H'5 | idtac | idtac ]; - auto with sets. -elim H'1; auto with sets. -Qed. + Theorem covers_is_Add : + forall A a a':Ensemble U, + Included U a A -> + Included U a' A -> + (covers (Ensemble U) (Power_set_PO U A) a' a <-> + (exists x : _, a' = Add U a x /\ In U A x /\ ~ In U a x)). + Proof. + intros A a a' H' H'0; split; intro K. + apply covers_Add with (A := A); auto with sets. + elim K. + intros x H'1; elim H'1; intros H'2 H'3; rewrite H'2; clear H'1. + apply Add_covers; intuition. + Qed. + + Theorem Singleton_atomic : + forall (x:U) (A:Ensemble U), + In U A x -> + covers (Ensemble U) (Power_set_PO U A) (Singleton U x) (Empty_set U). + Proof. + intros x A H'. + rewrite <- (Empty_set_zero' U x). + apply Add_covers; auto with sets. + Qed. + + Lemma less_than_singleton : + forall (X:Ensemble U) (x:U), + Strict_Included U X (Singleton U x) -> X = Empty_set U. + Proof. + intros X x H'; try assumption. + red in H'. + lapply (Singleton_atomic x (Full_set U)); + [ intro H'2; try exact H'2 | apply Full_intro ]. + elim H'; intros H'0 H'1; try exact H'1; clear H'. + elim (setcover_inv (Full_set U) (Empty_set U) (Singleton U x)); + [ intros H'6 H'7; try exact H'7 | idtac ]; auto with sets. + elim (H'7 X); [ intro H'5; try exact H'5 | intro H'5 | idtac | idtac ]; + auto with sets. + elim H'1; auto with sets. + Qed. End Sets_as_an_algebra. @@ -339,4 +335,4 @@ Hint Resolve incl_soustr: sets v62. Hint Resolve incl_soustr_add_l: sets v62. Hint Resolve incl_soustr_add_r: sets v62. Hint Resolve add_soustr_1 add_soustr_2: sets v62. -Hint Resolve add_soustr_xy: sets v62.
\ No newline at end of file +Hint Resolve add_soustr_xy: sets v62. diff --git a/theories/Sets/Powerset_facts.v b/theories/Sets/Powerset_facts.v index 47ef2ea7..edb6a215 100644 --- a/theories/Sets/Powerset_facts.v +++ b/theories/Sets/Powerset_facts.v @@ -24,7 +24,7 @@ (* in Summer 1995. Several developments by E. Ledinot were an inspiration. *) (****************************************************************************) -(*i $Id: Powerset_facts.v 8642 2006-03-17 10:09:02Z notin $ i*) +(*i $Id: Powerset_facts.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Export Ensembles. Require Export Constructive_sets. @@ -35,231 +35,223 @@ Require Export Cpo. Require Export Powerset. Section Sets_as_an_algebra. -Variable U : Type. -Hint Unfold not. + Variable U : Type. -Theorem Empty_set_zero : forall X:Ensemble U, Union U (Empty_set U) X = X. -Proof. -auto 6 with sets. -Qed. -Hint Resolve Empty_set_zero. + Theorem Empty_set_zero : forall X:Ensemble U, Union U (Empty_set U) X = X. + Proof. + auto 6 with sets. + Qed. + + Theorem Empty_set_zero' : forall x:U, Add U (Empty_set U) x = Singleton U x. + Proof. + unfold Add at 1 in |- *; auto using Empty_set_zero with sets. + Qed. + + Lemma less_than_empty : + forall X:Ensemble U, Included U X (Empty_set U) -> X = Empty_set U. + Proof. + auto with sets. + Qed. + + Theorem Union_commutative : forall A B:Ensemble U, Union U A B = Union U B A. + Proof. + auto with sets. + Qed. + + Theorem Union_associative : + forall A B C:Ensemble U, Union U (Union U A B) C = Union U A (Union U B C). + Proof. + auto 9 with sets. + Qed. + + Theorem Union_idempotent : forall A:Ensemble U, Union U A A = A. + Proof. + auto 7 with sets. + Qed. + + Lemma Union_absorbs : + forall A B:Ensemble U, Included U B A -> Union U A B = A. + Proof. + auto 7 with sets. + Qed. -Theorem Empty_set_zero' : forall x:U, Add U (Empty_set U) x = Singleton U x. -Proof. -unfold Add at 1 in |- *; auto with sets. -Qed. -Hint Resolve Empty_set_zero'. + Theorem Couple_as_union : + forall x y:U, Union U (Singleton U x) (Singleton U y) = Couple U x y. + Proof. + intros x y; apply Extensionality_Ensembles; split; red in |- *. + intros x0 H'; elim H'; (intros x1 H'0; elim H'0; auto with sets). + intros x0 H'; elim H'; auto with sets. + Qed. + + Theorem Triple_as_union : + forall x y z:U, + Union U (Union U (Singleton U x) (Singleton U y)) (Singleton U z) = + Triple U x y z. + Proof. + intros x y z; apply Extensionality_Ensembles; split; red in |- *. + intros x0 H'; elim H'. + intros x1 H'0; elim H'0; (intros x2 H'1; elim H'1; auto with sets). + intros x1 H'0; elim H'0; auto with sets. + intros x0 H'; elim H'; auto with sets. + Qed. + + Theorem Triple_as_Couple : forall x y:U, Couple U x y = Triple U x x y. + Proof. + intros x y. + rewrite <- (Couple_as_union x y). + rewrite <- (Union_idempotent (Singleton U x)). + apply Triple_as_union. + Qed. + + Theorem Triple_as_Couple_Singleton : + forall x y z:U, Triple U x y z = Union U (Couple U x y) (Singleton U z). + Proof. + intros x y z. + rewrite <- (Triple_as_union x y z). + rewrite <- (Couple_as_union x y); auto with sets. + Qed. + + Theorem Intersection_commutative : + forall A B:Ensemble U, Intersection U A B = Intersection U B A. + Proof. + intros A B. + apply Extensionality_Ensembles. + split; red in |- *; intros x H'; elim H'; auto with sets. + Qed. + + Theorem Distributivity : + forall A B C:Ensemble U, + Intersection U A (Union U B C) = + Union U (Intersection U A B) (Intersection U A C). + Proof. + intros A B C. + apply Extensionality_Ensembles. + split; red in |- *; intros x H'. + elim H'. + intros x0 H'0 H'1; generalize H'0. + elim H'1; auto with sets. + elim H'; intros x0 H'0; elim H'0; auto with sets. + Qed. + + Theorem Distributivity' : + forall A B C:Ensemble U, + Union U A (Intersection U B C) = + Intersection U (Union U A B) (Union U A C). + Proof. + intros A B C. + apply Extensionality_Ensembles. + split; red in |- *; intros x H'. + elim H'; auto with sets. + intros x0 H'0; elim H'0; auto with sets. + elim H'. + intros x0 H'0; elim H'0; auto with sets. + intros x1 H'1 H'2; try exact H'2. + generalize H'1. + elim H'2; auto with sets. + Qed. + + Theorem Union_add : + forall (A B:Ensemble U) (x:U), Add U (Union U A B) x = Union U A (Add U B x). + Proof. + unfold Add in |- *; auto using Union_associative with sets. + Qed. + + Theorem Non_disjoint_union : + forall (X:Ensemble U) (x:U), In U X x -> Add U X x = X. + Proof. + intros X x H'; unfold Add in |- *. + apply Extensionality_Ensembles; red in |- *. + split; red in |- *; auto with sets. + intros x0 H'0; elim H'0; auto with sets. + intros t H'1; elim H'1; auto with sets. + Qed. + + Theorem Non_disjoint_union' : + forall (X:Ensemble U) (x:U), ~ In U X x -> Subtract U X x = X. + Proof. + intros X x H'; unfold Subtract in |- *. + apply Extensionality_Ensembles. + split; red in |- *; auto with sets. + intros x0 H'0; elim H'0; auto with sets. + intros x0 H'0; apply Setminus_intro; auto with sets. + red in |- *; intro H'1; elim H'1. + lapply (Singleton_inv U x x0); auto with sets. + intro H'4; apply H'; rewrite H'4; auto with sets. + Qed. + + Lemma singlx : forall x y:U, In U (Add U (Empty_set U) x) y -> x = y. + Proof. + intro x; rewrite (Empty_set_zero' x); auto with sets. + Qed. + + Lemma incl_add : + forall (A B:Ensemble U) (x:U), + Included U A B -> Included U (Add U A x) (Add U B x). + Proof. + intros A B x H'; red in |- *; auto with sets. + intros x0 H'0. + lapply (Add_inv U A x x0); auto with sets. + intro H'1; elim H'1; + [ intro H'2; clear H'1 | intro H'2; rewrite <- H'2; clear H'1 ]; + auto with sets. + Qed. -Lemma less_than_empty : - forall X:Ensemble U, Included U X (Empty_set U) -> X = Empty_set U. -Proof. -auto with sets. -Qed. -Hint Resolve less_than_empty. + Lemma incl_add_x : + forall (A B:Ensemble U) (x:U), + ~ In U A x -> Included U (Add U A x) (Add U B x) -> Included U A B. + Proof. + unfold Included in |- *. + intros A B x H' H'0 x0 H'1. + lapply (H'0 x0); auto with sets. + intro H'2; lapply (Add_inv U B x x0); auto with sets. + intro H'3; elim H'3; + [ intro H'4; try exact H'4; clear H'3 | intro H'4; clear H'3 ]. + absurd (In U A x0); auto with sets. + rewrite <- H'4; auto with sets. + Qed. + + Lemma Add_commutative : + forall (A:Ensemble U) (x y:U), Add U (Add U A x) y = Add U (Add U A y) x. + Proof. + intros A x y. + unfold Add in |- *. + rewrite (Union_associative A (Singleton U x) (Singleton U y)). + rewrite (Union_commutative (Singleton U x) (Singleton U y)). + rewrite <- (Union_associative A (Singleton U y) (Singleton U x)); + auto with sets. + Qed. + + Lemma Add_commutative' : + forall (A:Ensemble U) (x y z:U), + Add U (Add U (Add U A x) y) z = Add U (Add U (Add U A z) x) y. + Proof. + intros A x y z. + rewrite (Add_commutative (Add U A x) y z). + rewrite (Add_commutative A x z); auto with sets. + Qed. + + Lemma Add_distributes : + forall (A B:Ensemble U) (x y:U), + Included U B A -> Add U (Add U A x) y = Union U (Add U A x) (Add U B y). + Proof. + intros A B x y H'; try assumption. + rewrite <- (Union_add (Add U A x) B y). + unfold Add at 4 in |- *. + rewrite (Union_commutative A (Singleton U x)). + rewrite Union_associative. + rewrite (Union_absorbs A B H'). + rewrite (Union_commutative (Singleton U x) A). + auto with sets. + Qed. -Theorem Union_commutative : forall A B:Ensemble U, Union U A B = Union U B A. -Proof. -auto with sets. -Qed. - -Theorem Union_associative : - forall A B C:Ensemble U, Union U (Union U A B) C = Union U A (Union U B C). -Proof. -auto 9 with sets. -Qed. -Hint Resolve Union_associative. - -Theorem Union_idempotent : forall A:Ensemble U, Union U A A = A. -Proof. -auto 7 with sets. -Qed. - -Lemma Union_absorbs : - forall A B:Ensemble U, Included U B A -> Union U A B = A. -Proof. -auto 7 with sets. -Qed. - -Theorem Couple_as_union : - forall x y:U, Union U (Singleton U x) (Singleton U y) = Couple U x y. -Proof. -intros x y; apply Extensionality_Ensembles; split; red in |- *. -intros x0 H'; elim H'; (intros x1 H'0; elim H'0; auto with sets). -intros x0 H'; elim H'; auto with sets. -Qed. - -Theorem Triple_as_union : - forall x y z:U, - Union U (Union U (Singleton U x) (Singleton U y)) (Singleton U z) = - Triple U x y z. -Proof. -intros x y z; apply Extensionality_Ensembles; split; red in |- *. -intros x0 H'; elim H'. -intros x1 H'0; elim H'0; (intros x2 H'1; elim H'1; auto with sets). -intros x1 H'0; elim H'0; auto with sets. -intros x0 H'; elim H'; auto with sets. -Qed. - -Theorem Triple_as_Couple : forall x y:U, Couple U x y = Triple U x x y. -Proof. -intros x y. -rewrite <- (Couple_as_union x y). -rewrite <- (Union_idempotent (Singleton U x)). -apply Triple_as_union. -Qed. - -Theorem Triple_as_Couple_Singleton : - forall x y z:U, Triple U x y z = Union U (Couple U x y) (Singleton U z). -Proof. -intros x y z. -rewrite <- (Triple_as_union x y z). -rewrite <- (Couple_as_union x y); auto with sets. -Qed. - -Theorem Intersection_commutative : - forall A B:Ensemble U, Intersection U A B = Intersection U B A. -Proof. -intros A B. -apply Extensionality_Ensembles. -split; red in |- *; intros x H'; elim H'; auto with sets. -Qed. - -Theorem Distributivity : - forall A B C:Ensemble U, - Intersection U A (Union U B C) = - Union U (Intersection U A B) (Intersection U A C). -Proof. -intros A B C. -apply Extensionality_Ensembles. -split; red in |- *; intros x H'. -elim H'. -intros x0 H'0 H'1; generalize H'0. -elim H'1; auto with sets. -elim H'; intros x0 H'0; elim H'0; auto with sets. -Qed. - -Theorem Distributivity' : - forall A B C:Ensemble U, - Union U A (Intersection U B C) = - Intersection U (Union U A B) (Union U A C). -Proof. -intros A B C. -apply Extensionality_Ensembles. -split; red in |- *; intros x H'. -elim H'; auto with sets. -intros x0 H'0; elim H'0; auto with sets. -elim H'. -intros x0 H'0; elim H'0; auto with sets. -intros x1 H'1 H'2; try exact H'2. -generalize H'1. -elim H'2; auto with sets. -Qed. - -Theorem Union_add : - forall (A B:Ensemble U) (x:U), Add U (Union U A B) x = Union U A (Add U B x). -Proof. -unfold Add in |- *; auto with sets. -Qed. -Hint Resolve Union_add. - -Theorem Non_disjoint_union : - forall (X:Ensemble U) (x:U), In U X x -> Add U X x = X. -intros X x H'; unfold Add in |- *. -apply Extensionality_Ensembles; red in |- *. -split; red in |- *; auto with sets. -intros x0 H'0; elim H'0; auto with sets. -intros t H'1; elim H'1; auto with sets. -Qed. - -Theorem Non_disjoint_union' : - forall (X:Ensemble U) (x:U), ~ In U X x -> Subtract U X x = X. -Proof. -intros X x H'; unfold Subtract in |- *. -apply Extensionality_Ensembles. -split; red in |- *; auto with sets. -intros x0 H'0; elim H'0; auto with sets. -intros x0 H'0; apply Setminus_intro; auto with sets. -red in |- *; intro H'1; elim H'1. -lapply (Singleton_inv U x x0); auto with sets. -intro H'4; apply H'; rewrite H'4; auto with sets. -Qed. - -Lemma singlx : forall x y:U, In U (Add U (Empty_set U) x) y -> x = y. -Proof. -intro x; rewrite (Empty_set_zero' x); auto with sets. -Qed. -Hint Resolve singlx. - -Lemma incl_add : - forall (A B:Ensemble U) (x:U), - Included U A B -> Included U (Add U A x) (Add U B x). -Proof. -intros A B x H'; red in |- *; auto with sets. -intros x0 H'0. -lapply (Add_inv U A x x0); auto with sets. -intro H'1; elim H'1; - [ intro H'2; clear H'1 | intro H'2; rewrite <- H'2; clear H'1 ]; - auto with sets. -Qed. -Hint Resolve incl_add. - -Lemma incl_add_x : - forall (A B:Ensemble U) (x:U), - ~ In U A x -> Included U (Add U A x) (Add U B x) -> Included U A B. -Proof. -unfold Included in |- *. -intros A B x H' H'0 x0 H'1. -lapply (H'0 x0); auto with sets. -intro H'2; lapply (Add_inv U B x x0); auto with sets. -intro H'3; elim H'3; - [ intro H'4; try exact H'4; clear H'3 | intro H'4; clear H'3 ]. -absurd (In U A x0); auto with sets. -rewrite <- H'4; auto with sets. -Qed. - -Lemma Add_commutative : - forall (A:Ensemble U) (x y:U), Add U (Add U A x) y = Add U (Add U A y) x. -Proof. -intros A x y. -unfold Add in |- *. -rewrite (Union_associative A (Singleton U x) (Singleton U y)). -rewrite (Union_commutative (Singleton U x) (Singleton U y)). -rewrite <- (Union_associative A (Singleton U y) (Singleton U x)); - auto with sets. -Qed. - -Lemma Add_commutative' : - forall (A:Ensemble U) (x y z:U), - Add U (Add U (Add U A x) y) z = Add U (Add U (Add U A z) x) y. -Proof. -intros A x y z. -rewrite (Add_commutative (Add U A x) y z). -rewrite (Add_commutative A x z); auto with sets. -Qed. - -Lemma Add_distributes : - forall (A B:Ensemble U) (x y:U), - Included U B A -> Add U (Add U A x) y = Union U (Add U A x) (Add U B y). -Proof. -intros A B x y H'; try assumption. -rewrite <- (Union_add (Add U A x) B y). -unfold Add at 4 in |- *. -rewrite (Union_commutative A (Singleton U x)). -rewrite Union_associative. -rewrite (Union_absorbs A B H'). -rewrite (Union_commutative (Singleton U x) A). -auto with sets. -Qed. - -Lemma setcover_intro : - forall (U:Type) (A x y:Ensemble U), - Strict_Included U x y -> - ~ (exists z : _, Strict_Included U x z /\ Strict_Included U z y) -> - covers (Ensemble U) (Power_set_PO U A) y x. -Proof. -intros; apply Definition_of_covers; auto with sets. -Qed. -Hint Resolve setcover_intro. + Lemma setcover_intro : + forall (U:Type) (A x y:Ensemble U), + Strict_Included U x y -> + ~ (exists z : _, Strict_Included U x z /\ Strict_Included U z y) -> + covers (Ensemble U) (Power_set_PO U A) y x. + Proof. + intros; apply Definition_of_covers; auto with sets. + Qed. End Sets_as_an_algebra. diff --git a/theories/Sorting/Heap.v b/theories/Sorting/Heap.v index 346ae95a..e1e026f5 100644 --- a/theories/Sorting/Heap.v +++ b/theories/Sorting/Heap.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Heap.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Heap.v 9245 2006-10-17 12:53:34Z notin $ i*) (** A development of Treesort on Heap trees *) @@ -21,207 +21,216 @@ Require Import Sorting. Section defs. -Variable A : Set. -Variable leA : relation A. -Variable eqA : relation A. + (** * Trees and heap trees *) -Let gtA (x y:A) := ~ leA x y. + (** ** Definition of trees over an ordered set *) -Hypothesis leA_dec : forall x y:A, {leA x y} + {leA y x}. -Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}. -Hypothesis leA_refl : forall x y:A, eqA x y -> leA x y. -Hypothesis leA_trans : forall x y z:A, leA x y -> leA y z -> leA x z. -Hypothesis leA_antisym : forall x y:A, leA x y -> leA y x -> eqA x y. + Variable A : Set. + Variable leA : relation A. + Variable eqA : relation A. -Hint Resolve leA_refl. -Hint Immediate eqA_dec leA_dec leA_antisym. + Let gtA (x y:A) := ~ leA x y. + + Hypothesis leA_dec : forall x y:A, {leA x y} + {leA y x}. + Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}. + Hypothesis leA_refl : forall x y:A, eqA x y -> leA x y. + Hypothesis leA_trans : forall x y z:A, leA x y -> leA y z -> leA x z. + Hypothesis leA_antisym : forall x y:A, leA x y -> leA y x -> eqA x y. -Let emptyBag := EmptyBag A. -Let singletonBag := SingletonBag _ eqA_dec. + Hint Resolve leA_refl. + Hint Immediate eqA_dec leA_dec leA_antisym. -Inductive Tree : Set := - | Tree_Leaf : Tree - | Tree_Node : A -> Tree -> Tree -> Tree. + Let emptyBag := EmptyBag A. + Let singletonBag := SingletonBag _ eqA_dec. + + Inductive Tree : Set := + | Tree_Leaf : Tree + | Tree_Node : A -> Tree -> Tree -> Tree. -(** [a] is lower than a Tree [T] if [T] is a Leaf - or [T] is a Node holding [b>a] *) + (** [a] is lower than a Tree [T] if [T] is a Leaf + or [T] is a Node holding [b>a] *) -Definition leA_Tree (a:A) (t:Tree) := - match t with - | Tree_Leaf => True - | Tree_Node b T1 T2 => leA a b - end. + Definition leA_Tree (a:A) (t:Tree) := + match t with + | Tree_Leaf => True + | Tree_Node b T1 T2 => leA a b + end. -Lemma leA_Tree_Leaf : forall a:A, leA_Tree a Tree_Leaf. -Proof. -simpl in |- *; auto with datatypes. -Qed. + Lemma leA_Tree_Leaf : forall a:A, leA_Tree a Tree_Leaf. + Proof. + simpl in |- *; auto with datatypes. + Qed. -Lemma leA_Tree_Node : - forall (a b:A) (G D:Tree), leA a b -> leA_Tree a (Tree_Node b G D). -Proof. -simpl in |- *; auto with datatypes. -Qed. + Lemma leA_Tree_Node : + forall (a b:A) (G D:Tree), leA a b -> leA_Tree a (Tree_Node b G D). + Proof. + simpl in |- *; auto with datatypes. + Qed. -Hint Resolve leA_Tree_Leaf leA_Tree_Node. + (** ** The heap property *) -(** The heap property *) - -Inductive is_heap : Tree -> Prop := - | nil_is_heap : is_heap Tree_Leaf - | node_is_heap : + Inductive is_heap : Tree -> Prop := + | nil_is_heap : is_heap Tree_Leaf + | node_is_heap : forall (a:A) (T1 T2:Tree), leA_Tree a T1 -> leA_Tree a T2 -> is_heap T1 -> is_heap T2 -> is_heap (Tree_Node a T1 T2). -Hint Constructors is_heap. - -Lemma invert_heap : - forall (a:A) (T1 T2:Tree), - is_heap (Tree_Node a T1 T2) -> - leA_Tree a T1 /\ leA_Tree a T2 /\ is_heap T1 /\ is_heap T2. -Proof. -intros; inversion H; auto with datatypes. -Qed. - -(* This lemma ought to be generated automatically by the Inversion tools *) -Lemma is_heap_rec : - forall P:Tree -> Set, - P Tree_Leaf -> - (forall (a:A) (T1 T2:Tree), - leA_Tree a T1 -> - leA_Tree a T2 -> - is_heap T1 -> P T1 -> is_heap T2 -> P T2 -> P (Tree_Node a T1 T2)) -> - forall T:Tree, is_heap T -> P T. -Proof. -simple induction T; auto with datatypes. -intros a G PG D PD PN. -elim (invert_heap a G D); auto with datatypes. -intros H1 H2; elim H2; intros H3 H4; elim H4; intros. -apply H0; auto with datatypes. -Qed. - -Lemma low_trans : - forall (T:Tree) (a b:A), leA a b -> leA_Tree b T -> leA_Tree a T. -Proof. -simple induction T; auto with datatypes. -intros; simpl in |- *; apply leA_trans with b; auto with datatypes. -Qed. - -(** contents of a tree as a multiset *) - -(** Nota Bene : In what follows the definition of SingletonBag - in not used. Actually, we could just take as postulate: - [Parameter SingletonBag : A->multiset]. *) - -Fixpoint contents (t:Tree) : multiset A := - match t with - | Tree_Leaf => emptyBag - | Tree_Node a t1 t2 => - munion (contents t1) (munion (contents t2) (singletonBag a)) - end. - - -(** equivalence of two trees is equality of corresponding multisets *) - -Definition equiv_Tree (t1 t2:Tree) := meq (contents t1) (contents t2). - - -(** specification of heap insertion *) - -Inductive insert_spec (a:A) (T:Tree) : Set := + Lemma invert_heap : + forall (a:A) (T1 T2:Tree), + is_heap (Tree_Node a T1 T2) -> + leA_Tree a T1 /\ leA_Tree a T2 /\ is_heap T1 /\ is_heap T2. + Proof. + intros; inversion H; auto with datatypes. + Qed. + + (* This lemma ought to be generated automatically by the Inversion tools *) + Lemma is_heap_rec : + forall P:Tree -> Set, + P Tree_Leaf -> + (forall (a:A) (T1 T2:Tree), + leA_Tree a T1 -> + leA_Tree a T2 -> + is_heap T1 -> P T1 -> is_heap T2 -> P T2 -> P (Tree_Node a T1 T2)) -> + forall T:Tree, is_heap T -> P T. + Proof. + simple induction T; auto with datatypes. + intros a G PG D PD PN. + elim (invert_heap a G D); auto with datatypes. + intros H1 H2; elim H2; intros H3 H4; elim H4; intros. + apply H0; auto with datatypes. + Qed. + + Lemma low_trans : + forall (T:Tree) (a b:A), leA a b -> leA_Tree b T -> leA_Tree a T. + Proof. + simple induction T; auto with datatypes. + intros; simpl in |- *; apply leA_trans with b; auto with datatypes. + Qed. + + + (** ** From trees to multisets *) + + (** contents of a tree as a multiset *) + + (** Nota Bene : In what follows the definition of SingletonBag + in not used. Actually, we could just take as postulate: + [Parameter SingletonBag : A->multiset]. *) + + Fixpoint contents (t:Tree) : multiset A := + match t with + | Tree_Leaf => emptyBag + | Tree_Node a t1 t2 => + munion (contents t1) (munion (contents t2) (singletonBag a)) + end. + + + (** equivalence of two trees is equality of corresponding multisets *) + Definition equiv_Tree (t1 t2:Tree) := meq (contents t1) (contents t2). + + + + (** * From lists to sorted lists *) + + (** ** Specification of heap insertion *) + + Inductive insert_spec (a:A) (T:Tree) : Set := insert_exist : - forall T1:Tree, - is_heap T1 -> - meq (contents T1) (munion (contents T) (singletonBag a)) -> - (forall b:A, leA b a -> leA_Tree b T -> leA_Tree b T1) -> - insert_spec a T. - - -Lemma insert : forall T:Tree, is_heap T -> forall a:A, insert_spec a T. -Proof. -simple induction 1; intros. -apply insert_exist with (Tree_Node a Tree_Leaf Tree_Leaf); - auto with datatypes. -simpl in |- *; unfold meq, munion in |- *; auto with datatypes. -elim (leA_dec a a0); intros. -elim (H3 a0); intros. -apply insert_exist with (Tree_Node a T2 T0); auto with datatypes. -simpl in |- *; apply treesort_twist1; trivial with datatypes. -elim (H3 a); intros T3 HeapT3 ConT3 LeA. -apply insert_exist with (Tree_Node a0 T2 T3); auto with datatypes. -apply node_is_heap; auto with datatypes. -apply low_trans with a; auto with datatypes. -apply LeA; auto with datatypes. -apply low_trans with a; auto with datatypes. -simpl in |- *; apply treesort_twist2; trivial with datatypes. -Qed. - -(** building a heap from a list *) - -Inductive build_heap (l:list A) : Set := + forall T1:Tree, + is_heap T1 -> + meq (contents T1) (munion (contents T) (singletonBag a)) -> + (forall b:A, leA b a -> leA_Tree b T -> leA_Tree b T1) -> + insert_spec a T. + + + Lemma insert : forall T:Tree, is_heap T -> forall a:A, insert_spec a T. + Proof. + simple induction 1; intros. + apply insert_exist with (Tree_Node a Tree_Leaf Tree_Leaf); + auto using node_is_heap, nil_is_heap, leA_Tree_Leaf with datatypes. + simpl in |- *; unfold meq, munion in |- *; auto using node_is_heap with datatypes. + elim (leA_dec a a0); intros. + elim (H3 a0); intros. + apply insert_exist with (Tree_Node a T2 T0); + auto using node_is_heap, nil_is_heap, leA_Tree_Leaf with datatypes. + simpl in |- *; apply treesort_twist1; trivial with datatypes. + elim (H3 a); intros T3 HeapT3 ConT3 LeA. + apply insert_exist with (Tree_Node a0 T2 T3); + auto using node_is_heap, nil_is_heap, leA_Tree_Leaf with datatypes. + apply node_is_heap; auto using node_is_heap, nil_is_heap, leA_Tree_Leaf with datatypes. + apply low_trans with a; auto with datatypes. + apply LeA; auto with datatypes. + apply low_trans with a; auto with datatypes. + simpl in |- *; apply treesort_twist2; trivial with datatypes. + Qed. + + + (** ** Building a heap from a list *) + + Inductive build_heap (l:list A) : Set := heap_exist : - forall T:Tree, - is_heap T -> - meq (list_contents _ eqA_dec l) (contents T) -> build_heap l. - -Lemma list_to_heap : forall l:list A, build_heap l. -Proof. -simple induction l. -apply (heap_exist nil Tree_Leaf); auto with datatypes. -simpl in |- *; unfold meq in |- *; auto with datatypes. -simple induction 1. -intros T i m; elim (insert T i a). -intros; apply heap_exist with T1; simpl in |- *; auto with datatypes. -apply meq_trans with (munion (contents T) (singletonBag a)). -apply meq_trans with (munion (singletonBag a) (contents T)). -apply meq_right; trivial with datatypes. -apply munion_comm. -apply meq_sym; trivial with datatypes. -Qed. - - -(** building the sorted list *) - -Inductive flat_spec (T:Tree) : Set := + forall T:Tree, + is_heap T -> + meq (list_contents _ eqA_dec l) (contents T) -> build_heap l. + + Lemma list_to_heap : forall l:list A, build_heap l. + Proof. + simple induction l. + apply (heap_exist nil Tree_Leaf); auto with datatypes. + simpl in |- *; unfold meq in |- *; exact nil_is_heap. + simple induction 1. + intros T i m; elim (insert T i a). + intros; apply heap_exist with T1; simpl in |- *; auto with datatypes. + apply meq_trans with (munion (contents T) (singletonBag a)). + apply meq_trans with (munion (singletonBag a) (contents T)). + apply meq_right; trivial with datatypes. + apply munion_comm. + apply meq_sym; trivial with datatypes. + Qed. + + + (** ** Building the sorted list *) + + Inductive flat_spec (T:Tree) : Set := flat_exist : - forall l:list A, - sort leA l -> - (forall a:A, leA_Tree a T -> lelistA leA a l) -> - meq (contents T) (list_contents _ eqA_dec l) -> flat_spec T. - -Lemma heap_to_list : forall T:Tree, is_heap T -> flat_spec T. -Proof. - intros T h; elim h; intros. - apply flat_exist with (nil (A:=A)); auto with datatypes. - elim H2; intros l1 s1 i1 m1; elim H4; intros l2 s2 i2 m2. - elim (merge _ leA_dec eqA_dec s1 s2); intros. - apply flat_exist with (a :: l); simpl in |- *; auto with datatypes. - apply meq_trans with - (munion (list_contents _ eqA_dec l1) - (munion (list_contents _ eqA_dec l2) (singletonBag a))). - apply meq_congr; auto with datatypes. - apply meq_trans with - (munion (singletonBag a) - (munion (list_contents _ eqA_dec l1) (list_contents _ eqA_dec l2))). - apply munion_rotate. - apply meq_right; apply meq_sym; trivial with datatypes. -Qed. - -(** specification of treesort *) - -Theorem treesort : - forall l:list A, {m : list A | sort leA m & permutation _ eqA_dec l m}. -Proof. - intro l; unfold permutation in |- *. - elim (list_to_heap l). - intros. - elim (heap_to_list T); auto with datatypes. - intros. - exists l0; auto with datatypes. - apply meq_trans with (contents T); trivial with datatypes. -Qed. + forall l:list A, + sort leA l -> + (forall a:A, leA_Tree a T -> lelistA leA a l) -> + meq (contents T) (list_contents _ eqA_dec l) -> flat_spec T. + + Lemma heap_to_list : forall T:Tree, is_heap T -> flat_spec T. + Proof. + intros T h; elim h; intros. + apply flat_exist with (nil (A:=A)); auto with datatypes. + elim H2; intros l1 s1 i1 m1; elim H4; intros l2 s2 i2 m2. + elim (merge _ leA_dec eqA_dec s1 s2); intros. + apply flat_exist with (a :: l); simpl in |- *; auto with datatypes. + apply meq_trans with + (munion (list_contents _ eqA_dec l1) + (munion (list_contents _ eqA_dec l2) (singletonBag a))). + apply meq_congr; auto with datatypes. + apply meq_trans with + (munion (singletonBag a) + (munion (list_contents _ eqA_dec l1) (list_contents _ eqA_dec l2))). + apply munion_rotate. + apply meq_right; apply meq_sym; trivial with datatypes. + Qed. + + + (** * Specification of treesort *) + + Theorem treesort : + forall l:list A, {m : list A | sort leA m & permutation _ eqA_dec l m}. + Proof. + intro l; unfold permutation in |- *. + elim (list_to_heap l). + intros. + elim (heap_to_list T); auto with datatypes. + intros. + exists l0; auto with datatypes. + apply meq_trans with (contents T); trivial with datatypes. + Qed. End defs.
\ No newline at end of file diff --git a/theories/Sorting/PermutEq.v b/theories/Sorting/PermutEq.v index e56ff27d..f4986198 100644 --- a/theories/Sorting/PermutEq.v +++ b/theories/Sorting/PermutEq.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: PermutEq.v 8853 2006-05-23 18:17:38Z herbelin $ i*) +(*i $Id: PermutEq.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Omega. Require Import Relations. @@ -18,224 +18,224 @@ Require Import Permutation. Set Implicit Arguments. (** This file is similar to [PermutSetoid], except that the equality used here - is Coq usual one instead of a setoid equality. In particular, we can then - prove the equivalence between [List.Permutation] and - [Permutation.permutation]. + is Coq usual one instead of a setoid equality. In particular, we can then + prove the equivalence between [List.Permutation] and + [Permutation.permutation]. *) Section Perm. - -Variable A : Set. -Hypothesis eq_dec : forall x y:A, {x=y} + {~ x=y}. - -Notation permutation := (permutation _ eq_dec). -Notation list_contents := (list_contents _ eq_dec). - -(** we can use [multiplicity] to define [In] and [NoDup]. *) - -Lemma multiplicity_In : - forall l a, In a l <-> 0 < multiplicity (list_contents l) a. -Proof. -induction l. -simpl. -split; inversion 1. -simpl. -split; intros. -inversion_clear H. -subst a0. -destruct (eq_dec a a) as [_|H]; auto with arith; destruct H; auto. -destruct (eq_dec a a0) as [H1|H1]; auto with arith; simpl. -rewrite <- IHl; auto. -destruct (eq_dec a a0); auto. -simpl in H. -right; rewrite IHl; auto. -Qed. - -Lemma multiplicity_In_O : - forall l a, ~ In a l -> multiplicity (list_contents l) a = 0. -Proof. -intros l a; rewrite multiplicity_In; - destruct (multiplicity (list_contents l) a); auto. -destruct 1; auto with arith. -Qed. - -Lemma multiplicity_In_S : - forall l a, In a l -> multiplicity (list_contents l) a >= 1. -Proof. -intros l a; rewrite multiplicity_In; auto. -Qed. - -Lemma multiplicity_NoDup : - forall l, NoDup l <-> (forall a, multiplicity (list_contents l) a <= 1). -Proof. -induction l. -simpl. -split; auto with arith. -intros; apply NoDup_nil. -split; simpl. -inversion_clear 1. -rewrite IHl in H1. -intros; destruct (eq_dec a a0) as [H2|H2]; simpl; auto. -subst a0. -rewrite multiplicity_In_O; auto. -intros; constructor. -rewrite multiplicity_In. -generalize (H a). -destruct (eq_dec a a) as [H0|H0]. -destruct (multiplicity (list_contents l) a); auto with arith. -simpl; inversion 1. -inversion H3. -destruct H0; auto. -rewrite IHl; intros. -generalize (H a0); auto with arith. -destruct (eq_dec a a0); simpl; auto with arith. -Qed. - -Lemma NoDup_permut : - forall l l', NoDup l -> NoDup l' -> - (forall x, In x l <-> In x l') -> permutation l l'. -Proof. -intros. -red; unfold meq; intros. -rewrite multiplicity_NoDup in H, H0. -generalize (H a) (H0 a) (H1 a); clear H H0 H1. -do 2 rewrite multiplicity_In. -destruct 3; omega. -Qed. - -(** Permutation is compatible with In. *) -Lemma permut_In_In : - forall l1 l2 e, permutation l1 l2 -> In e l1 -> In e l2. -Proof. -unfold Permutation.permutation, meq; intros l1 l2 e P IN. -generalize (P e); clear P. -destruct (In_dec eq_dec e l2) as [H|H]; auto. -rewrite (multiplicity_In_O _ _ H). -intros. -generalize (multiplicity_In_S _ _ IN). -rewrite H0. -inversion 1. -Qed. - -Lemma permut_cons_In : - forall l1 l2 e, permutation (e :: l1) l2 -> In e l2. -Proof. -intros; eapply permut_In_In; eauto. -red; auto. -Qed. - -(** Permutation of an empty list. *) -Lemma permut_nil : - forall l, permutation l nil -> l = nil. -Proof. -intro l; destruct l as [ | e l ]; trivial. -assert (In e (e::l)) by (red; auto). -intro Abs; generalize (permut_In_In _ Abs H). -inversion 1. -Qed. - -(** When used with [eq], this permutation notion is equivalent to - the one defined in [List.v]. *) - -Lemma permutation_Permutation : - forall l l', Permutation l l' <-> permutation l l'. -Proof. -split. -induction 1. -apply permut_refl. -apply permut_cons; auto. -change (permutation (y::x::l) ((x::nil)++y::l)). -apply permut_add_cons_inside; simpl; apply permut_refl. -apply permut_tran with l'; auto. -revert l'. -induction l. -intros. -rewrite (permut_nil (permut_sym H)). -apply Permutation_refl. -intros. -destruct (In_split _ _ (permut_cons_In H)) as (h2,(t2,H1)). -subst l'. -apply Permutation_cons_app. -apply IHl. -apply permut_remove_hd with a; auto. -Qed. - -(** Permutation for short lists. *) - -Lemma permut_length_1: - forall a b, permutation (a :: nil) (b :: nil) -> a=b. -Proof. -intros a b; unfold Permutation.permutation, meq; intro P; -generalize (P b); clear P; simpl. -destruct (eq_dec b b) as [H|H]; [ | destruct H; auto]. -destruct (eq_dec a b); simpl; auto; intros; discriminate. -Qed. - -Lemma permut_length_2 : - forall a1 b1 a2 b2, permutation (a1 :: b1 :: nil) (a2 :: b2 :: nil) -> - (a1=a2) /\ (b1=b2) \/ (a1=b2) /\ (a2=b1). -Proof. -intros a1 b1 a2 b2 P. -assert (H:=permut_cons_In P). -inversion_clear H. -left; split; auto. -apply permut_length_1. -red; red; intros. -generalize (P a); clear P; simpl. -destruct (eq_dec a1 a) as [H2|H2]; - destruct (eq_dec a2 a) as [H3|H3]; auto. -destruct H3; transitivity a1; auto. -destruct H2; transitivity a2; auto. -right. -inversion_clear H0; [|inversion H]. -split; auto. -apply permut_length_1. -red; red; intros. -generalize (P a); clear P; simpl. -destruct (eq_dec a1 a) as [H2|H2]; - destruct (eq_dec b2 a) as [H3|H3]; auto. -simpl; rewrite <- plus_n_Sm; inversion 1; auto. -destruct H3; transitivity a1; auto. -destruct H2; transitivity b2; auto. -Qed. - -(** Permutation is compatible with length. *) -Lemma permut_length : - forall l1 l2, permutation l1 l2 -> length l1 = length l2. -Proof. -induction l1; intros l2 H. -rewrite (permut_nil (permut_sym H)); auto. -destruct (In_split _ _ (permut_cons_In H)) as (h2,(t2,H1)). -subst l2. -rewrite app_length. -simpl; rewrite <- plus_n_Sm; f_equal. -rewrite <- app_length. -apply IHl1. -apply permut_remove_hd with a; auto. -Qed. - -Variable B : Set. -Variable eqB_dec : forall x y:B, { x=y }+{ ~x=y }. - -(** Permutation is compatible with map. *) - -Lemma permutation_map : - forall f l1 l2, permutation l1 l2 -> - Permutation.permutation _ eqB_dec (map f l1) (map f l2). -Proof. -intros f; induction l1. -intros l2 P; rewrite (permut_nil (permut_sym P)); apply permut_refl. -intros l2 P. -simpl. -destruct (In_split _ _ (permut_cons_In P)) as (h2,(t2,H1)). -subst l2. -rewrite map_app. -simpl. -apply permut_add_cons_inside. -rewrite <- map_app. -apply IHl1; auto. -apply permut_remove_hd with a; auto. -Qed. + + Variable A : Set. + Hypothesis eq_dec : forall x y:A, {x=y} + {~ x=y}. + + Notation permutation := (permutation _ eq_dec). + Notation list_contents := (list_contents _ eq_dec). + + (** we can use [multiplicity] to define [In] and [NoDup]. *) + + Lemma multiplicity_In : + forall l a, In a l <-> 0 < multiplicity (list_contents l) a. + Proof. + induction l. + simpl. + split; inversion 1. + simpl. + split; intros. + inversion_clear H. + subst a0. + destruct (eq_dec a a) as [_|H]; auto with arith; destruct H; auto. + destruct (eq_dec a a0) as [H1|H1]; auto with arith; simpl. + rewrite <- IHl; auto. + destruct (eq_dec a a0); auto. + simpl in H. + right; rewrite IHl; auto. + Qed. + + Lemma multiplicity_In_O : + forall l a, ~ In a l -> multiplicity (list_contents l) a = 0. + Proof. + intros l a; rewrite multiplicity_In; + destruct (multiplicity (list_contents l) a); auto. + destruct 1; auto with arith. + Qed. + + Lemma multiplicity_In_S : + forall l a, In a l -> multiplicity (list_contents l) a >= 1. + Proof. + intros l a; rewrite multiplicity_In; auto. + Qed. + + Lemma multiplicity_NoDup : + forall l, NoDup l <-> (forall a, multiplicity (list_contents l) a <= 1). + Proof. + induction l. + simpl. + split; auto with arith. + intros; apply NoDup_nil. + split; simpl. + inversion_clear 1. + rewrite IHl in H1. + intros; destruct (eq_dec a a0) as [H2|H2]; simpl; auto. + subst a0. + rewrite multiplicity_In_O; auto. + intros; constructor. + rewrite multiplicity_In. + generalize (H a). + destruct (eq_dec a a) as [H0|H0]. + destruct (multiplicity (list_contents l) a); auto with arith. + simpl; inversion 1. + inversion H3. + destruct H0; auto. + rewrite IHl; intros. + generalize (H a0); auto with arith. + destruct (eq_dec a a0); simpl; auto with arith. + Qed. + + Lemma NoDup_permut : + forall l l', NoDup l -> NoDup l' -> + (forall x, In x l <-> In x l') -> permutation l l'. + Proof. + intros. + red; unfold meq; intros. + rewrite multiplicity_NoDup in H, H0. + generalize (H a) (H0 a) (H1 a); clear H H0 H1. + do 2 rewrite multiplicity_In. + destruct 3; omega. + Qed. + + (** Permutation is compatible with In. *) + Lemma permut_In_In : + forall l1 l2 e, permutation l1 l2 -> In e l1 -> In e l2. + Proof. + unfold Permutation.permutation, meq; intros l1 l2 e P IN. + generalize (P e); clear P. + destruct (In_dec eq_dec e l2) as [H|H]; auto. + rewrite (multiplicity_In_O _ _ H). + intros. + generalize (multiplicity_In_S _ _ IN). + rewrite H0. + inversion 1. + Qed. + + Lemma permut_cons_In : + forall l1 l2 e, permutation (e :: l1) l2 -> In e l2. + Proof. + intros; eapply permut_In_In; eauto. + red; auto. + Qed. + + (** Permutation of an empty list. *) + Lemma permut_nil : + forall l, permutation l nil -> l = nil. + Proof. + intro l; destruct l as [ | e l ]; trivial. + assert (In e (e::l)) by (red; auto). + intro Abs; generalize (permut_In_In _ Abs H). + inversion 1. + Qed. + + (** When used with [eq], this permutation notion is equivalent to + the one defined in [List.v]. *) + + Lemma permutation_Permutation : + forall l l', Permutation l l' <-> permutation l l'. + Proof. + split. + induction 1. + apply permut_refl. + apply permut_cons; auto. + change (permutation (y::x::l) ((x::nil)++y::l)). + apply permut_add_cons_inside; simpl; apply permut_refl. + apply permut_tran with l'; auto. + revert l'. + induction l. + intros. + rewrite (permut_nil (permut_sym H)). + apply Permutation_refl. + intros. + destruct (In_split _ _ (permut_cons_In H)) as (h2,(t2,H1)). + subst l'. + apply Permutation_cons_app. + apply IHl. + apply permut_remove_hd with a; auto. + Qed. + + (** Permutation for short lists. *) + + Lemma permut_length_1: + forall a b, permutation (a :: nil) (b :: nil) -> a=b. + Proof. + intros a b; unfold Permutation.permutation, meq; intro P; + generalize (P b); clear P; simpl. + destruct (eq_dec b b) as [H|H]; [ | destruct H; auto]. + destruct (eq_dec a b); simpl; auto; intros; discriminate. + Qed. + + Lemma permut_length_2 : + forall a1 b1 a2 b2, permutation (a1 :: b1 :: nil) (a2 :: b2 :: nil) -> + (a1=a2) /\ (b1=b2) \/ (a1=b2) /\ (a2=b1). + Proof. + intros a1 b1 a2 b2 P. + assert (H:=permut_cons_In P). + inversion_clear H. + left; split; auto. + apply permut_length_1. + red; red; intros. + generalize (P a); clear P; simpl. + destruct (eq_dec a1 a) as [H2|H2]; + destruct (eq_dec a2 a) as [H3|H3]; auto. + destruct H3; transitivity a1; auto. + destruct H2; transitivity a2; auto. + right. + inversion_clear H0; [|inversion H]. + split; auto. + apply permut_length_1. + red; red; intros. + generalize (P a); clear P; simpl. + destruct (eq_dec a1 a) as [H2|H2]; + destruct (eq_dec b2 a) as [H3|H3]; auto. + simpl; rewrite <- plus_n_Sm; inversion 1; auto. + destruct H3; transitivity a1; auto. + destruct H2; transitivity b2; auto. + Qed. + + (** Permutation is compatible with length. *) + Lemma permut_length : + forall l1 l2, permutation l1 l2 -> length l1 = length l2. + Proof. + induction l1; intros l2 H. + rewrite (permut_nil (permut_sym H)); auto. + destruct (In_split _ _ (permut_cons_In H)) as (h2,(t2,H1)). + subst l2. + rewrite app_length. + simpl; rewrite <- plus_n_Sm; f_equal. + rewrite <- app_length. + apply IHl1. + apply permut_remove_hd with a; auto. + Qed. + + Variable B : Set. + Variable eqB_dec : forall x y:B, { x=y }+{ ~x=y }. + + (** Permutation is compatible with map. *) + + Lemma permutation_map : + forall f l1 l2, permutation l1 l2 -> + Permutation.permutation _ eqB_dec (map f l1) (map f l2). + Proof. + intros f; induction l1. + intros l2 P; rewrite (permut_nil (permut_sym P)); apply permut_refl. + intros l2 P. + simpl. + destruct (In_split _ _ (permut_cons_In P)) as (h2,(t2,H1)). + subst l2. + rewrite map_app. + simpl. + apply permut_add_cons_inside. + rewrite <- map_app. + apply IHl1; auto. + apply permut_remove_hd with a; auto. + Qed. End Perm. diff --git a/theories/Sorting/PermutSetoid.v b/theories/Sorting/PermutSetoid.v index 46ea088f..65369a01 100644 --- a/theories/Sorting/PermutSetoid.v +++ b/theories/Sorting/PermutSetoid.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: PermutSetoid.v 8823 2006-05-16 16:17:43Z letouzey $ i*) +(*i $Id: PermutSetoid.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Omega. Require Import Relations. @@ -41,59 +41,59 @@ Variable eqA_trans : forall x y z, eqA x y -> eqA y z -> eqA x z. Lemma multiplicity_InA : forall l a, InA eqA a l <-> 0 < multiplicity (list_contents l) a. Proof. -induction l. -simpl. -split; inversion 1. -simpl. -split; intros. -inversion_clear H. -destruct (eqA_dec a a0) as [_|H1]; auto with arith. -destruct H1; auto. -destruct (eqA_dec a a0); auto with arith. -simpl; rewrite <- IHl; auto. -destruct (eqA_dec a a0) as [H0|H0]; auto. -simpl in H. -constructor 2; rewrite IHl; auto. + induction l. + simpl. + split; inversion 1. + simpl. + split; intros. + inversion_clear H. + destruct (eqA_dec a a0) as [_|H1]; auto with arith. + destruct H1; auto. + destruct (eqA_dec a a0); auto with arith. + simpl; rewrite <- IHl; auto. + destruct (eqA_dec a a0) as [H0|H0]; auto. + simpl in H. + constructor 2; rewrite IHl; auto. Qed. Lemma multiplicity_InA_O : forall l a, ~ InA eqA a l -> multiplicity (list_contents l) a = 0. Proof. -intros l a; rewrite multiplicity_InA; -destruct (multiplicity (list_contents l) a); auto with arith. -destruct 1; auto with arith. + intros l a; rewrite multiplicity_InA; + destruct (multiplicity (list_contents l) a); auto with arith. + destruct 1; auto with arith. Qed. Lemma multiplicity_InA_S : - forall l a, InA eqA a l -> multiplicity (list_contents l) a >= 1. + forall l a, InA eqA a l -> multiplicity (list_contents l) a >= 1. Proof. -intros l a; rewrite multiplicity_InA; auto with arith. + intros l a; rewrite multiplicity_InA; auto with arith. Qed. Lemma multiplicity_NoDupA : forall l, NoDupA eqA l <-> (forall a, multiplicity (list_contents l) a <= 1). Proof. -induction l. -simpl. -split; auto with arith. -split; simpl. -inversion_clear 1. -rewrite IHl in H1. -intros; destruct (eqA_dec a a0) as [H2|H2]; simpl; auto. -rewrite multiplicity_InA_O; auto. -swap H0. -apply InA_eqA with a0; auto. -intros; constructor. -rewrite multiplicity_InA. -generalize (H a). -destruct (eqA_dec a a) as [H0|H0]. -destruct (multiplicity (list_contents l) a); auto with arith. -simpl; inversion 1. -inversion H3. -destruct H0; auto. -rewrite IHl; intros. -generalize (H a0); auto with arith. -destruct (eqA_dec a a0); simpl; auto with arith. + induction l. + simpl. + split; auto with arith. + split; simpl. + inversion_clear 1. + rewrite IHl in H1. + intros; destruct (eqA_dec a a0) as [H2|H2]; simpl; auto. + rewrite multiplicity_InA_O; auto. + swap H0. + apply InA_eqA with a0; auto. + intros; constructor. + rewrite multiplicity_InA. + generalize (H a). + destruct (eqA_dec a a) as [H0|H0]. + destruct (multiplicity (list_contents l) a); auto with arith. + simpl; inversion 1. + inversion H3. + destruct H0; auto. + rewrite IHl; intros. + generalize (H a0); auto with arith. + destruct (eqA_dec a a0); simpl; auto with arith. Qed. @@ -101,100 +101,100 @@ Qed. Lemma permut_InA_InA : forall l1 l2 e, permutation l1 l2 -> InA eqA e l1 -> InA eqA e l2. Proof. -intros l1 l2 e. -do 2 rewrite multiplicity_InA. -unfold Permutation.permutation, meq. -intros H;rewrite H; auto. + intros l1 l2 e. + do 2 rewrite multiplicity_InA. + unfold Permutation.permutation, meq. + intros H;rewrite H; auto. Qed. Lemma permut_cons_InA : forall l1 l2 e, permutation (e :: l1) l2 -> InA eqA e l2. Proof. -intros; apply (permut_InA_InA (e:=e) H); auto. + intros; apply (permut_InA_InA (e:=e) H); auto. Qed. (** Permutation of an empty list. *) Lemma permut_nil : - forall l, permutation l nil -> l = nil. + forall l, permutation l nil -> l = nil. Proof. -intro l; destruct l as [ | e l ]; trivial. -assert (InA eqA e (e::l)) by auto. -intro Abs; generalize (permut_InA_InA Abs H). -inversion 1. + intro l; destruct l as [ | e l ]; trivial. + assert (InA eqA e (e::l)) by auto. + intro Abs; generalize (permut_InA_InA Abs H). + inversion 1. Qed. (** Permutation for short lists. *) Lemma permut_length_1: - forall a b, permutation (a :: nil) (b :: nil) -> eqA a b. + forall a b, permutation (a :: nil) (b :: nil) -> eqA a b. Proof. -intros a b; unfold Permutation.permutation, meq; intro P; -generalize (P b); clear P; simpl. -destruct (eqA_dec b b) as [H|H]; [ | destruct H; auto]. -destruct (eqA_dec a b); simpl; auto; intros; discriminate. + intros a b; unfold Permutation.permutation, meq; intro P; + generalize (P b); clear P; simpl. + destruct (eqA_dec b b) as [H|H]; [ | destruct H; auto]. + destruct (eqA_dec a b); simpl; auto; intros; discriminate. Qed. Lemma permut_length_2 : - forall a1 b1 a2 b2, permutation (a1 :: b1 :: nil) (a2 :: b2 :: nil) -> - (eqA a1 a2) /\ (eqA b1 b2) \/ (eqA a1 b2) /\ (eqA a2 b1). + forall a1 b1 a2 b2, permutation (a1 :: b1 :: nil) (a2 :: b2 :: nil) -> + (eqA a1 a2) /\ (eqA b1 b2) \/ (eqA a1 b2) /\ (eqA a2 b1). Proof. -intros a1 b1 a2 b2 P. -assert (H:=permut_cons_InA P). -inversion_clear H. -left; split; auto. -apply permut_length_1. -red; red; intros. -generalize (P a); clear P; simpl. -destruct (eqA_dec a1 a) as [H2|H2]; - destruct (eqA_dec a2 a) as [H3|H3]; auto. -destruct H3; apply eqA_trans with a1; auto. -destruct H2; apply eqA_trans with a2; auto. -right. -inversion_clear H0; [|inversion H]. -split; auto. -apply permut_length_1. -red; red; intros. -generalize (P a); clear P; simpl. -destruct (eqA_dec a1 a) as [H2|H2]; - destruct (eqA_dec b2 a) as [H3|H3]; auto. -simpl; rewrite <- plus_n_Sm; inversion 1; auto. -destruct H3; apply eqA_trans with a1; auto. -destruct H2; apply eqA_trans with b2; auto. + intros a1 b1 a2 b2 P. + assert (H:=permut_cons_InA P). + inversion_clear H. + left; split; auto. + apply permut_length_1. + red; red; intros. + generalize (P a); clear P; simpl. + destruct (eqA_dec a1 a) as [H2|H2]; + destruct (eqA_dec a2 a) as [H3|H3]; auto. + destruct H3; apply eqA_trans with a1; auto. + destruct H2; apply eqA_trans with a2; auto. + right. + inversion_clear H0; [|inversion H]. + split; auto. + apply permut_length_1. + red; red; intros. + generalize (P a); clear P; simpl. + destruct (eqA_dec a1 a) as [H2|H2]; + destruct (eqA_dec b2 a) as [H3|H3]; auto. + simpl; rewrite <- plus_n_Sm; inversion 1; auto. + destruct H3; apply eqA_trans with a1; auto. + destruct H2; apply eqA_trans with b2; auto. Qed. (** Permutation is compatible with length. *) Lemma permut_length : - forall l1 l2, permutation l1 l2 -> length l1 = length l2. + forall l1 l2, permutation l1 l2 -> length l1 = length l2. Proof. -induction l1; intros l2 H. -rewrite (permut_nil (permut_sym H)); auto. -assert (H0:=permut_cons_InA H). -destruct (InA_split H0) as (h2,(b,(t2,(H1,H2)))). -subst l2. -rewrite app_length. -simpl; rewrite <- plus_n_Sm; f_equal. -rewrite <- app_length. -apply IHl1. -apply permut_remove_hd with b. -apply permut_tran with (a::l1); auto. -revert H1; unfold Permutation.permutation, meq; simpl. -intros; f_equal; auto. -destruct (eqA_dec b a0) as [H2|H2]; - destruct (eqA_dec a a0) as [H3|H3]; auto. -destruct H3; apply eqA_trans with b; auto. -destruct H2; apply eqA_trans with a; auto. + induction l1; intros l2 H. + rewrite (permut_nil (permut_sym H)); auto. + assert (H0:=permut_cons_InA H). + destruct (InA_split H0) as (h2,(b,(t2,(H1,H2)))). + subst l2. + rewrite app_length. + simpl; rewrite <- plus_n_Sm; f_equal. + rewrite <- app_length. + apply IHl1. + apply permut_remove_hd with b. + apply permut_tran with (a::l1); auto. + revert H1; unfold Permutation.permutation, meq; simpl. + intros; f_equal; auto. + destruct (eqA_dec b a0) as [H2|H2]; + destruct (eqA_dec a a0) as [H3|H3]; auto. + destruct H3; apply eqA_trans with b; auto. + destruct H2; apply eqA_trans with a; auto. Qed. Lemma NoDupA_eqlistA_permut : forall l l', NoDupA eqA l -> NoDupA eqA l' -> - eqlistA eqA l l' -> permutation l l'. + eqlistA eqA l l' -> permutation l l'. Proof. -intros. -red; unfold meq; intros. -rewrite multiplicity_NoDupA in H, H0. -generalize (H a) (H0 a) (H1 a); clear H H0 H1. -do 2 rewrite multiplicity_InA. -destruct 3; omega. + intros. + red; unfold meq; intros. + rewrite multiplicity_NoDupA in H, H0. + generalize (H a) (H0 a) (H1 a); clear H H0 H1. + do 2 rewrite multiplicity_InA. + destruct 3; omega. Qed. @@ -207,37 +207,37 @@ Variable eqB_trans : forall x y z, eqB x y -> eqB y z -> eqB x z. Lemma permut_map : forall f, - (forall x y, eqA x y -> eqB (f x) (f y)) -> - forall l1 l2, permutation l1 l2 -> - Permutation.permutation _ eqB_dec (map f l1) (map f l2). + (forall x y, eqA x y -> eqB (f x) (f y)) -> + forall l1 l2, permutation l1 l2 -> + Permutation.permutation _ eqB_dec (map f l1) (map f l2). Proof. -intros f; induction l1. -intros l2 P; rewrite (permut_nil (permut_sym P)); apply permut_refl. -intros l2 P. -simpl. -assert (H0:=permut_cons_InA P). -destruct (InA_split H0) as (h2,(b,(t2,(H1,H2)))). -subst l2. -rewrite map_app. -simpl. -apply permut_tran with (f b :: map f l1). -revert H1; unfold Permutation.permutation, meq; simpl. -intros; f_equal; auto. -destruct (eqB_dec (f b) a0) as [H2|H2]; - destruct (eqB_dec (f a) a0) as [H3|H3]; auto. -destruct H3; apply eqB_trans with (f b); auto. -destruct H2; apply eqB_trans with (f a); auto. -apply permut_add_cons_inside. -rewrite <- map_app. -apply IHl1; auto. -apply permut_remove_hd with b. -apply permut_tran with (a::l1); auto. -revert H1; unfold Permutation.permutation, meq; simpl. -intros; f_equal; auto. -destruct (eqA_dec b a0) as [H2|H2]; - destruct (eqA_dec a a0) as [H3|H3]; auto. -destruct H3; apply eqA_trans with b; auto. -destruct H2; apply eqA_trans with a; auto. + intros f; induction l1. + intros l2 P; rewrite (permut_nil (permut_sym P)); apply permut_refl. + intros l2 P. + simpl. + assert (H0:=permut_cons_InA P). + destruct (InA_split H0) as (h2,(b,(t2,(H1,H2)))). + subst l2. + rewrite map_app. + simpl. + apply permut_tran with (f b :: map f l1). + revert H1; unfold Permutation.permutation, meq; simpl. + intros; f_equal; auto. + destruct (eqB_dec (f b) a0) as [H2|H2]; + destruct (eqB_dec (f a) a0) as [H3|H3]; auto. + destruct H3; apply eqB_trans with (f b); auto. + destruct H2; apply eqB_trans with (f a); auto. + apply permut_add_cons_inside. + rewrite <- map_app. + apply IHl1; auto. + apply permut_remove_hd with b. + apply permut_tran with (a::l1); auto. + revert H1; unfold Permutation.permutation, meq; simpl. + intros; f_equal; auto. + destruct (eqA_dec b a0) as [H2|H2]; + destruct (eqA_dec a a0) as [H3|H3]; auto. + destruct H3; apply eqA_trans with b; auto. + destruct H2; apply eqA_trans with a; auto. Qed. End Perm. diff --git a/theories/Sorting/Permutation.v b/theories/Sorting/Permutation.v index 0f2e02b5..3ff026c2 100644 --- a/theories/Sorting/Permutation.v +++ b/theories/Sorting/Permutation.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Permutation.v 8823 2006-05-16 16:17:43Z letouzey $ i*) +(*i $Id: Permutation.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Relations. Require Import List. @@ -14,193 +14,194 @@ Require Import Multiset. Require Import Arith. (** This file define a notion of permutation for lists, based on multisets: - there exists a permutation between two lists iff every elements have - the same multiplicities in the two lists. + there exists a permutation between two lists iff every elements have + the same multiplicities in the two lists. - Unlike [List.Permutation], the present notion of permutation requires - a decidable equality. At the same time, this definition can be used - with a non-standard equality, whereas [List.Permutation] cannot. + Unlike [List.Permutation], the present notion of permutation requires + a decidable equality. At the same time, this definition can be used + with a non-standard equality, whereas [List.Permutation] cannot. - The present file contains basic results, obtained without any particular - assumption on the decidable equality used. + The present file contains basic results, obtained without any particular + assumption on the decidable equality used. - File [PermutSetoid] contains additional results about permutations - with respect to an setoid equality (i.e. an equivalence relation). + File [PermutSetoid] contains additional results about permutations + with respect to an setoid equality (i.e. an equivalence relation). - Finally, file [PermutEq] concerns Coq equality : this file is similar - to the previous one, but proves in addition that [List.Permutation] - and [permutation] are equivalent in this context. -*) + Finally, file [PermutEq] concerns Coq equality : this file is similar + to the previous one, but proves in addition that [List.Permutation] + and [permutation] are equivalent in this context. +x*) Set Implicit Arguments. Section defs. -Variable A : Set. -Variable eqA : relation A. -Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}. - -Let emptyBag := EmptyBag A. -Let singletonBag := SingletonBag _ eqA_dec. - -(** contents of a list *) - -Fixpoint list_contents (l:list A) : multiset A := - match l with - | nil => emptyBag - | a :: l => munion (singletonBag a) (list_contents l) - end. - -Lemma list_contents_app : - forall l m:list A, - meq (list_contents (l ++ m)) (munion (list_contents l) (list_contents m)). -Proof. -simple induction l; simpl in |- *; auto with datatypes. -intros. -apply meq_trans with - (munion (singletonBag a) (munion (list_contents l0) (list_contents m))); - auto with datatypes. -Qed. -Hint Resolve list_contents_app. - -Definition permutation (l m:list A) := - meq (list_contents l) (list_contents m). - -Lemma permut_refl : forall l:list A, permutation l l. -Proof. -unfold permutation in |- *; auto with datatypes. -Qed. -Hint Resolve permut_refl. - -Lemma permut_sym : - forall l1 l2 : list A, permutation l1 l2 -> permutation l2 l1. -Proof. -unfold permutation, meq; intros; apply sym_eq; trivial. -Qed. - -Lemma permut_tran : - forall l m n:list A, permutation l m -> permutation m n -> permutation l n. -Proof. -unfold permutation in |- *; intros. -apply meq_trans with (list_contents m); auto with datatypes. -Qed. - -Lemma permut_cons : - forall l m:list A, - permutation l m -> forall a:A, permutation (a :: l) (a :: m). -Proof. -unfold permutation in |- *; simpl in |- *; auto with datatypes. -Qed. -Hint Resolve permut_cons. - -Lemma permut_app : - forall l l' m m':list A, - permutation l l' -> permutation m m' -> permutation (l ++ m) (l' ++ m'). -Proof. -unfold permutation in |- *; intros. -apply meq_trans with (munion (list_contents l) (list_contents m)); - auto with datatypes. -apply meq_trans with (munion (list_contents l') (list_contents m')); - auto with datatypes. -apply meq_trans with (munion (list_contents l') (list_contents m)); - auto with datatypes. -Qed. -Hint Resolve permut_app. - -Lemma permut_add_inside : - forall a l1 l2 l3 l4, - permutation (l1 ++ l2) (l3 ++ l4) -> - permutation (l1 ++ a :: l2) (l3 ++ a :: l4). -Proof. -unfold permutation, meq in *; intros. -generalize (H a0); clear H. -do 4 rewrite list_contents_app. -simpl. -destruct (eqA_dec a a0); simpl; auto with arith. -do 2 rewrite <- plus_n_Sm; f_equal; auto. -Qed. - -Lemma permut_add_cons_inside : - forall a l l1 l2, - permutation l (l1 ++ l2) -> - permutation (a :: l) (l1 ++ a :: l2). -Proof. -intros; -replace (a :: l) with (nil ++ a :: l); trivial; -apply permut_add_inside; trivial. -Qed. - -Lemma permut_middle : - forall (l m:list A) (a:A), permutation (a :: l ++ m) (l ++ a :: m). -Proof. -intros; apply permut_add_cons_inside; auto. -Qed. -Hint Resolve permut_middle. - -Lemma permut_sym_app : - forall l1 l2, permutation (l1 ++ l2) (l2 ++ l1). -Proof. -intros l1 l2; -unfold permutation, meq; -intro a; do 2 rewrite list_contents_app; simpl; -auto with arith. -Qed. - -Lemma permut_rev : - forall l, permutation l (rev l). -Proof. -induction l. -simpl; auto. -simpl. -apply permut_add_cons_inside. -rewrite <- app_nil_end; auto. -Qed. - -(** Some inversion results. *) -Lemma permut_conv_inv : - forall e l1 l2, permutation (e :: l1) (e :: l2) -> permutation l1 l2. -Proof. -intros e l1 l2; unfold permutation, meq; simpl; intros H a; -generalize (H a); apply plus_reg_l. -Qed. - -Lemma permut_app_inv1 : - forall l l1 l2, permutation (l1 ++ l) (l2 ++ l) -> permutation l1 l2. -Proof. -intros l l1 l2; unfold permutation, meq; simpl; -intros H a; generalize (H a); clear H. -do 2 rewrite list_contents_app. -simpl. -intros; apply plus_reg_l with (multiplicity (list_contents l) a). -rewrite plus_comm; rewrite H; rewrite plus_comm. -trivial. -Qed. - -Lemma permut_app_inv2 : - forall l l1 l2, permutation (l ++ l1) (l ++ l2) -> permutation l1 l2. -Proof. -intros l l1 l2; unfold permutation, meq; simpl; -intros H a; generalize (H a); clear H. -do 2 rewrite list_contents_app. -simpl. -intros; apply plus_reg_l with (multiplicity (list_contents l) a). -trivial. -Qed. - -Lemma permut_remove_hd : - forall l l1 l2 a, - permutation (a :: l) (l1 ++ a :: l2) -> permutation l (l1 ++ l2). -Proof. -intros l l1 l2 a; unfold permutation, meq; simpl; intros H a0; generalize (H a0); clear H. -do 2 rewrite list_contents_app; simpl; intro H. -apply plus_reg_l with (if eqA_dec a a0 then 1 else 0). -rewrite H; clear H. -symmetry; rewrite plus_comm. -repeat rewrite <- plus_assoc; f_equal. -apply plus_comm. -Qed. + (** * From lists to multisets *) + + Variable A : Set. + Variable eqA : relation A. + Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}. + + Let emptyBag := EmptyBag A. + Let singletonBag := SingletonBag _ eqA_dec. + + (** contents of a list *) + + Fixpoint list_contents (l:list A) : multiset A := + match l with + | nil => emptyBag + | a :: l => munion (singletonBag a) (list_contents l) + end. + + Lemma list_contents_app : + forall l m:list A, + meq (list_contents (l ++ m)) (munion (list_contents l) (list_contents m)). + Proof. + simple induction l; simpl in |- *; auto with datatypes. + intros. + apply meq_trans with + (munion (singletonBag a) (munion (list_contents l0) (list_contents m))); + auto with datatypes. + Qed. + + + (** * [permutation]: definition and basic properties *) + + Definition permutation (l m:list A) := + meq (list_contents l) (list_contents m). + + Lemma permut_refl : forall l:list A, permutation l l. + Proof. + unfold permutation in |- *; auto with datatypes. + Qed. + + Lemma permut_sym : + forall l1 l2 : list A, permutation l1 l2 -> permutation l2 l1. + Proof. + unfold permutation, meq; intros; apply sym_eq; trivial. + Qed. + + Lemma permut_tran : + forall l m n:list A, permutation l m -> permutation m n -> permutation l n. + Proof. + unfold permutation in |- *; intros. + apply meq_trans with (list_contents m); auto with datatypes. + Qed. + + Lemma permut_cons : + forall l m:list A, + permutation l m -> forall a:A, permutation (a :: l) (a :: m). + Proof. + unfold permutation in |- *; simpl in |- *; auto with datatypes. + Qed. + + Lemma permut_app : + forall l l' m m':list A, + permutation l l' -> permutation m m' -> permutation (l ++ m) (l' ++ m'). + Proof. + unfold permutation in |- *; intros. + apply meq_trans with (munion (list_contents l) (list_contents m)); + auto using permut_cons, list_contents_app with datatypes. + apply meq_trans with (munion (list_contents l') (list_contents m')); + auto using permut_cons, list_contents_app with datatypes. + apply meq_trans with (munion (list_contents l') (list_contents m)); + auto using permut_cons, list_contents_app with datatypes. + Qed. + + Lemma permut_add_inside : + forall a l1 l2 l3 l4, + permutation (l1 ++ l2) (l3 ++ l4) -> + permutation (l1 ++ a :: l2) (l3 ++ a :: l4). + Proof. + unfold permutation, meq in *; intros. + generalize (H a0); clear H. + do 4 rewrite list_contents_app. + simpl. + destruct (eqA_dec a a0); simpl; auto with arith. + do 2 rewrite <- plus_n_Sm; f_equal; auto. + Qed. + + Lemma permut_add_cons_inside : + forall a l l1 l2, + permutation l (l1 ++ l2) -> + permutation (a :: l) (l1 ++ a :: l2). + Proof. + intros; + replace (a :: l) with (nil ++ a :: l); trivial; + apply permut_add_inside; trivial. + Qed. + + Lemma permut_middle : + forall (l m:list A) (a:A), permutation (a :: l ++ m) (l ++ a :: m). + Proof. + intros; apply permut_add_cons_inside; auto using permut_sym, permut_refl. + Qed. + + Lemma permut_sym_app : + forall l1 l2, permutation (l1 ++ l2) (l2 ++ l1). + Proof. + intros l1 l2; + unfold permutation, meq; + intro a; do 2 rewrite list_contents_app; simpl; + auto with arith. + Qed. + + Lemma permut_rev : + forall l, permutation l (rev l). + Proof. + induction l. + simpl; trivial using permut_refl. + simpl. + apply permut_add_cons_inside. + rewrite <- app_nil_end. trivial. + Qed. + + (** * Some inversion results. *) + Lemma permut_conv_inv : + forall e l1 l2, permutation (e :: l1) (e :: l2) -> permutation l1 l2. + Proof. + intros e l1 l2; unfold permutation, meq; simpl; intros H a; + generalize (H a); apply plus_reg_l. + Qed. + + Lemma permut_app_inv1 : + forall l l1 l2, permutation (l1 ++ l) (l2 ++ l) -> permutation l1 l2. + Proof. + intros l l1 l2; unfold permutation, meq; simpl; + intros H a; generalize (H a); clear H. + do 2 rewrite list_contents_app. + simpl. + intros; apply plus_reg_l with (multiplicity (list_contents l) a). + rewrite plus_comm; rewrite H; rewrite plus_comm. + trivial. + Qed. + + Lemma permut_app_inv2 : + forall l l1 l2, permutation (l ++ l1) (l ++ l2) -> permutation l1 l2. + Proof. + intros l l1 l2; unfold permutation, meq; simpl; + intros H a; generalize (H a); clear H. + do 2 rewrite list_contents_app. + simpl. + intros; apply plus_reg_l with (multiplicity (list_contents l) a). + trivial. + Qed. + + Lemma permut_remove_hd : + forall l l1 l2 a, + permutation (a :: l) (l1 ++ a :: l2) -> permutation l (l1 ++ l2). + Proof. + intros l l1 l2 a; unfold permutation, meq; simpl; intros H a0; generalize (H a0); clear H. + do 2 rewrite list_contents_app; simpl; intro H. + apply plus_reg_l with (if eqA_dec a a0 then 1 else 0). + rewrite H; clear H. + symmetry; rewrite plus_comm. + repeat rewrite <- plus_assoc; f_equal. + apply plus_comm. + Qed. End defs. -(* For compatibilty *) + +(** For compatibilty *) Notation permut_right := permut_cons. Unset Implicit Arguments. diff --git a/theories/Sorting/Sorting.v b/theories/Sorting/Sorting.v index 0e0bfe8f..f895d79e 100644 --- a/theories/Sorting/Sorting.v +++ b/theories/Sorting/Sorting.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Sorting.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Sorting.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import List. Require Import Multiset. @@ -17,107 +17,107 @@ Set Implicit Arguments. Section defs. -Variable A : Set. -Variable leA : relation A. -Variable eqA : relation A. + Variable A : Set. + Variable leA : relation A. + Variable eqA : relation A. -Let gtA (x y:A) := ~ leA x y. + Let gtA (x y:A) := ~ leA x y. + + Hypothesis leA_dec : forall x y:A, {leA x y} + {leA y x}. + Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}. + Hypothesis leA_refl : forall x y:A, eqA x y -> leA x y. + Hypothesis leA_trans : forall x y z:A, leA x y -> leA y z -> leA x z. + Hypothesis leA_antisym : forall x y:A, leA x y -> leA y x -> eqA x y. -Hypothesis leA_dec : forall x y:A, {leA x y} + {leA y x}. -Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}. -Hypothesis leA_refl : forall x y:A, eqA x y -> leA x y. -Hypothesis leA_trans : forall x y z:A, leA x y -> leA y z -> leA x z. -Hypothesis leA_antisym : forall x y:A, leA x y -> leA y x -> eqA x y. + Hint Resolve leA_refl. + Hint Immediate eqA_dec leA_dec leA_antisym. -Hint Resolve leA_refl. -Hint Immediate eqA_dec leA_dec leA_antisym. + Let emptyBag := EmptyBag A. + Let singletonBag := SingletonBag _ eqA_dec. -Let emptyBag := EmptyBag A. -Let singletonBag := SingletonBag _ eqA_dec. + (** [lelistA] *) -(** [lelistA] *) + Inductive lelistA (a:A) : list A -> Prop := + | nil_leA : lelistA a nil + | cons_leA : forall (b:A) (l:list A), leA a b -> lelistA a (b :: l). -Inductive lelistA (a:A) : list A -> Prop := - | nil_leA : lelistA a nil - | cons_leA : forall (b:A) (l:list A), leA a b -> lelistA a (b :: l). -Hint Constructors lelistA. + Lemma lelistA_inv : forall (a b:A) (l:list A), lelistA a (b :: l) -> leA a b. + Proof. + intros; inversion H; trivial with datatypes. + Qed. -Lemma lelistA_inv : forall (a b:A) (l:list A), lelistA a (b :: l) -> leA a b. -Proof. - intros; inversion H; trivial with datatypes. -Qed. + (** * Definition for a list to be sorted *) -(** definition for a list to be sorted *) - -Inductive sort : list A -> Prop := - | nil_sort : sort nil - | cons_sort : + Inductive sort : list A -> Prop := + | nil_sort : sort nil + | cons_sort : forall (a:A) (l:list A), sort l -> lelistA a l -> sort (a :: l). -Hint Constructors sort. - -Lemma sort_inv : - forall (a:A) (l:list A), sort (a :: l) -> sort l /\ lelistA a l. -Proof. -intros; inversion H; auto with datatypes. -Qed. - -Lemma sort_rec : - forall P:list A -> Set, - P nil -> - (forall (a:A) (l:list A), sort l -> P l -> lelistA a l -> P (a :: l)) -> - forall y:list A, sort y -> P y. -Proof. -simple induction y; auto with datatypes. -intros; elim (sort_inv (a:=a) (l:=l)); auto with datatypes. -Qed. - -(** merging two sorted lists *) - -Inductive merge_lem (l1 l2:list A) : Set := + + Lemma sort_inv : + forall (a:A) (l:list A), sort (a :: l) -> sort l /\ lelistA a l. + Proof. + intros; inversion H; auto with datatypes. + Qed. + + Lemma sort_rec : + forall P:list A -> Set, + P nil -> + (forall (a:A) (l:list A), sort l -> P l -> lelistA a l -> P (a :: l)) -> + forall y:list A, sort y -> P y. + Proof. + simple induction y; auto with datatypes. + intros; elim (sort_inv (a:=a) (l:=l)); auto with datatypes. + Qed. + + (** * Merging two sorted lists *) + + Inductive merge_lem (l1 l2:list A) : Set := merge_exist : - forall l:list A, - sort l -> - meq (list_contents _ eqA_dec l) - (munion (list_contents _ eqA_dec l1) (list_contents _ eqA_dec l2)) -> - (forall a:A, lelistA a l1 -> lelistA a l2 -> lelistA a l) -> - merge_lem l1 l2. - -Lemma merge : - forall l1:list A, sort l1 -> forall l2:list A, sort l2 -> merge_lem l1 l2. -Proof. - simple induction 1; intros. - apply merge_exist with l2; auto with datatypes. - elim H3; intros. - apply merge_exist with (a :: l); simpl in |- *; auto with datatypes. - elim (leA_dec a a0); intros. - -(* 1 (leA a a0) *) - cut (merge_lem l (a0 :: l0)); auto with datatypes. - intros [l3 l3sorted l3contents Hrec]. - apply merge_exist with (a :: l3); simpl in |- *; auto with datatypes. - apply meq_trans with - (munion (singletonBag a) - (munion (list_contents _ eqA_dec l) - (list_contents _ eqA_dec (a0 :: l0)))). - apply meq_right; trivial with datatypes. - apply meq_sym; apply munion_ass. - intros; apply cons_leA. - apply lelistA_inv with l; trivial with datatypes. - -(* 2 (leA a0 a) *) - elim H5; simpl in |- *; intros. - apply merge_exist with (a0 :: l3); simpl in |- *; auto with datatypes. - apply meq_trans with - (munion (singletonBag a0) - (munion (munion (singletonBag a) (list_contents _ eqA_dec l)) - (list_contents _ eqA_dec l0))). - apply meq_right; trivial with datatypes. - apply munion_perm_left. - intros; apply cons_leA; apply lelistA_inv with l0; trivial with datatypes. -Qed. + forall l:list A, + sort l -> + meq (list_contents _ eqA_dec l) + (munion (list_contents _ eqA_dec l1) (list_contents _ eqA_dec l2)) -> + (forall a:A, lelistA a l1 -> lelistA a l2 -> lelistA a l) -> + merge_lem l1 l2. + + Lemma merge : + forall l1:list A, sort l1 -> forall l2:list A, sort l2 -> merge_lem l1 l2. + Proof. + simple induction 1; intros. + apply merge_exist with l2; auto with datatypes. + elim H3; intros. + apply merge_exist with (a :: l); simpl in |- *; auto using cons_sort with datatypes. + elim (leA_dec a a0); intros. + + (* 1 (leA a a0) *) + cut (merge_lem l (a0 :: l0)); auto using cons_sort with datatypes. + intros [l3 l3sorted l3contents Hrec]. + apply merge_exist with (a :: l3); simpl in |- *; + auto using cons_sort, cons_leA with datatypes. + apply meq_trans with + (munion (singletonBag a) + (munion (list_contents _ eqA_dec l) + (list_contents _ eqA_dec (a0 :: l0)))). + apply meq_right; trivial with datatypes. + apply meq_sym; apply munion_ass. + intros; apply cons_leA. + apply lelistA_inv with l; trivial with datatypes. + + (* 2 (leA a0 a) *) + elim H5; simpl in |- *; intros. + apply merge_exist with (a0 :: l3); simpl in |- *; + auto using cons_sort, cons_leA with datatypes. + apply meq_trans with + (munion (singletonBag a0) + (munion (munion (singletonBag a) (list_contents _ eqA_dec l)) + (list_contents _ eqA_dec l0))). + apply meq_right; trivial with datatypes. + apply munion_perm_left. + intros; apply cons_leA; apply lelistA_inv with l0; trivial with datatypes. + Qed. End defs. Unset Implicit Arguments. Hint Constructors sort: datatypes v62. -Hint Constructors lelistA: datatypes v62.
\ No newline at end of file +Hint Constructors lelistA: datatypes v62. diff --git a/theories/Strings/Ascii.v b/theories/Strings/Ascii.v index 919989fd..1c02be7f 100644 --- a/theories/Strings/Ascii.v +++ b/theories/Strings/Ascii.v @@ -6,17 +6,17 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: Ascii.v 8026 2006-02-11 19:40:49Z herbelin $ *) +(* $Id: Ascii.v 9245 2006-10-17 12:53:34Z notin $ *) -(* Contributed by Laurent Théry (INRIA); - Adapted to Coq V8 by the Coq Development Team *) +(** Contributed by Laurent Théry (INRIA); + Adapted to Coq V8 by the Coq Development Team *) Require Import Bool. Require Import BinPos. -(** *** Definition of ascii characters *) +(** * Definition of ascii characters *) -(* Definition of ascii character as a 8 bits constructor *) +(** Definition of ascii character as a 8 bits constructor *) Inductive ascii : Set := Ascii (_ _ _ _ _ _ _ _ : bool). @@ -29,86 +29,86 @@ Definition one := Ascii true false false false false false false false. Definition app1 (f : bool -> bool) (a : ascii) := match a with - | Ascii a1 a2 a3 a4 a5 a6 a7 a8 => + | Ascii a1 a2 a3 a4 a5 a6 a7 a8 => Ascii (f a1) (f a2) (f a3) (f a4) (f a5) (f a6) (f a7) (f a8) end. Definition app2 (f : bool -> bool -> bool) (a b : ascii) := match a, b with - | Ascii a1 a2 a3 a4 a5 a6 a7 a8, Ascii b1 b2 b3 b4 b5 b6 b7 b8 => + | Ascii a1 a2 a3 a4 a5 a6 a7 a8, Ascii b1 b2 b3 b4 b5 b6 b7 b8 => Ascii (f a1 b1) (f a2 b2) (f a3 b3) (f a4 b4) - (f a5 b5) (f a6 b6) (f a7 b7) (f a8 b8) + (f a5 b5) (f a6 b6) (f a7 b7) (f a8 b8) end. Definition shift (c : bool) (a : ascii) := match a with - | Ascii a1 a2 a3 a4 a5 a6 a7 a8 => Ascii c a1 a2 a3 a4 a5 a6 a7 + | Ascii a1 a2 a3 a4 a5 a6 a7 a8 => Ascii c a1 a2 a3 a4 a5 a6 a7 end. -(* Definition of a decidable function that is effective *) +(** Definition of a decidable function that is effective *) Definition ascii_dec : forall a b : ascii, {a = b} + {a <> b}. - decide equality; apply bool_dec. + decide equality; apply bool_dec. Defined. -(** *** Conversion between natural numbers modulo 256 and ascii characters *) +(** * Conversion between natural numbers modulo 256 and ascii characters *) -(* Auxillary function that turns a positive into an ascii by +(** Auxillary function that turns a positive into an ascii by looking at the last n bits, ie z mod 2^n *) Fixpoint ascii_of_pos_aux (res acc : ascii) (z : positive) - (n : nat) {struct n} : ascii := + (n : nat) {struct n} : ascii := match n with - | O => res - | S n1 => + | O => res + | S n1 => match z with - | xH => app2 orb res acc - | xI z' => ascii_of_pos_aux (app2 orb res acc) (shift false acc) z' n1 - | xO z' => ascii_of_pos_aux res (shift false acc) z' n1 + | xH => app2 orb res acc + | xI z' => ascii_of_pos_aux (app2 orb res acc) (shift false acc) z' n1 + | xO z' => ascii_of_pos_aux res (shift false acc) z' n1 end end. -(* Function that turns a positive into an ascii by - looking at the last 8 bits, ie a mod 8 *) +(** Function that turns a positive into an ascii by + looking at the last 8 bits, ie a mod 8 *) Definition ascii_of_pos (a : positive) := ascii_of_pos_aux zero one a 8. - -(* Function that turns a Peano number into an ascii by converting it - to positive *) + +(** Function that turns a Peano number into an ascii by converting it + to positive *) Definition ascii_of_nat (a : nat) := match a with - | O => zero - | S a' => ascii_of_pos (P_of_succ_nat a') + | O => zero + | S a' => ascii_of_pos (P_of_succ_nat a') end. -(* The opposite function *) +(** The opposite function *) Definition nat_of_ascii (a : ascii) : nat := let (a1, a2, a3, a4, a5, a6, a7, a8) := a in - 2 * + 2 * + (2 * (2 * - (2 * (2 * - (2 * (2 * - (2 * (if a8 then 1 else 0) - + (if a7 then 1 else 0)) - + (if a6 then 1 else 0)) - + (if a5 then 1 else 0)) - + (if a4 then 1 else 0)) + (2 * + (2 * (if a8 then 1 else 0) + + (if a7 then 1 else 0)) + + (if a6 then 1 else 0)) + + (if a5 then 1 else 0)) + + (if a4 then 1 else 0)) + (if a3 then 1 else 0)) - + (if a2 then 1 else 0)) - + (if a1 then 1 else 0). + + (if a2 then 1 else 0)) + + (if a1 then 1 else 0). Theorem ascii_nat_embedding : forall a : ascii, ascii_of_nat (nat_of_ascii a) = a. Proof. destruct a as [[|][|][|][|][|][|][|][|]]; compute; reflexivity. -Abort. +Qed. -(** *** Concrete syntax *) +(** * Concrete syntax *) (** Ascii characters can be represented in scope char_scope as follows: diff --git a/theories/Wellfounded/Disjoint_Union.v b/theories/Wellfounded/Disjoint_Union.v index 940569bd..1e22730b 100644 --- a/theories/Wellfounded/Disjoint_Union.v +++ b/theories/Wellfounded/Disjoint_Union.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Disjoint_Union.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Disjoint_Union.v 9245 2006-10-17 12:53:34Z notin $ i*) (** Author: Cristina Cornes From : Constructing Recursion Operators in Type Theory @@ -15,41 +15,41 @@ Require Import Relation_Operators. Section Wf_Disjoint_Union. -Variables A B : Set. -Variable leA : A -> A -> Prop. -Variable leB : B -> B -> Prop. - -Notation Le_AsB := (le_AsB A B leA leB). - -Lemma acc_A_sum : forall x:A, Acc leA x -> Acc Le_AsB (inl B x). -Proof. - induction 1. - apply Acc_intro; intros y H2. - inversion_clear H2. - auto with sets. -Qed. - -Lemma acc_B_sum : - well_founded leA -> forall x:B, Acc leB x -> Acc Le_AsB (inr A x). -Proof. - induction 2. - apply Acc_intro; intros y H3. - inversion_clear H3; auto with sets. - apply acc_A_sum; auto with sets. -Qed. - - -Lemma wf_disjoint_sum : - well_founded leA -> well_founded leB -> well_founded Le_AsB. -Proof. - intros. - unfold well_founded in |- *. - destruct a as [a| b]. - apply (acc_A_sum a). - apply (H a). - - apply (acc_B_sum H b). - apply (H0 b). -Qed. + Variables A B : Set. + Variable leA : A -> A -> Prop. + Variable leB : B -> B -> Prop. + + Notation Le_AsB := (le_AsB A B leA leB). + + Lemma acc_A_sum : forall x:A, Acc leA x -> Acc Le_AsB (inl B x). + Proof. + induction 1. + apply Acc_intro; intros y H2. + inversion_clear H2. + auto with sets. + Qed. + + Lemma acc_B_sum : + well_founded leA -> forall x:B, Acc leB x -> Acc Le_AsB (inr A x). + Proof. + induction 2. + apply Acc_intro; intros y H3. + inversion_clear H3; auto with sets. + apply acc_A_sum; auto with sets. + Qed. + + + Lemma wf_disjoint_sum : + well_founded leA -> well_founded leB -> well_founded Le_AsB. + Proof. + intros. + unfold well_founded in |- *. + destruct a as [a| b]. + apply (acc_A_sum a). + apply (H a). + + apply (acc_B_sum H b). + apply (H0 b). + Qed. End Wf_Disjoint_Union.
\ No newline at end of file diff --git a/theories/Wellfounded/Inclusion.v b/theories/Wellfounded/Inclusion.v index f596640d..44e07d0b 100644 --- a/theories/Wellfounded/Inclusion.v +++ b/theories/Wellfounded/Inclusion.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Inclusion.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Inclusion.v 9245 2006-10-17 12:53:34Z notin $ i*) (** Author: Bruno Barras *) @@ -21,7 +21,7 @@ Section WfInclusion. induction 2. apply Acc_intro; auto with sets. Qed. - + Hint Resolve Acc_incl. Theorem wf_incl : inclusion A R1 R2 -> well_founded R2 -> well_founded R1. diff --git a/theories/Wellfounded/Inverse_Image.v b/theories/Wellfounded/Inverse_Image.v index 3323590e..210cc757 100644 --- a/theories/Wellfounded/Inverse_Image.v +++ b/theories/Wellfounded/Inverse_Image.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Inverse_Image.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Inverse_Image.v 9245 2006-10-17 12:53:34Z notin $ i*) (** Author: Bruno Barras *) @@ -19,6 +19,7 @@ Section Inverse_Image. Let Rof (x y:A) : Prop := R (f x) (f y). Remark Acc_lemma : forall y:B, Acc R y -> forall x:A, y = f x -> Acc Rof x. + Proof. induction 1 as [y _ IHAcc]; intros x H. apply Acc_intro; intros y0 H1. apply (IHAcc (f y0)); try trivial. @@ -26,30 +27,34 @@ Section Inverse_Image. Qed. Lemma Acc_inverse_image : forall x:A, Acc R (f x) -> Acc Rof x. + Proof. intros; apply (Acc_lemma (f x)); trivial. Qed. Theorem wf_inverse_image : well_founded R -> well_founded Rof. + Proof. red in |- *; intros; apply Acc_inverse_image; auto. Qed. Variable F : A -> B -> Prop. Let RoF (x y:A) : Prop := - exists2 b : B, F x b & (forall c:B, F y c -> R b c). - -Lemma Acc_inverse_rel : forall b:B, Acc R b -> forall x:A, F x b -> Acc RoF x. -induction 1 as [x _ IHAcc]; intros x0 H2. -constructor; intros y H3. -destruct H3. -apply (IHAcc x1); auto. -Qed. - - -Theorem wf_inverse_rel : well_founded R -> well_founded RoF. + exists2 b : B, F x b & (forall c:B, F y c -> R b c). + + Lemma Acc_inverse_rel : forall b:B, Acc R b -> forall x:A, F x b -> Acc RoF x. + Proof. + induction 1 as [x _ IHAcc]; intros x0 H2. + constructor; intros y H3. + destruct H3. + apply (IHAcc x1); auto. + Qed. + + + Theorem wf_inverse_rel : well_founded R -> well_founded RoF. + Proof. red in |- *; constructor; intros. case H0; intros. apply (Acc_inverse_rel x); auto. -Qed. + Qed. End Inverse_Image. diff --git a/theories/Wellfounded/Lexicographic_Exponentiation.v b/theories/Wellfounded/Lexicographic_Exponentiation.v index 988d2475..24816a20 100644 --- a/theories/Wellfounded/Lexicographic_Exponentiation.v +++ b/theories/Wellfounded/Lexicographic_Exponentiation.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Lexicographic_Exponentiation.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Lexicographic_Exponentiation.v 9245 2006-10-17 12:53:34Z notin $ i*) (** Author: Cristina Cornes @@ -19,356 +19,350 @@ Require Import Relation_Operators. Require Import Transitive_Closure. Section Wf_Lexicographic_Exponentiation. -Variable A : Set. -Variable leA : A -> A -> Prop. - -Notation Power := (Pow A leA). -Notation Lex_Exp := (lex_exp A leA). -Notation ltl := (Ltl A leA). -Notation Descl := (Desc A leA). - -Notation List := (list A). -Notation Nil := (nil (A:=A)). -(* useless but symmetric *) -Notation Cons := (cons (A:=A)). -Notation "<< x , y >>" := (exist Descl x y) (at level 0, x, y at level 100). - -Hint Resolve d_one d_nil t_step. - -Lemma left_prefix : forall x y z:List, ltl (x ++ y) z -> ltl x z. -Proof. - simple induction x. - simple induction z. - simpl in |- *; intros H. - inversion_clear H. - simpl in |- *; intros; apply (Lt_nil A leA). - intros a l HInd. - simpl in |- *. - intros. - inversion_clear H. - apply (Lt_hd A leA); auto with sets. - apply (Lt_tl A leA). - apply (HInd y y0); auto with sets. -Qed. - - -Lemma right_prefix : - forall x y z:List, - ltl x (y ++ z) -> ltl x y \/ (exists y' : List, x = y ++ y' /\ ltl y' z). -Proof. - intros x y; generalize x. - elim y; simpl in |- *. - right. - exists x0; auto with sets. - intros. - inversion H0. - left; apply (Lt_nil A leA). - left; apply (Lt_hd A leA); auto with sets. - generalize (H x1 z H3). - simple induction 1. - left; apply (Lt_tl A leA); auto with sets. - simple induction 1. - simple induction 1; intros. - rewrite H8. - right; exists x2; auto with sets. -Qed. - - - -Lemma desc_prefix : forall (x:List) (a:A), Descl (x ++ Cons a Nil) -> Descl x. -Proof. - intros. - inversion H. - generalize (app_cons_not_nil _ _ _ H1); simple induction 1. - cut (x ++ Cons a Nil = Cons x0 Nil); auto with sets. - intro. - generalize (app_eq_unit _ _ H0). - simple induction 1; simple induction 1; intros. - rewrite H4; auto with sets. - discriminate H5. - generalize (app_inj_tail _ _ _ _ H0). - simple induction 1; intros. - rewrite <- H4; auto with sets. -Qed. - -Lemma desc_tail : - forall (x:List) (a b:A), - Descl (Cons b (x ++ Cons a Nil)) -> clos_trans A leA a b. -Proof. - intro. - apply rev_ind with - (A := A) - (P := fun x:List => - forall a b:A, - Descl (Cons b (x ++ Cons a Nil)) -> clos_trans A leA a b). - intros. - - inversion H. - cut (Cons b (Cons a Nil) = (Nil ++ Cons b Nil) ++ Cons a Nil); - auto with sets; intro. - generalize H0. - intro. - generalize (app_inj_tail (l ++ Cons y Nil) (Nil ++ Cons b Nil) _ _ H4); - simple induction 1. - intros. - - generalize (app_inj_tail _ _ _ _ H6); simple induction 1; intros. - generalize H1. - rewrite <- H10; rewrite <- H7; intro. - apply (t_step A leA); auto with sets. - - - - intros. - inversion H0. - generalize (app_cons_not_nil _ _ _ H3); intro. - elim H1. - - generalize H0. - generalize (app_comm_cons (l ++ Cons x0 Nil) (Cons a Nil) b); - simple induction 1. - intro. - generalize (desc_prefix (Cons b (l ++ Cons x0 Nil)) a H5); intro. - generalize (H x0 b H6). - intro. - apply t_trans with (A := A) (y := x0); auto with sets. - - apply t_step. - generalize H1. - rewrite H4; intro. - - generalize (app_inj_tail _ _ _ _ H8); simple induction 1. - intros. - generalize H2; generalize (app_comm_cons l (Cons x0 Nil) b). - intro. - generalize H10. - rewrite H12; intro. - generalize (app_inj_tail _ _ _ _ H13); simple induction 1. - intros. - rewrite <- H11; rewrite <- H16; auto with sets. -Qed. - - -Lemma dist_aux : - forall z:List, Descl z -> forall x y:List, z = x ++ y -> Descl x /\ Descl y. -Proof. - intros z D. - elim D. - intros. - cut (x ++ y = Nil); auto with sets; intro. - generalize (app_eq_nil _ _ H0); simple induction 1. - intros. - rewrite H2; rewrite H3; split; apply d_nil. - - intros. - cut (x0 ++ y = Cons x Nil); auto with sets. - intros E. - generalize (app_eq_unit _ _ E); simple induction 1. - simple induction 1; intros. - rewrite H2; rewrite H3; split. - apply d_nil. - - apply d_one. - - simple induction 1; intros. - rewrite H2; rewrite H3; split. - apply d_one. - - apply d_nil. - - do 5 intro. - intros Hind. - do 2 intro. - generalize x0. - apply rev_ind with - (A := A) - (P := fun y0:List => - forall x0:List, - (l ++ Cons y Nil) ++ Cons x Nil = x0 ++ y0 -> - Descl x0 /\ Descl y0). - - intro. - generalize (app_nil_end x1); simple induction 1; simple induction 1. - split. apply d_conc; auto with sets. - - apply d_nil. - - do 3 intro. - generalize x1. - apply rev_ind with - (A := A) - (P := fun l0:List => - forall (x1:A) (x0:List), - (l ++ Cons y Nil) ++ Cons x Nil = x0 ++ l0 ++ Cons x1 Nil -> - Descl x0 /\ Descl (l0 ++ Cons x1 Nil)). - - - simpl in |- *. - split. - generalize (app_inj_tail _ _ _ _ H2); simple induction 1. - simple induction 1; auto with sets. - - apply d_one. - do 5 intro. - generalize (app_ass x4 (l1 ++ Cons x2 Nil) (Cons x3 Nil)). - simple induction 1. - generalize (app_ass x4 l1 (Cons x2 Nil)); simple induction 1. - intro E. - generalize (app_inj_tail _ _ _ _ E). - simple induction 1; intros. - generalize (app_inj_tail _ _ _ _ H6); simple induction 1; intros. - rewrite <- H7; rewrite <- H10; generalize H6. - generalize (app_ass x4 l1 (Cons x2 Nil)); intro E1. - rewrite E1. - intro. - generalize (Hind x4 (l1 ++ Cons x2 Nil) H11). - simple induction 1; split. - auto with sets. - - generalize H14. - rewrite <- H10; intro. - apply d_conc; auto with sets. -Qed. - - - -Lemma dist_Desc_concat : - forall x y:List, Descl (x ++ y) -> Descl x /\ Descl y. -Proof. - intros. - apply (dist_aux (x ++ y) H x y); auto with sets. -Qed. - - -Lemma desc_end : - forall (a b:A) (x:List), - Descl (x ++ Cons a Nil) /\ ltl (x ++ Cons a Nil) (Cons b Nil) -> - clos_trans A leA a b. - -Proof. - intros a b x. - case x. - simpl in |- *. - simple induction 1. - intros. - inversion H1; auto with sets. - inversion H3. - - simple induction 1. - generalize (app_comm_cons l (Cons a Nil) a0). - intros E; rewrite <- E; intros. - generalize (desc_tail l a a0 H0); intro. - inversion H1. - apply t_trans with (y := a0); auto with sets. - - inversion H4. -Qed. - - - - -Lemma ltl_unit : - forall (x:List) (a b:A), - Descl (x ++ Cons a Nil) -> - ltl (x ++ Cons a Nil) (Cons b Nil) -> ltl x (Cons b Nil). -Proof. - intro. - case x. - intros; apply (Lt_nil A leA). - - simpl in |- *; intros. - inversion_clear H0. - apply (Lt_hd A leA a b); auto with sets. - - inversion_clear H1. -Qed. - - -Lemma acc_app : - forall (x1 x2:List) (y1:Descl (x1 ++ x2)), - Acc Lex_Exp << x1 ++ x2, y1 >> -> - forall (x:List) (y:Descl x), ltl x (x1 ++ x2) -> Acc Lex_Exp << x, y >>. -Proof. - intros. - apply (Acc_inv (R:=Lex_Exp) (x:=<< x1 ++ x2, y1 >>)). - auto with sets. - - unfold lex_exp in |- *; simpl in |- *; auto with sets. -Qed. - - -Theorem wf_lex_exp : well_founded leA -> well_founded Lex_Exp. -Proof. - unfold well_founded at 2 in |- *. - simple induction a; intros x y. - apply Acc_intro. - simple induction y0. - unfold lex_exp at 1 in |- *; simpl in |- *. - apply rev_ind with - (A := A) - (P := fun x:List => - forall (x0:List) (y:Descl x0), ltl x0 x -> Acc Lex_Exp << x0, y >>). - intros. - inversion_clear H0. - - intro. - generalize (well_founded_ind (wf_clos_trans A leA H)). - intros GR. - apply GR with - (P := fun x0:A => - forall l:List, - (forall (x1:List) (y:Descl x1), - ltl x1 l -> Acc Lex_Exp << x1, y >>) -> - forall (x1:List) (y:Descl x1), - ltl x1 (l ++ Cons x0 Nil) -> Acc Lex_Exp << x1, y >>). - intro; intros HInd; intros. - generalize (right_prefix x2 l (Cons x1 Nil) H1). - simple induction 1. - intro; apply (H0 x2 y1 H3). - - simple induction 1. - intro; simple induction 1. - clear H4 H2. - intro; generalize y1; clear y1. - rewrite H2. - apply rev_ind with - (A := A) - (P := fun x3:List => - forall y1:Descl (l ++ x3), - ltl x3 (Cons x1 Nil) -> Acc Lex_Exp << l ++ x3, y1 >>). - intros. - generalize (app_nil_end l); intros Heq. - generalize y1. - clear y1. - rewrite <- Heq. - intro. - apply Acc_intro. - simple induction y2. - unfold lex_exp at 1 in |- *. - simpl in |- *; intros x4 y3. intros. - apply (H0 x4 y3); auto with sets. - - intros. - generalize (dist_Desc_concat l (l0 ++ Cons x4 Nil) y1). - simple induction 1. - intros. - generalize (desc_end x4 x1 l0 (conj H8 H5)); intros. - generalize y1. - rewrite <- (app_ass l l0 (Cons x4 Nil)); intro. - generalize (HInd x4 H9 (l ++ l0)); intros HInd2. - generalize (ltl_unit l0 x4 x1 H8 H5); intro. - generalize (dist_Desc_concat (l ++ l0) (Cons x4 Nil) y2). - simple induction 1; intros. - generalize (H4 H12 H10); intro. - generalize (Acc_inv H14). - generalize (acc_app l l0 H12 H14). - intros f g. - generalize (HInd2 f); intro. - apply Acc_intro. - simple induction y3. - unfold lex_exp at 1 in |- *; simpl in |- *; intros. - apply H15; auto with sets. -Qed. + Variable A : Set. + Variable leA : A -> A -> Prop. + + Notation Power := (Pow A leA). + Notation Lex_Exp := (lex_exp A leA). + Notation ltl := (Ltl A leA). + Notation Descl := (Desc A leA). + + Notation List := (list A). + Notation Nil := (nil (A:=A)). + (* useless but symmetric *) + Notation Cons := (cons (A:=A)). + Notation "<< x , y >>" := (exist Descl x y) (at level 0, x, y at level 100). + + (* Hint Resolve d_one d_nil t_step. *) + + Lemma left_prefix : forall x y z:List, ltl (x ++ y) z -> ltl x z. + Proof. + simple induction x. + simple induction z. + simpl in |- *; intros H. + inversion_clear H. + simpl in |- *; intros; apply (Lt_nil A leA). + intros a l HInd. + simpl in |- *. + intros. + inversion_clear H. + apply (Lt_hd A leA); auto with sets. + apply (Lt_tl A leA). + apply (HInd y y0); auto with sets. + Qed. + + + Lemma right_prefix : + forall x y z:List, + ltl x (y ++ z) -> ltl x y \/ (exists y' : List, x = y ++ y' /\ ltl y' z). + Proof. + intros x y; generalize x. + elim y; simpl in |- *. + right. + exists x0; auto with sets. + intros. + inversion H0. + left; apply (Lt_nil A leA). + left; apply (Lt_hd A leA); auto with sets. + generalize (H x1 z H3). + simple induction 1. + left; apply (Lt_tl A leA); auto with sets. + simple induction 1. + simple induction 1; intros. + rewrite H8. + right; exists x2; auto with sets. + Qed. + + Lemma desc_prefix : forall (x:List) (a:A), Descl (x ++ Cons a Nil) -> Descl x. + Proof. + intros. + inversion H. + generalize (app_cons_not_nil _ _ _ H1); simple induction 1. + cut (x ++ Cons a Nil = Cons x0 Nil); auto with sets. + intro. + generalize (app_eq_unit _ _ H0). + simple induction 1; simple induction 1; intros. + rewrite H4; auto using d_nil with sets. + discriminate H5. + generalize (app_inj_tail _ _ _ _ H0). + simple induction 1; intros. + rewrite <- H4; auto with sets. + Qed. + + Lemma desc_tail : + forall (x:List) (a b:A), + Descl (Cons b (x ++ Cons a Nil)) -> clos_trans A leA a b. + Proof. + intro. + apply rev_ind with + (A := A) + (P := fun x:List => + forall a b:A, + Descl (Cons b (x ++ Cons a Nil)) -> clos_trans A leA a b). + intros. + + inversion H. + cut (Cons b (Cons a Nil) = (Nil ++ Cons b Nil) ++ Cons a Nil); + auto with sets; intro. + generalize H0. + intro. + generalize (app_inj_tail (l ++ Cons y Nil) (Nil ++ Cons b Nil) _ _ H4); + simple induction 1. + intros. + + generalize (app_inj_tail _ _ _ _ H6); simple induction 1; intros. + generalize H1. + rewrite <- H10; rewrite <- H7; intro. + apply (t_step A leA); auto with sets. + + intros. + inversion H0. + generalize (app_cons_not_nil _ _ _ H3); intro. + elim H1. + + generalize H0. + generalize (app_comm_cons (l ++ Cons x0 Nil) (Cons a Nil) b); + simple induction 1. + intro. + generalize (desc_prefix (Cons b (l ++ Cons x0 Nil)) a H5); intro. + generalize (H x0 b H6). + intro. + apply t_trans with (A := A) (y := x0); auto with sets. + + apply t_step. + generalize H1. + rewrite H4; intro. + + generalize (app_inj_tail _ _ _ _ H8); simple induction 1. + intros. + generalize H2; generalize (app_comm_cons l (Cons x0 Nil) b). + intro. + generalize H10. + rewrite H12; intro. + generalize (app_inj_tail _ _ _ _ H13); simple induction 1. + intros. + rewrite <- H11; rewrite <- H16; auto with sets. + Qed. + + + Lemma dist_aux : + forall z:List, Descl z -> forall x y:List, z = x ++ y -> Descl x /\ Descl y. + Proof. + intros z D. + elim D. + intros. + cut (x ++ y = Nil); auto with sets; intro. + generalize (app_eq_nil _ _ H0); simple induction 1. + intros. + rewrite H2; rewrite H3; split; apply d_nil. + + intros. + cut (x0 ++ y = Cons x Nil); auto with sets. + intros E. + generalize (app_eq_unit _ _ E); simple induction 1. + simple induction 1; intros. + rewrite H2; rewrite H3; split. + apply d_nil. + + apply d_one. + + simple induction 1; intros. + rewrite H2; rewrite H3; split. + apply d_one. + + apply d_nil. + + do 5 intro. + intros Hind. + do 2 intro. + generalize x0. + apply rev_ind with + (A := A) + (P := fun y0:List => + forall x0:List, + (l ++ Cons y Nil) ++ Cons x Nil = x0 ++ y0 -> + Descl x0 /\ Descl y0). + + intro. + generalize (app_nil_end x1); simple induction 1; simple induction 1. + split. apply d_conc; auto with sets. + + apply d_nil. + + do 3 intro. + generalize x1. + apply rev_ind with + (A := A) + (P := fun l0:List => + forall (x1:A) (x0:List), + (l ++ Cons y Nil) ++ Cons x Nil = x0 ++ l0 ++ Cons x1 Nil -> + Descl x0 /\ Descl (l0 ++ Cons x1 Nil)). + + + simpl in |- *. + split. + generalize (app_inj_tail _ _ _ _ H2); simple induction 1. + simple induction 1; auto with sets. + + apply d_one. + do 5 intro. + generalize (app_ass x4 (l1 ++ Cons x2 Nil) (Cons x3 Nil)). + simple induction 1. + generalize (app_ass x4 l1 (Cons x2 Nil)); simple induction 1. + intro E. + generalize (app_inj_tail _ _ _ _ E). + simple induction 1; intros. + generalize (app_inj_tail _ _ _ _ H6); simple induction 1; intros. + rewrite <- H7; rewrite <- H10; generalize H6. + generalize (app_ass x4 l1 (Cons x2 Nil)); intro E1. + rewrite E1. + intro. + generalize (Hind x4 (l1 ++ Cons x2 Nil) H11). + simple induction 1; split. + auto with sets. + + generalize H14. + rewrite <- H10; intro. + apply d_conc; auto with sets. + Qed. + + + + Lemma dist_Desc_concat : + forall x y:List, Descl (x ++ y) -> Descl x /\ Descl y. + Proof. + intros. + apply (dist_aux (x ++ y) H x y); auto with sets. + Qed. + + Lemma desc_end : + forall (a b:A) (x:List), + Descl (x ++ Cons a Nil) /\ ltl (x ++ Cons a Nil) (Cons b Nil) -> + clos_trans A leA a b. + Proof. + intros a b x. + case x. + simpl in |- *. + simple induction 1. + intros. + inversion H1; auto with sets. + inversion H3. + + simple induction 1. + generalize (app_comm_cons l (Cons a Nil) a0). + intros E; rewrite <- E; intros. + generalize (desc_tail l a a0 H0); intro. + inversion H1. + apply t_trans with (y := a0); auto with sets. + + inversion H4. + Qed. + + + + + Lemma ltl_unit : + forall (x:List) (a b:A), + Descl (x ++ Cons a Nil) -> + ltl (x ++ Cons a Nil) (Cons b Nil) -> ltl x (Cons b Nil). + Proof. + intro. + case x. + intros; apply (Lt_nil A leA). + + simpl in |- *; intros. + inversion_clear H0. + apply (Lt_hd A leA a b); auto with sets. + + inversion_clear H1. + Qed. + + + Lemma acc_app : + forall (x1 x2:List) (y1:Descl (x1 ++ x2)), + Acc Lex_Exp << x1 ++ x2, y1 >> -> + forall (x:List) (y:Descl x), ltl x (x1 ++ x2) -> Acc Lex_Exp << x, y >>. + Proof. + intros. + apply (Acc_inv (R:=Lex_Exp) (x:=<< x1 ++ x2, y1 >>)). + auto with sets. + + unfold lex_exp in |- *; simpl in |- *; auto with sets. + Qed. + + + Theorem wf_lex_exp : well_founded leA -> well_founded Lex_Exp. + Proof. + unfold well_founded at 2 in |- *. + simple induction a; intros x y. + apply Acc_intro. + simple induction y0. + unfold lex_exp at 1 in |- *; simpl in |- *. + apply rev_ind with + (A := A) + (P := fun x:List => + forall (x0:List) (y:Descl x0), ltl x0 x -> Acc Lex_Exp << x0, y >>). + intros. + inversion_clear H0. + + intro. + generalize (well_founded_ind (wf_clos_trans A leA H)). + intros GR. + apply GR with + (P := fun x0:A => + forall l:List, + (forall (x1:List) (y:Descl x1), + ltl x1 l -> Acc Lex_Exp << x1, y >>) -> + forall (x1:List) (y:Descl x1), + ltl x1 (l ++ Cons x0 Nil) -> Acc Lex_Exp << x1, y >>). + intro; intros HInd; intros. + generalize (right_prefix x2 l (Cons x1 Nil) H1). + simple induction 1. + intro; apply (H0 x2 y1 H3). + + simple induction 1. + intro; simple induction 1. + clear H4 H2. + intro; generalize y1; clear y1. + rewrite H2. + apply rev_ind with + (A := A) + (P := fun x3:List => + forall y1:Descl (l ++ x3), + ltl x3 (Cons x1 Nil) -> Acc Lex_Exp << l ++ x3, y1 >>). + intros. + generalize (app_nil_end l); intros Heq. + generalize y1. + clear y1. + rewrite <- Heq. + intro. + apply Acc_intro. + simple induction y2. + unfold lex_exp at 1 in |- *. + simpl in |- *; intros x4 y3. intros. + apply (H0 x4 y3); auto with sets. + + intros. + generalize (dist_Desc_concat l (l0 ++ Cons x4 Nil) y1). + simple induction 1. + intros. + generalize (desc_end x4 x1 l0 (conj H8 H5)); intros. + generalize y1. + rewrite <- (app_ass l l0 (Cons x4 Nil)); intro. + generalize (HInd x4 H9 (l ++ l0)); intros HInd2. + generalize (ltl_unit l0 x4 x1 H8 H5); intro. + generalize (dist_Desc_concat (l ++ l0) (Cons x4 Nil) y2). + simple induction 1; intros. + generalize (H4 H12 H10); intro. + generalize (Acc_inv H14). + generalize (acc_app l l0 H12 H14). + intros f g. + generalize (HInd2 f); intro. + apply Acc_intro. + simple induction y3. + unfold lex_exp at 1 in |- *; simpl in |- *; intros. + apply H15; auto with sets. + Qed. End Wf_Lexicographic_Exponentiation. diff --git a/theories/Wellfounded/Lexicographic_Product.v b/theories/Wellfounded/Lexicographic_Product.v index 035c1e65..8ac0d546 100644 --- a/theories/Wellfounded/Lexicographic_Product.v +++ b/theories/Wellfounded/Lexicographic_Product.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Lexicographic_Product.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Lexicographic_Product.v 9245 2006-10-17 12:53:34Z notin $ i*) (** Authors: Bruno Barras, Cristina Cornes *) @@ -18,58 +18,56 @@ Require Import Transitive_Closure. L. Paulson JSC (1986) 2, 325-355 *) Section WfLexicographic_Product. -Variable A : Set. -Variable B : A -> Set. -Variable leA : A -> A -> Prop. -Variable leB : forall x:A, B x -> B x -> Prop. - -Notation LexProd := (lexprod A B leA leB). - -Hint Resolve t_step Acc_clos_trans wf_clos_trans. - -Lemma acc_A_B_lexprod : - forall x:A, - Acc leA x -> - (forall x0:A, clos_trans A leA x0 x -> well_founded (leB x0)) -> - forall y:B x, Acc (leB x) y -> Acc LexProd (existS B x y). -Proof. - induction 1 as [x _ IHAcc]; intros H2 y. - induction 1 as [x0 H IHAcc0]; intros. - apply Acc_intro. - destruct y as [x2 y1]; intro H6. - simple inversion H6; intro. - cut (leA x2 x); intros. - apply IHAcc; auto with sets. - intros. - apply H2. - apply t_trans with x2; auto with sets. - - red in H2. - apply H2. - auto with sets. - - injection H1. - destruct 2. - injection H3. - destruct 2; auto with sets. - - rewrite <- H1. - injection H3; intros _ Hx1. - subst x1. - apply IHAcc0. - elim inj_pair2 with A B x y' x0; assumption. -Qed. - -Theorem wf_lexprod : - well_founded leA -> - (forall x:A, well_founded (leB x)) -> well_founded LexProd. -Proof. - intros wfA wfB; unfold well_founded in |- *. - destruct a. - apply acc_A_B_lexprod; auto with sets; intros. - red in wfB. - auto with sets. -Qed. + Variable A : Set. + Variable B : A -> Set. + Variable leA : A -> A -> Prop. + Variable leB : forall x:A, B x -> B x -> Prop. + + Notation LexProd := (lexprod A B leA leB). + + Lemma acc_A_B_lexprod : + forall x:A, + Acc leA x -> + (forall x0:A, clos_trans A leA x0 x -> well_founded (leB x0)) -> + forall y:B x, Acc (leB x) y -> Acc LexProd (existS B x y). + Proof. + induction 1 as [x _ IHAcc]; intros H2 y. + induction 1 as [x0 H IHAcc0]; intros. + apply Acc_intro. + destruct y as [x2 y1]; intro H6. + simple inversion H6; intro. + cut (leA x2 x); intros. + apply IHAcc; auto with sets. + intros. + apply H2. + apply t_trans with x2; auto with sets. + + red in H2. + apply H2. + auto with sets. + + injection H1. + destruct 2. + injection H3. + destruct 2; auto with sets. + + rewrite <- H1. + injection H3; intros _ Hx1. + subst x1. + apply IHAcc0. + elim inj_pair2 with A B x y' x0; assumption. + Qed. + + Theorem wf_lexprod : + well_founded leA -> + (forall x:A, well_founded (leB x)) -> well_founded LexProd. + Proof. + intros wfA wfB; unfold well_founded in |- *. + destruct a. + apply acc_A_B_lexprod; auto with sets; intros. + red in wfB. + auto with sets. + Qed. End WfLexicographic_Product. @@ -83,50 +81,31 @@ Section Wf_Symmetric_Product. Notation Symprod := (symprod A B leA leB). -(*i - Local sig_prod:= - [x:A*B]<{_:A&B}>Case x of [a:A][b:B](existS A [_:A]B a b) end. - -Lemma incl_sym_lexprod: (included (A*B) Symprod - (R_o_f (A*B) {_:A&B} sig_prod (lexprod A [_:A]B leA [_:A]leB))). -Proof. - Red. - Induction x. - (Induction y1;Intros). - Red. - Unfold sig_prod . - Inversion_clear H. - (Apply left_lex;Auto with sets). - - (Apply right_lex;Auto with sets). -Qed. -i*) - Lemma Acc_symprod : - forall x:A, Acc leA x -> forall y:B, Acc leB y -> Acc Symprod (x, y). - Proof. - induction 1 as [x _ IHAcc]; intros y H2. - induction H2 as [x1 H3 IHAcc1]. - apply Acc_intro; intros y H5. - inversion_clear H5; auto with sets. - apply IHAcc; auto. - apply Acc_intro; trivial. -Qed. - - -Lemma wf_symprod : - well_founded leA -> well_founded leB -> well_founded Symprod. -Proof. - red in |- *. - destruct a. - apply Acc_symprod; auto with sets. -Qed. + forall x:A, Acc leA x -> forall y:B, Acc leB y -> Acc Symprod (x, y). + Proof. + induction 1 as [x _ IHAcc]; intros y H2. + induction H2 as [x1 H3 IHAcc1]. + apply Acc_intro; intros y H5. + inversion_clear H5; auto with sets. + apply IHAcc; auto. + apply Acc_intro; trivial. + Qed. + + + Lemma wf_symprod : + well_founded leA -> well_founded leB -> well_founded Symprod. + Proof. + red in |- *. + destruct a. + apply Acc_symprod; auto with sets. + Qed. End Wf_Symmetric_Product. Section Swap. - + Variable A : Set. Variable R : A -> A -> Prop. @@ -134,59 +113,59 @@ Section Swap. Lemma swap_Acc : forall x y:A, Acc SwapProd (x, y) -> Acc SwapProd (y, x). -Proof. - intros. - inversion_clear H. - apply Acc_intro. - destruct y0; intros. - inversion_clear H; inversion_clear H1; apply H0. - apply sp_swap. - apply right_sym; auto with sets. - - apply sp_swap. - apply left_sym; auto with sets. - - apply sp_noswap. - apply right_sym; auto with sets. - - apply sp_noswap. - apply left_sym; auto with sets. -Qed. + Proof. + intros. + inversion_clear H. + apply Acc_intro. + destruct y0; intros. + inversion_clear H; inversion_clear H1; apply H0. + apply sp_swap. + apply right_sym; auto with sets. + + apply sp_swap. + apply left_sym; auto with sets. + + apply sp_noswap. + apply right_sym; auto with sets. + + apply sp_noswap. + apply left_sym; auto with sets. + Qed. Lemma Acc_swapprod : - forall x y:A, Acc R x -> Acc R y -> Acc SwapProd (x, y). -Proof. - induction 1 as [x0 _ IHAcc0]; intros H2. - cut (forall y0:A, R y0 x0 -> Acc SwapProd (y0, y)). - clear IHAcc0. - induction H2 as [x1 _ IHAcc1]; intros H4. - cut (forall y:A, R y x1 -> Acc SwapProd (x0, y)). - clear IHAcc1. - intro. - apply Acc_intro. - destruct y; intro H5. - inversion_clear H5. - inversion_clear H0; auto with sets. - - apply swap_Acc. - inversion_clear H0; auto with sets. - - intros. - apply IHAcc1; auto with sets; intros. - apply Acc_inv with (y0, x1); auto with sets. - apply sp_noswap. - apply right_sym; auto with sets. - - auto with sets. -Qed. - - + forall x y:A, Acc R x -> Acc R y -> Acc SwapProd (x, y). + Proof. + induction 1 as [x0 _ IHAcc0]; intros H2. + cut (forall y0:A, R y0 x0 -> Acc SwapProd (y0, y)). + clear IHAcc0. + induction H2 as [x1 _ IHAcc1]; intros H4. + cut (forall y:A, R y x1 -> Acc SwapProd (x0, y)). + clear IHAcc1. + intro. + apply Acc_intro. + destruct y; intro H5. + inversion_clear H5. + inversion_clear H0; auto with sets. + + apply swap_Acc. + inversion_clear H0; auto with sets. + + intros. + apply IHAcc1; auto with sets; intros. + apply Acc_inv with (y0, x1); auto with sets. + apply sp_noswap. + apply right_sym; auto with sets. + + auto with sets. + Qed. + + Lemma wf_swapprod : well_founded R -> well_founded SwapProd. -Proof. - red in |- *. - destruct a; intros. - apply Acc_swapprod; auto with sets. -Qed. + Proof. + red in |- *. + destruct a; intros. + apply Acc_swapprod; auto with sets. + Qed. End Swap.
\ No newline at end of file diff --git a/theories/Wellfounded/Union.v b/theories/Wellfounded/Union.v index 269cfd9d..634576ad 100644 --- a/theories/Wellfounded/Union.v +++ b/theories/Wellfounded/Union.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Union.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Union.v 9245 2006-10-17 12:53:34Z notin $ i*) (** Author: Bruno Barras *) @@ -18,60 +18,58 @@ Section WfUnion. Variable A : Set. Variables R1 R2 : relation A. - Notation Union := (union A R1 R2). - - Hint Resolve Acc_clos_trans wf_clos_trans. - -Remark strip_commut : - commut A R1 R2 -> - forall x y:A, - clos_trans A R1 y x -> - forall z:A, R2 z y -> exists2 y' : A, R2 y' x & clos_trans A R1 z y'. -Proof. - induction 2 as [x y| x y z H0 IH1 H1 IH2]; intros. - elim H with y x z; auto with sets; intros x0 H2 H3. - exists x0; auto with sets. - - elim IH1 with z0; auto with sets; intros. - elim IH2 with x0; auto with sets; intros. - exists x1; auto with sets. - apply t_trans with x0; auto with sets. -Qed. + Notation Union := (union A R1 R2). + + Remark strip_commut : + commut A R1 R2 -> + forall x y:A, + clos_trans A R1 y x -> + forall z:A, R2 z y -> exists2 y' : A, R2 y' x & clos_trans A R1 z y'. + Proof. + induction 2 as [x y| x y z H0 IH1 H1 IH2]; intros. + elim H with y x z; auto with sets; intros x0 H2 H3. + exists x0; auto with sets. + + elim IH1 with z0; auto with sets; intros. + elim IH2 with x0; auto with sets; intros. + exists x1; auto with sets. + apply t_trans with x0; auto with sets. + Qed. Lemma Acc_union : - commut A R1 R2 -> - (forall x:A, Acc R2 x -> Acc R1 x) -> forall a:A, Acc R2 a -> Acc Union a. -Proof. - induction 3 as [x H1 H2]. - apply Acc_intro; intros. - elim H3; intros; auto with sets. - cut (clos_trans A R1 y x); auto with sets. - elimtype (Acc (clos_trans A R1) y); intros. - apply Acc_intro; intros. - elim H8; intros. - apply H6; auto with sets. - apply t_trans with x0; auto with sets. - - elim strip_commut with x x0 y0; auto with sets; intros. - apply Acc_inv_trans with x1; auto with sets. - unfold union in |- *. - elim H11; auto with sets; intros. - apply t_trans with y1; auto with sets. - - apply (Acc_clos_trans A). - apply Acc_inv with x; auto with sets. - apply H0. - apply Acc_intro; auto with sets. -Qed. + commut A R1 R2 -> + (forall x:A, Acc R2 x -> Acc R1 x) -> forall a:A, Acc R2 a -> Acc Union a. + Proof. + induction 3 as [x H1 H2]. + apply Acc_intro; intros. + elim H3; intros; auto with sets. + cut (clos_trans A R1 y x); auto with sets. + elimtype (Acc (clos_trans A R1) y); intros. + apply Acc_intro; intros. + elim H8; intros. + apply H6; auto with sets. + apply t_trans with x0; auto with sets. + + elim strip_commut with x x0 y0; auto with sets; intros. + apply Acc_inv_trans with x1; auto with sets. + unfold union in |- *. + elim H11; auto with sets; intros. + apply t_trans with y1; auto with sets. + apply (Acc_clos_trans A). + apply Acc_inv with x; auto with sets. + apply H0. + apply Acc_intro; auto with sets. + Qed. + Theorem wf_union : - commut A R1 R2 -> well_founded R1 -> well_founded R2 -> well_founded Union. -Proof. - unfold well_founded in |- *. - intros. - apply Acc_union; auto with sets. -Qed. + commut A R1 R2 -> well_founded R1 -> well_founded R2 -> well_founded Union. + Proof. + unfold well_founded in |- *. + intros. + apply Acc_union; auto with sets. + Qed. End WfUnion.
\ No newline at end of file diff --git a/theories/Wellfounded/Well_Ordering.v b/theories/Wellfounded/Well_Ordering.v index e9a18e74..69617de2 100644 --- a/theories/Wellfounded/Well_Ordering.v +++ b/theories/Wellfounded/Well_Ordering.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Well_Ordering.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Well_Ordering.v 9245 2006-10-17 12:53:34Z notin $ i*) (** Author: Cristina Cornes. From: Constructing Recursion Operators in Type Theory @@ -15,58 +15,57 @@ Require Import Eqdep. Section WellOrdering. -Variable A : Set. -Variable B : A -> Set. - -Inductive WO : Set := + Variable A : Set. + Variable B : A -> Set. + + Inductive WO : Set := sup : forall (a:A) (f:B a -> WO), WO. -Inductive le_WO : WO -> WO -> Prop := + Inductive le_WO : WO -> WO -> Prop := le_sup : forall (a:A) (f:B a -> WO) (v:B a), le_WO (f v) (sup a f). - -Theorem wf_WO : well_founded le_WO. -Proof. - unfold well_founded in |- *; intro. - apply Acc_intro. - elim a. - intros. - inversion H0. - apply Acc_intro. - generalize H4; generalize H1; generalize f0; generalize v. - rewrite H3. - intros. - apply (H v0 y0). - cut (f = f1). - intros E; rewrite E; auto. - symmetry in |- *. - apply (inj_pair2 A (fun a0:A => B a0 -> WO) a0 f1 f H5). -Qed. + Theorem wf_WO : well_founded le_WO. + Proof. + unfold well_founded in |- *; intro. + apply Acc_intro. + elim a. + intros. + inversion H0. + apply Acc_intro. + generalize H4; generalize H1; generalize f0; generalize v. + rewrite H3. + intros. + apply (H v0 y0). + cut (f = f1). + intros E; rewrite E; auto. + symmetry in |- *. + apply (inj_pair2 A (fun a0:A => B a0 -> WO) a0 f1 f H5). + Qed. End WellOrdering. Section Characterisation_wf_relations. -(** Wellfounded relations are the inverse image of wellordering types *) -(* in course of development *) + (** Wellfounded relations are the inverse image of wellordering types *) + (* in course of development *) -Variable A : Set. -Variable leA : A -> A -> Prop. + Variable A : Set. + Variable leA : A -> A -> Prop. -Definition B (a:A) := {x : A | leA x a}. + Definition B (a:A) := {x : A | leA x a}. -Definition wof : well_founded leA -> A -> WO A B. -Proof. - intros. - apply (well_founded_induction H (fun a:A => WO A B)); auto. - intros. - apply (sup A B x). - unfold B at 1 in |- *. - destruct 1 as [x0]. - apply (H1 x0); auto. + Definition wof : well_founded leA -> A -> WO A B. + Proof. + intros. + apply (well_founded_induction H (fun a:A => WO A B)); auto. + intros. + apply (sup A B x). + unfold B at 1 in |- *. + destruct 1 as [x0]. + apply (H1 x0); auto. Qed. End Characterisation_wf_relations.
\ No newline at end of file diff --git a/theories/ZArith/BinInt.v b/theories/ZArith/BinInt.v index fda521de..71e48360 100644 --- a/theories/ZArith/BinInt.v +++ b/theories/ZArith/BinInt.v @@ -6,10 +6,10 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: BinInt.v 8883 2006-05-31 21:56:37Z letouzey $ i*) +(*i $Id: BinInt.v 9245 2006-10-17 12:53:34Z notin $ i*) (***********************************************************) -(** Binary Integers (Pierre Crégut, CNET, Lannion, France) *) +(** Binary Integers (Pierre Crégut, CNET, Lannion, France) *) (***********************************************************) Require Export BinPos. @@ -19,190 +19,190 @@ Require Import Plus. Require Import Mult. Unset Boxed Definitions. -(**********************************************************************) -(** Binary integer numbers *) + +(*****************************) +(** * Binary integer numbers *) Inductive Z : Set := | Z0 : Z | Zpos : positive -> Z | Zneg : positive -> Z. -(** Declare Scope Z_scope with Key Z *) -Delimit Scope Z_scope with Z. (** Automatically open scope positive_scope for the constructors of Z *) +Delimit Scope Z_scope with Z. Bind Scope Z_scope with Z. Arguments Scope Zpos [positive_scope]. Arguments Scope Zneg [positive_scope]. -(** Subtraction of positive into Z *) +(** ** Subtraction of positive into Z *) Definition Zdouble_plus_one (x:Z) := match x with - | Z0 => Zpos 1 - | Zpos p => Zpos (xI p) - | Zneg p => Zneg (Pdouble_minus_one p) + | Z0 => Zpos 1 + | Zpos p => Zpos (xI p) + | Zneg p => Zneg (Pdouble_minus_one p) end. Definition Zdouble_minus_one (x:Z) := match x with - | Z0 => Zneg 1 - | Zneg p => Zneg (xI p) - | Zpos p => Zpos (Pdouble_minus_one p) + | Z0 => Zneg 1 + | Zneg p => Zneg (xI p) + | Zpos p => Zpos (Pdouble_minus_one p) end. Definition Zdouble (x:Z) := match x with - | Z0 => Z0 - | Zpos p => Zpos (xO p) - | Zneg p => Zneg (xO p) + | Z0 => Z0 + | Zpos p => Zpos (xO p) + | Zneg p => Zneg (xO p) end. Fixpoint ZPminus (x y:positive) {struct y} : Z := match x, y with - | xI x', xI y' => Zdouble (ZPminus x' y') - | xI x', xO y' => Zdouble_plus_one (ZPminus x' y') - | xI x', xH => Zpos (xO x') - | xO x', xI y' => Zdouble_minus_one (ZPminus x' y') - | xO x', xO y' => Zdouble (ZPminus x' y') - | xO x', xH => Zpos (Pdouble_minus_one x') - | xH, xI y' => Zneg (xO y') - | xH, xO y' => Zneg (Pdouble_minus_one y') - | xH, xH => Z0 + | xI x', xI y' => Zdouble (ZPminus x' y') + | xI x', xO y' => Zdouble_plus_one (ZPminus x' y') + | xI x', xH => Zpos (xO x') + | xO x', xI y' => Zdouble_minus_one (ZPminus x' y') + | xO x', xO y' => Zdouble (ZPminus x' y') + | xO x', xH => Zpos (Pdouble_minus_one x') + | xH, xI y' => Zneg (xO y') + | xH, xO y' => Zneg (Pdouble_minus_one y') + | xH, xH => Z0 end. -(** Addition on integers *) +(** ** Addition on integers *) Definition Zplus (x y:Z) := match x, y with - | Z0, y => y - | x, Z0 => x - | Zpos x', Zpos y' => Zpos (x' + y') - | Zpos x', Zneg y' => + | Z0, y => y + | x, Z0 => x + | Zpos x', Zpos y' => Zpos (x' + y') + | Zpos x', Zneg y' => match (x' ?= y')%positive Eq with - | Eq => Z0 - | Lt => Zneg (y' - x') - | Gt => Zpos (x' - y') + | Eq => Z0 + | Lt => Zneg (y' - x') + | Gt => Zpos (x' - y') end - | Zneg x', Zpos y' => + | Zneg x', Zpos y' => match (x' ?= y')%positive Eq with - | Eq => Z0 - | Lt => Zpos (y' - x') - | Gt => Zneg (x' - y') + | Eq => Z0 + | Lt => Zpos (y' - x') + | Gt => Zneg (x' - y') end - | Zneg x', Zneg y' => Zneg (x' + y') + | Zneg x', Zneg y' => Zneg (x' + y') end. Infix "+" := Zplus : Z_scope. -(** Opposite *) +(** ** Opposite *) Definition Zopp (x:Z) := match x with - | Z0 => Z0 - | Zpos x => Zneg x - | Zneg x => Zpos x + | Z0 => Z0 + | Zpos x => Zneg x + | Zneg x => Zpos x end. Notation "- x" := (Zopp x) : Z_scope. -(** Successor on integers *) +(** ** Successor on integers *) Definition Zsucc (x:Z) := (x + Zpos 1)%Z. -(** Predecessor on integers *) +(** ** Predecessor on integers *) Definition Zpred (x:Z) := (x + Zneg 1)%Z. -(** Subtraction on integers *) +(** ** Subtraction on integers *) Definition Zminus (m n:Z) := (m + - n)%Z. Infix "-" := Zminus : Z_scope. -(** Multiplication on integers *) +(** ** Multiplication on integers *) Definition Zmult (x y:Z) := match x, y with - | Z0, _ => Z0 - | _, Z0 => Z0 - | Zpos x', Zpos y' => Zpos (x' * y') - | Zpos x', Zneg y' => Zneg (x' * y') - | Zneg x', Zpos y' => Zneg (x' * y') - | Zneg x', Zneg y' => Zpos (x' * y') + | Z0, _ => Z0 + | _, Z0 => Z0 + | Zpos x', Zpos y' => Zpos (x' * y') + | Zpos x', Zneg y' => Zneg (x' * y') + | Zneg x', Zpos y' => Zneg (x' * y') + | Zneg x', Zneg y' => Zpos (x' * y') end. Infix "*" := Zmult : Z_scope. -(** Comparison of integers *) +(** ** Comparison of integers *) Definition Zcompare (x y:Z) := match x, y with - | Z0, Z0 => Eq - | Z0, Zpos y' => Lt - | Z0, Zneg y' => Gt - | Zpos x', Z0 => Gt - | Zpos x', Zpos y' => (x' ?= y')%positive Eq - | Zpos x', Zneg y' => Gt - | Zneg x', Z0 => Lt - | Zneg x', Zpos y' => Lt - | Zneg x', Zneg y' => CompOpp ((x' ?= y')%positive Eq) + | Z0, Z0 => Eq + | Z0, Zpos y' => Lt + | Z0, Zneg y' => Gt + | Zpos x', Z0 => Gt + | Zpos x', Zpos y' => (x' ?= y')%positive Eq + | Zpos x', Zneg y' => Gt + | Zneg x', Z0 => Lt + | Zneg x', Zpos y' => Lt + | Zneg x', Zneg y' => CompOpp ((x' ?= y')%positive Eq) end. Infix "?=" := Zcompare (at level 70, no associativity) : Z_scope. Ltac elim_compare com1 com2 := case (Dcompare (com1 ?= com2)%Z); - [ idtac | let x := fresh "H" in - (intro x; case x; clear x) ]. + [ idtac | let x := fresh "H" in + (intro x; case x; clear x) ]. -(** Sign function *) +(** ** Sign function *) Definition Zsgn (z:Z) : Z := match z with - | Z0 => Z0 - | Zpos p => Zpos 1 - | Zneg p => Zneg 1 + | Z0 => Z0 + | Zpos p => Zpos 1 + | Zneg p => Zneg 1 end. -(** Direct, easier to handle variants of successor and addition *) +(** ** Direct, easier to handle variants of successor and addition *) Definition Zsucc' (x:Z) := match x with - | Z0 => Zpos 1 - | Zpos x' => Zpos (Psucc x') - | Zneg x' => ZPminus 1 x' + | Z0 => Zpos 1 + | Zpos x' => Zpos (Psucc x') + | Zneg x' => ZPminus 1 x' end. Definition Zpred' (x:Z) := match x with - | Z0 => Zneg 1 - | Zpos x' => ZPminus x' 1 - | Zneg x' => Zneg (Psucc x') + | Z0 => Zneg 1 + | Zpos x' => ZPminus x' 1 + | Zneg x' => Zneg (Psucc x') end. Definition Zplus' (x y:Z) := match x, y with - | Z0, y => y - | x, Z0 => x - | Zpos x', Zpos y' => Zpos (x' + y') - | Zpos x', Zneg y' => ZPminus x' y' - | Zneg x', Zpos y' => ZPminus y' x' - | Zneg x', Zneg y' => Zneg (x' + y') + | Z0, y => y + | x, Z0 => x + | Zpos x', Zpos y' => Zpos (x' + y') + | Zpos x', Zneg y' => ZPminus x' y' + | Zneg x', Zpos y' => ZPminus y' x' + | Zneg x', Zneg y' => Zneg (x' + y') end. Open Local Scope Z_scope. (**********************************************************************) -(** Inductive specification of Z *) +(** ** Inductive specification of Z *) Theorem Zind : - forall P:Z -> Prop, - P Z0 -> - (forall x:Z, P x -> P (Zsucc' x)) -> - (forall x:Z, P x -> P (Zpred' x)) -> forall n:Z, P n. + forall P:Z -> Prop, + P Z0 -> + (forall x:Z, P x -> P (Zsucc' x)) -> + (forall x:Z, P x -> P (Zpred' x)) -> forall n:Z, P n. Proof. -intros P H0 Hs Hp z; destruct z. + intros P H0 Hs Hp z; destruct z. assumption. apply Pind with (P := fun p => P (Zpos p)). change (P (Zsucc' Z0)) in |- *; apply Hs; apply H0. @@ -213,52 +213,56 @@ intros P H0 Hs Hp z; destruct z. Qed. (**********************************************************************) -(** Properties of opposite on binary integer numbers *) +(** * Misc properties about binary integer operations *) + + +(**********************************************************************) +(** ** Properties of opposite on binary integer numbers *) Theorem Zopp_neg : forall p:positive, - Zneg p = Zpos p. Proof. -reflexivity. + reflexivity. Qed. (** [opp] is involutive *) Theorem Zopp_involutive : forall n:Z, - - n = n. Proof. -intro x; destruct x; reflexivity. + intro x; destruct x; reflexivity. Qed. (** Injectivity of the opposite *) Theorem Zopp_inj : forall n m:Z, - n = - m -> n = m. Proof. -intros x y; case x; case y; simpl in |- *; intros; - [ trivial - | discriminate H - | discriminate H - | discriminate H - | simplify_eq H; intro E; rewrite E; trivial - | discriminate H - | discriminate H - | discriminate H - | simplify_eq H; intro E; rewrite E; trivial ]. + intros x y; case x; case y; simpl in |- *; intros; + [ trivial + | discriminate H + | discriminate H + | discriminate H + | simplify_eq H; intro E; rewrite E; trivial + | discriminate H + | discriminate H + | discriminate H + | simplify_eq H; intro E; rewrite E; trivial ]. Qed. -(**********************************************************************) -(* Properties of the direct definition of successor and predecessor *) +(*************************************************************************) +(** ** Properties of the direct definition of successor and predecessor *) Lemma Zpred'_succ' : forall n:Z, Zpred' (Zsucc' n) = n. Proof. -intro x; destruct x; simpl in |- *. - reflexivity. -destruct p; simpl in |- *; try rewrite Pdouble_minus_one_o_succ_eq_xI; - reflexivity. -destruct p; simpl in |- *; try rewrite Psucc_o_double_minus_one_eq_xO; - reflexivity. + intro x; destruct x; simpl in |- *. + reflexivity. + destruct p; simpl in |- *; try rewrite Pdouble_minus_one_o_succ_eq_xI; + reflexivity. + destruct p; simpl in |- *; try rewrite Psucc_o_double_minus_one_eq_xO; + reflexivity. Qed. Lemma Zsucc'_discr : forall n:Z, n <> Zsucc' n. Proof. -intro x; destruct x; simpl in |- *. + intro x; destruct x; simpl in |- *. discriminate. injection; apply Psucc_discr. destruct p; simpl in |- *. @@ -268,512 +272,517 @@ intro x; destruct x; simpl in |- *. Qed. (**********************************************************************) -(** Other properties of binary integer numbers *) +(** ** Other properties of binary integer numbers *) Lemma ZL0 : 2%nat = (1 + 1)%nat. Proof. -reflexivity. + reflexivity. Qed. (**********************************************************************) -(** Properties of the addition on integers *) +(** * Properties of the addition on integers *) -(** zero is left neutral for addition *) +(** ** zero is left neutral for addition *) Theorem Zplus_0_l : forall n:Z, Z0 + n = n. Proof. -intro x; destruct x; reflexivity. + intro x; destruct x; reflexivity. Qed. -(** zero is right neutral for addition *) +(** *** zero is right neutral for addition *) Theorem Zplus_0_r : forall n:Z, n + Z0 = n. Proof. -intro x; destruct x; reflexivity. + intro x; destruct x; reflexivity. Qed. -(** addition is commutative *) +(** ** addition is commutative *) Theorem Zplus_comm : forall n m:Z, n + m = m + n. Proof. -intro x; induction x as [| p| p]; intro y; destruct y as [| q| q]; - simpl in |- *; try reflexivity. + intro x; induction x as [| p| p]; intro y; destruct y as [| q| q]; + simpl in |- *; try reflexivity. rewrite Pplus_comm; reflexivity. rewrite ZC4; destruct ((q ?= p)%positive Eq); reflexivity. rewrite ZC4; destruct ((q ?= p)%positive Eq); reflexivity. rewrite Pplus_comm; reflexivity. Qed. -(** opposite distributes over addition *) +(** ** opposite distributes over addition *) Theorem Zopp_plus_distr : forall n m:Z, - (n + m) = - n + - m. Proof. -intro x; destruct x as [| p| p]; intro y; destruct y as [| q| q]; - simpl in |- *; reflexivity || destruct ((p ?= q)%positive Eq); - reflexivity. + intro x; destruct x as [| p| p]; intro y; destruct y as [| q| q]; + simpl in |- *; reflexivity || destruct ((p ?= q)%positive Eq); + reflexivity. Qed. -(** opposite is inverse for addition *) +(** ** opposite is inverse for addition *) Theorem Zplus_opp_r : forall n:Z, n + - n = Z0. Proof. -intro x; destruct x as [| p| p]; simpl in |- *; - [ reflexivity - | rewrite (Pcompare_refl p); reflexivity - | rewrite (Pcompare_refl p); reflexivity ]. + intro x; destruct x as [| p| p]; simpl in |- *; + [ reflexivity + | rewrite (Pcompare_refl p); reflexivity + | rewrite (Pcompare_refl p); reflexivity ]. Qed. Theorem Zplus_opp_l : forall n:Z, - n + n = Z0. Proof. -intro; rewrite Zplus_comm; apply Zplus_opp_r. + intro; rewrite Zplus_comm; apply Zplus_opp_r. Qed. Hint Local Resolve Zplus_0_l Zplus_0_r. -(** addition is associative *) +(** ** addition is associative *) Lemma weak_assoc : - forall (p q:positive) (n:Z), Zpos p + (Zpos q + n) = Zpos p + Zpos q + n. -Proof. -intros x y z'; case z'; - [ auto with arith - | intros z; simpl in |- *; rewrite Pplus_assoc; auto with arith - | intros z; simpl in |- *; ElimPcompare y z; intros E0; rewrite E0; - ElimPcompare (x + y)%positive z; intros E1; rewrite E1; - [ absurd ((x + y ?= z)%positive Eq = Eq); - [ (* Case 1 *) - rewrite nat_of_P_gt_Gt_compare_complement_morphism; - [ discriminate - | rewrite nat_of_P_plus_morphism; rewrite (Pcompare_Eq_eq y z E0); - elim (ZL4 x); intros k E2; rewrite E2; - simpl in |- *; unfold gt, lt in |- *; - apply le_n_S; apply le_plus_r ] - | assumption ] - | absurd ((x + y ?= z)%positive Eq = Lt); - [ (* Case 2 *) - rewrite nat_of_P_gt_Gt_compare_complement_morphism; - [ discriminate - | rewrite nat_of_P_plus_morphism; rewrite (Pcompare_Eq_eq y z E0); - elim (ZL4 x); intros k E2; rewrite E2; - simpl in |- *; unfold gt, lt in |- *; - apply le_n_S; apply le_plus_r ] - | assumption ] - | rewrite (Pcompare_Eq_eq y z E0); - (* Case 3 *) - elim (Pminus_mask_Gt (x + z) z); - [ intros t H; elim H; intros H1 H2; elim H2; intros H3 H4; - unfold Pminus in |- *; rewrite H1; cut (x = t); - [ intros E; rewrite E; auto with arith - | apply Pplus_reg_r with (r := z); rewrite <- H3; - rewrite Pplus_comm; trivial with arith ] - | pattern z at 1 in |- *; rewrite <- (Pcompare_Eq_eq y z E0); - assumption ] - | elim (Pminus_mask_Gt z y); - [ (* Case 4 *) - intros k H; elim H; intros H1 H2; elim H2; intros H3 H4; - unfold Pminus at 1 in |- *; rewrite H1; cut (x = k); - [ intros E; rewrite E; rewrite (Pcompare_refl k); - trivial with arith - | apply Pplus_reg_r with (r := y); rewrite (Pplus_comm k y); - rewrite H3; apply Pcompare_Eq_eq; assumption ] - | apply ZC2; assumption ] - | elim (Pminus_mask_Gt z y); - [ (* Case 5 *) - intros k H; elim H; intros H1 H2; elim H2; intros H3 H4; - unfold Pminus at 1 3 5 in |- *; rewrite H1; - cut ((x ?= k)%positive Eq = Lt); - [ intros E2; rewrite E2; elim (Pminus_mask_Gt k x); - [ intros i H5; elim H5; intros H6 H7; elim H7; intros H8 H9; - elim (Pminus_mask_Gt z (x + y)); - [ intros j H10; elim H10; intros H11 H12; elim H12; - intros H13 H14; unfold Pminus in |- *; - rewrite H6; rewrite H11; cut (i = j); - [ intros E; rewrite E; auto with arith - | apply (Pplus_reg_l (x + y)); rewrite H13; - rewrite (Pplus_comm x y); rewrite <- Pplus_assoc; - rewrite H8; assumption ] - | apply ZC2; assumption ] - | apply ZC2; assumption ] - | apply nat_of_P_lt_Lt_compare_complement_morphism; - apply plus_lt_reg_l with (p := nat_of_P y); - do 2 rewrite <- nat_of_P_plus_morphism; - apply nat_of_P_lt_Lt_compare_morphism; - rewrite H3; rewrite Pplus_comm; assumption ] - | apply ZC2; assumption ] - | elim (Pminus_mask_Gt z y); - [ (* Case 6 *) - intros k H; elim H; intros H1 H2; elim H2; intros H3 H4; - elim (Pminus_mask_Gt (x + y) z); - [ intros i H5; elim H5; intros H6 H7; elim H7; intros H8 H9; - unfold Pminus in |- *; rewrite H1; rewrite H6; - cut ((x ?= k)%positive Eq = Gt); - [ intros H10; elim (Pminus_mask_Gt x k H10); intros j H11; - elim H11; intros H12 H13; elim H13; - intros H14 H15; rewrite H10; rewrite H12; - cut (i = j); - [ intros H16; rewrite H16; auto with arith - | apply (Pplus_reg_l (z + k)); rewrite <- (Pplus_assoc z k j); - rewrite H14; rewrite (Pplus_comm z k); - rewrite <- Pplus_assoc; rewrite H8; - rewrite (Pplus_comm x y); rewrite Pplus_assoc; - rewrite (Pplus_comm k y); rewrite H3; - trivial with arith ] - | apply nat_of_P_gt_Gt_compare_complement_morphism; - unfold lt, gt in |- *; - apply plus_lt_reg_l with (p := nat_of_P y); - do 2 rewrite <- nat_of_P_plus_morphism; - apply nat_of_P_lt_Lt_compare_morphism; - rewrite H3; rewrite Pplus_comm; apply ZC1; - assumption ] - | assumption ] - | apply ZC2; assumption ] - | absurd ((x + y ?= z)%positive Eq = Eq); - [ (* Case 7 *) - rewrite nat_of_P_gt_Gt_compare_complement_morphism; - [ discriminate - | rewrite nat_of_P_plus_morphism; unfold gt in |- *; - apply lt_le_trans with (m := nat_of_P y); - [ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; assumption - | apply le_plus_r ] ] - | assumption ] - | absurd ((x + y ?= z)%positive Eq = Lt); - [ (* Case 8 *) - rewrite nat_of_P_gt_Gt_compare_complement_morphism; - [ discriminate - | unfold gt in |- *; apply lt_le_trans with (m := nat_of_P y); - [ exact (nat_of_P_gt_Gt_compare_morphism y z E0) - | rewrite nat_of_P_plus_morphism; apply le_plus_r ] ] - | assumption ] - | elim Pminus_mask_Gt with (1 := E0); intros k H1; - (* Case 9 *) - elim Pminus_mask_Gt with (1 := E1); intros i H2; - elim H1; intros H3 H4; elim H4; intros H5 H6; - elim H2; intros H7 H8; elim H8; intros H9 H10; - unfold Pminus in |- *; rewrite H3; rewrite H7; - cut ((x + k)%positive = i); - [ intros E; rewrite E; auto with arith - | apply (Pplus_reg_l z); rewrite (Pplus_comm x k); rewrite Pplus_assoc; - rewrite H5; rewrite H9; rewrite Pplus_comm; - trivial with arith ] ] ]. + forall (p q:positive) (n:Z), Zpos p + (Zpos q + n) = Zpos p + Zpos q + n. +Proof. + intros x y z'; case z'; + [ auto with arith + | intros z; simpl in |- *; rewrite Pplus_assoc; auto with arith + | intros z; simpl in |- *; ElimPcompare y z; intros E0; rewrite E0; + ElimPcompare (x + y)%positive z; intros E1; rewrite E1; + [ absurd ((x + y ?= z)%positive Eq = Eq); + [ (* Case 1 *) + rewrite nat_of_P_gt_Gt_compare_complement_morphism; + [ discriminate + | rewrite nat_of_P_plus_morphism; rewrite (Pcompare_Eq_eq y z E0); + elim (ZL4 x); intros k E2; rewrite E2; + simpl in |- *; unfold gt, lt in |- *; + apply le_n_S; apply le_plus_r ] + | assumption ] + | absurd ((x + y ?= z)%positive Eq = Lt); + [ (* Case 2 *) + rewrite nat_of_P_gt_Gt_compare_complement_morphism; + [ discriminate + | rewrite nat_of_P_plus_morphism; rewrite (Pcompare_Eq_eq y z E0); + elim (ZL4 x); intros k E2; rewrite E2; + simpl in |- *; unfold gt, lt in |- *; + apply le_n_S; apply le_plus_r ] + | assumption ] + | rewrite (Pcompare_Eq_eq y z E0); + (* Case 3 *) + elim (Pminus_mask_Gt (x + z) z); + [ intros t H; elim H; intros H1 H2; elim H2; intros H3 H4; + unfold Pminus in |- *; rewrite H1; cut (x = t); + [ intros E; rewrite E; auto with arith + | apply Pplus_reg_r with (r := z); rewrite <- H3; + rewrite Pplus_comm; trivial with arith ] + | pattern z at 1 in |- *; rewrite <- (Pcompare_Eq_eq y z E0); + assumption ] + | elim (Pminus_mask_Gt z y); + [ (* Case 4 *) + intros k H; elim H; intros H1 H2; elim H2; intros H3 H4; + unfold Pminus at 1 in |- *; rewrite H1; cut (x = k); + [ intros E; rewrite E; rewrite (Pcompare_refl k); + trivial with arith + | apply Pplus_reg_r with (r := y); rewrite (Pplus_comm k y); + rewrite H3; apply Pcompare_Eq_eq; assumption ] + | apply ZC2; assumption ] + | elim (Pminus_mask_Gt z y); + [ (* Case 5 *) + intros k H; elim H; intros H1 H2; elim H2; intros H3 H4; + unfold Pminus at 1 3 5 in |- *; rewrite H1; + cut ((x ?= k)%positive Eq = Lt); + [ intros E2; rewrite E2; elim (Pminus_mask_Gt k x); + [ intros i H5; elim H5; intros H6 H7; elim H7; intros H8 H9; + elim (Pminus_mask_Gt z (x + y)); + [ intros j H10; elim H10; intros H11 H12; elim H12; + intros H13 H14; unfold Pminus in |- *; + rewrite H6; rewrite H11; cut (i = j); + [ intros E; rewrite E; auto with arith + | apply (Pplus_reg_l (x + y)); rewrite H13; + rewrite (Pplus_comm x y); rewrite <- Pplus_assoc; + rewrite H8; assumption ] + | apply ZC2; assumption ] + | apply ZC2; assumption ] + | apply nat_of_P_lt_Lt_compare_complement_morphism; + apply plus_lt_reg_l with (p := nat_of_P y); + do 2 rewrite <- nat_of_P_plus_morphism; + apply nat_of_P_lt_Lt_compare_morphism; + rewrite H3; rewrite Pplus_comm; assumption ] + | apply ZC2; assumption ] + | elim (Pminus_mask_Gt z y); + [ (* Case 6 *) + intros k H; elim H; intros H1 H2; elim H2; intros H3 H4; + elim (Pminus_mask_Gt (x + y) z); + [ intros i H5; elim H5; intros H6 H7; elim H7; intros H8 H9; + unfold Pminus in |- *; rewrite H1; rewrite H6; + cut ((x ?= k)%positive Eq = Gt); + [ intros H10; elim (Pminus_mask_Gt x k H10); intros j H11; + elim H11; intros H12 H13; elim H13; + intros H14 H15; rewrite H10; rewrite H12; + cut (i = j); + [ intros H16; rewrite H16; auto with arith + | apply (Pplus_reg_l (z + k)); rewrite <- (Pplus_assoc z k j); + rewrite H14; rewrite (Pplus_comm z k); + rewrite <- Pplus_assoc; rewrite H8; + rewrite (Pplus_comm x y); rewrite Pplus_assoc; + rewrite (Pplus_comm k y); rewrite H3; + trivial with arith ] + | apply nat_of_P_gt_Gt_compare_complement_morphism; + unfold lt, gt in |- *; + apply plus_lt_reg_l with (p := nat_of_P y); + do 2 rewrite <- nat_of_P_plus_morphism; + apply nat_of_P_lt_Lt_compare_morphism; + rewrite H3; rewrite Pplus_comm; apply ZC1; + assumption ] + | assumption ] + | apply ZC2; assumption ] + | absurd ((x + y ?= z)%positive Eq = Eq); + [ (* Case 7 *) + rewrite nat_of_P_gt_Gt_compare_complement_morphism; + [ discriminate + | rewrite nat_of_P_plus_morphism; unfold gt in |- *; + apply lt_le_trans with (m := nat_of_P y); + [ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; assumption + | apply le_plus_r ] ] + | assumption ] + | absurd ((x + y ?= z)%positive Eq = Lt); + [ (* Case 8 *) + rewrite nat_of_P_gt_Gt_compare_complement_morphism; + [ discriminate + | unfold gt in |- *; apply lt_le_trans with (m := nat_of_P y); + [ exact (nat_of_P_gt_Gt_compare_morphism y z E0) + | rewrite nat_of_P_plus_morphism; apply le_plus_r ] ] + | assumption ] + | elim Pminus_mask_Gt with (1 := E0); intros k H1; + (* Case 9 *) + elim Pminus_mask_Gt with (1 := E1); intros i H2; + elim H1; intros H3 H4; elim H4; intros H5 H6; + elim H2; intros H7 H8; elim H8; intros H9 H10; + unfold Pminus in |- *; rewrite H3; rewrite H7; + cut ((x + k)%positive = i); + [ intros E; rewrite E; auto with arith + | apply (Pplus_reg_l z); rewrite (Pplus_comm x k); rewrite Pplus_assoc; + rewrite H5; rewrite H9; rewrite Pplus_comm; + trivial with arith ] ] ]. Qed. Hint Local Resolve weak_assoc. Theorem Zplus_assoc : forall n m p:Z, n + (m + p) = n + m + p. Proof. -intros x y z; case x; case y; case z; auto with arith; intros; - [ rewrite (Zplus_comm (Zneg p0)); rewrite weak_assoc; - rewrite (Zplus_comm (Zpos p1 + Zneg p0)); rewrite weak_assoc; - rewrite (Zplus_comm (Zpos p1)); trivial with arith - | apply Zopp_inj; do 4 rewrite Zopp_plus_distr; do 2 rewrite Zopp_neg; - rewrite Zplus_comm; rewrite <- weak_assoc; - rewrite (Zplus_comm (- Zpos p1)); - rewrite (Zplus_comm (Zpos p0 + - Zpos p1)); rewrite (weak_assoc p); - rewrite weak_assoc; rewrite (Zplus_comm (Zpos p0)); - trivial with arith - | rewrite Zplus_comm; rewrite (Zplus_comm (Zpos p0) (Zpos p)); - rewrite <- weak_assoc; rewrite Zplus_comm; rewrite (Zplus_comm (Zpos p0)); - trivial with arith - | apply Zopp_inj; do 4 rewrite Zopp_plus_distr; do 2 rewrite Zopp_neg; - rewrite (Zplus_comm (- Zpos p0)); rewrite weak_assoc; - rewrite (Zplus_comm (Zpos p1 + - Zpos p0)); rewrite weak_assoc; - rewrite (Zplus_comm (Zpos p)); trivial with arith - | apply Zopp_inj; do 4 rewrite Zopp_plus_distr; do 2 rewrite Zopp_neg; - apply weak_assoc - | apply Zopp_inj; do 4 rewrite Zopp_plus_distr; do 2 rewrite Zopp_neg; - apply weak_assoc ]. + intros x y z; case x; case y; case z; auto with arith; intros; + [ rewrite (Zplus_comm (Zneg p0)); rewrite weak_assoc; + rewrite (Zplus_comm (Zpos p1 + Zneg p0)); rewrite weak_assoc; + rewrite (Zplus_comm (Zpos p1)); trivial with arith + | apply Zopp_inj; do 4 rewrite Zopp_plus_distr; do 2 rewrite Zopp_neg; + rewrite Zplus_comm; rewrite <- weak_assoc; + rewrite (Zplus_comm (- Zpos p1)); + rewrite (Zplus_comm (Zpos p0 + - Zpos p1)); rewrite (weak_assoc p); + rewrite weak_assoc; rewrite (Zplus_comm (Zpos p0)); + trivial with arith + | rewrite Zplus_comm; rewrite (Zplus_comm (Zpos p0) (Zpos p)); + rewrite <- weak_assoc; rewrite Zplus_comm; rewrite (Zplus_comm (Zpos p0)); + trivial with arith + | apply Zopp_inj; do 4 rewrite Zopp_plus_distr; do 2 rewrite Zopp_neg; + rewrite (Zplus_comm (- Zpos p0)); rewrite weak_assoc; + rewrite (Zplus_comm (Zpos p1 + - Zpos p0)); rewrite weak_assoc; + rewrite (Zplus_comm (Zpos p)); trivial with arith + | apply Zopp_inj; do 4 rewrite Zopp_plus_distr; do 2 rewrite Zopp_neg; + apply weak_assoc + | apply Zopp_inj; do 4 rewrite Zopp_plus_distr; do 2 rewrite Zopp_neg; + apply weak_assoc ]. Qed. Lemma Zplus_assoc_reverse : forall n m p:Z, n + m + p = n + (m + p). Proof. -intros; symmetry in |- *; apply Zplus_assoc. + intros; symmetry in |- *; apply Zplus_assoc. Qed. -(** Associativity mixed with commutativity *) +(** ** Associativity mixed with commutativity *) Theorem Zplus_permute : forall n m p:Z, n + (m + p) = m + (n + p). Proof. -intros n m p; rewrite Zplus_comm; rewrite <- Zplus_assoc; - rewrite (Zplus_comm p n); trivial with arith. + intros n m p; rewrite Zplus_comm; rewrite <- Zplus_assoc; + rewrite (Zplus_comm p n); trivial with arith. Qed. -(** addition simplifies *) +(** ** addition simplifies *) Theorem Zplus_reg_l : forall n m p:Z, n + m = n + p -> m = p. -intros n m p H; cut (- n + (n + m) = - n + (n + p)); - [ do 2 rewrite Zplus_assoc; rewrite (Zplus_comm (- n) n); - rewrite Zplus_opp_r; simpl in |- *; trivial with arith - | rewrite H; trivial with arith ]. + intros n m p H; cut (- n + (n + m) = - n + (n + p)); + [ do 2 rewrite Zplus_assoc; rewrite (Zplus_comm (- n) n); + rewrite Zplus_opp_r; simpl in |- *; trivial with arith + | rewrite H; trivial with arith ]. Qed. -(** addition and successor permutes *) +(** ** addition and successor permutes *) Lemma Zplus_succ_l : forall n m:Z, Zsucc n + m = Zsucc (n + m). Proof. -intros x y; unfold Zsucc in |- *; rewrite (Zplus_comm (x + y)); - rewrite Zplus_assoc; rewrite (Zplus_comm (Zpos 1)); - trivial with arith. + intros x y; unfold Zsucc in |- *; rewrite (Zplus_comm (x + y)); + rewrite Zplus_assoc; rewrite (Zplus_comm (Zpos 1)); + trivial with arith. Qed. Lemma Zplus_succ_r : forall n m:Z, Zsucc (n + m) = n + Zsucc m. Proof. -intros n m; unfold Zsucc in |- *; rewrite Zplus_assoc; trivial with arith. + intros n m; unfold Zsucc in |- *; rewrite Zplus_assoc; trivial with arith. Qed. Lemma Zplus_succ_comm : forall n m:Z, Zsucc n + m = n + Zsucc m. Proof. -unfold Zsucc in |- *; intros n m; rewrite <- Zplus_assoc; - rewrite (Zplus_comm (Zpos 1)); trivial with arith. + unfold Zsucc in |- *; intros n m; rewrite <- Zplus_assoc; + rewrite (Zplus_comm (Zpos 1)); trivial with arith. Qed. -(** Misc properties, usually redundant or non natural *) +(** ** Misc properties, usually redundant or non natural *) Lemma Zplus_0_r_reverse : forall n:Z, n = n + Z0. Proof. -symmetry in |- *; apply Zplus_0_r. + symmetry in |- *; apply Zplus_0_r. Qed. Lemma Zplus_0_simpl_l : forall n m:Z, n + Z0 = m -> n = m. Proof. -intros n m; rewrite Zplus_0_r; intro; assumption. + intros n m; rewrite Zplus_0_r; intro; assumption. Qed. Lemma Zplus_0_simpl_l_reverse : forall n m:Z, n = m + Z0 -> n = m. Proof. -intros n m; rewrite Zplus_0_r; intro; assumption. + intros n m; rewrite Zplus_0_r; intro; assumption. Qed. Lemma Zplus_eq_compat : forall n m p q:Z, n = m -> p = q -> n + p = m + q. Proof. -intros; rewrite H; rewrite H0; reflexivity. + intros; rewrite H; rewrite H0; reflexivity. Qed. Lemma Zplus_opp_expand : forall n m p:Z, n + - m = n + - p + (p + - m). Proof. -intros x y z. -rewrite <- (Zplus_assoc x). -rewrite (Zplus_assoc (- z)). -rewrite Zplus_opp_l. -reflexivity. + intros x y z. + rewrite <- (Zplus_assoc x). + rewrite (Zplus_assoc (- z)). + rewrite Zplus_opp_l. + reflexivity. Qed. -(**********************************************************************) -(** Properties of successor and predecessor on binary integer numbers *) +(************************************************************************) +(** * Properties of successor and predecessor on binary integer numbers *) Theorem Zsucc_discr : forall n:Z, n <> Zsucc n. Proof. -intros n; cut (Z0 <> Zpos 1); - [ unfold not in |- *; intros H1 H2; apply H1; apply (Zplus_reg_l n); - rewrite Zplus_0_r; exact H2 - | discriminate ]. + intros n; cut (Z0 <> Zpos 1); + [ unfold not in |- *; intros H1 H2; apply H1; apply (Zplus_reg_l n); + rewrite Zplus_0_r; exact H2 + | discriminate ]. Qed. Theorem Zpos_succ_morphism : - forall p:positive, Zpos (Psucc p) = Zsucc (Zpos p). + forall p:positive, Zpos (Psucc p) = Zsucc (Zpos p). Proof. -intro; rewrite Pplus_one_succ_r; unfold Zsucc in |- *; simpl in |- *; - trivial with arith. + intro; rewrite Pplus_one_succ_r; unfold Zsucc in |- *; simpl in |- *; + trivial with arith. Qed. (** successor and predecessor are inverse functions *) Theorem Zsucc_pred : forall n:Z, n = Zsucc (Zpred n). Proof. -intros n; unfold Zsucc, Zpred in |- *; rewrite <- Zplus_assoc; simpl in |- *; - rewrite Zplus_0_r; trivial with arith. + intros n; unfold Zsucc, Zpred in |- *; rewrite <- Zplus_assoc; simpl in |- *; + rewrite Zplus_0_r; trivial with arith. Qed. Hint Immediate Zsucc_pred: zarith. Theorem Zpred_succ : forall n:Z, n = Zpred (Zsucc n). Proof. -intros m; unfold Zpred, Zsucc in |- *; rewrite <- Zplus_assoc; simpl in |- *; - rewrite Zplus_comm; auto with arith. + intros m; unfold Zpred, Zsucc in |- *; rewrite <- Zplus_assoc; simpl in |- *; + rewrite Zplus_comm; auto with arith. Qed. Theorem Zsucc_inj : forall n m:Z, Zsucc n = Zsucc m -> n = m. Proof. -intros n m H. -change (Zneg 1 + Zpos 1 + n = Zneg 1 + Zpos 1 + m) in |- *; - do 2 rewrite <- Zplus_assoc; do 2 rewrite (Zplus_comm (Zpos 1)); - unfold Zsucc in H; rewrite H; trivial with arith. + intros n m H. + change (Zneg 1 + Zpos 1 + n = Zneg 1 + Zpos 1 + m) in |- *; + do 2 rewrite <- Zplus_assoc; do 2 rewrite (Zplus_comm (Zpos 1)); + unfold Zsucc in H; rewrite H; trivial with arith. Qed. (** Misc properties, usually redundant or non natural *) Lemma Zsucc_eq_compat : forall n m:Z, n = m -> Zsucc n = Zsucc m. Proof. -intros n m H; rewrite H; reflexivity. + intros n m H; rewrite H; reflexivity. Qed. Lemma Zsucc_inj_contrapositive : forall n m:Z, n <> m -> Zsucc n <> Zsucc m. Proof. -unfold not in |- *; intros n m H1 H2; apply H1; apply Zsucc_inj; assumption. + unfold not in |- *; intros n m H1 H2; apply H1; apply Zsucc_inj; assumption. Qed. (**********************************************************************) -(** Properties of subtraction on binary integer numbers *) +(** * Properties of subtraction on binary integer numbers *) + +(** ** [minus] and [Z0] *) Lemma Zminus_0_r : forall n:Z, n - Z0 = n. Proof. -intro; unfold Zminus in |- *; simpl in |- *; rewrite Zplus_0_r; - trivial with arith. + intro; unfold Zminus in |- *; simpl in |- *; rewrite Zplus_0_r; + trivial with arith. Qed. Lemma Zminus_0_l_reverse : forall n:Z, n = n - Z0. Proof. -intro; symmetry in |- *; apply Zminus_0_r. + intro; symmetry in |- *; apply Zminus_0_r. Qed. Lemma Zminus_diag : forall n:Z, n - n = Z0. Proof. -intro; unfold Zminus in |- *; rewrite Zplus_opp_r; trivial with arith. + intro; unfold Zminus in |- *; rewrite Zplus_opp_r; trivial with arith. Qed. Lemma Zminus_diag_reverse : forall n:Z, Z0 = n - n. Proof. -intro; symmetry in |- *; apply Zminus_diag. + intro; symmetry in |- *; apply Zminus_diag. Qed. + +(** ** Relating [minus] with [plus] and [Zsucc] *) + Lemma Zplus_minus_eq : forall n m p:Z, n = m + p -> p = n - m. Proof. -intros n m p H; unfold Zminus in |- *; apply (Zplus_reg_l m); - rewrite (Zplus_comm m (n + - m)); rewrite <- Zplus_assoc; - rewrite Zplus_opp_l; rewrite Zplus_0_r; rewrite H; - trivial with arith. + intros n m p H; unfold Zminus in |- *; apply (Zplus_reg_l m); + rewrite (Zplus_comm m (n + - m)); rewrite <- Zplus_assoc; + rewrite Zplus_opp_l; rewrite Zplus_0_r; rewrite H; + trivial with arith. Qed. Lemma Zminus_plus : forall n m:Z, n + m - n = m. Proof. -intros n m; unfold Zminus in |- *; rewrite (Zplus_comm n m); - rewrite <- Zplus_assoc; rewrite Zplus_opp_r; apply Zplus_0_r. + intros n m; unfold Zminus in |- *; rewrite (Zplus_comm n m); + rewrite <- Zplus_assoc; rewrite Zplus_opp_r; apply Zplus_0_r. Qed. Lemma Zplus_minus : forall n m:Z, n + (m - n) = m. Proof. -unfold Zminus in |- *; intros n m; rewrite Zplus_permute; rewrite Zplus_opp_r; - apply Zplus_0_r. + unfold Zminus in |- *; intros n m; rewrite Zplus_permute; rewrite Zplus_opp_r; + apply Zplus_0_r. Qed. Lemma Zminus_succ_l : forall n m:Z, Zsucc (n - m) = Zsucc n - m. Proof. -intros n m; unfold Zminus, Zsucc in |- *; rewrite (Zplus_comm n (- m)); - rewrite <- Zplus_assoc; apply Zplus_comm. + intros n m; unfold Zminus, Zsucc in |- *; rewrite (Zplus_comm n (- m)); + rewrite <- Zplus_assoc; apply Zplus_comm. Qed. Lemma Zminus_plus_simpl_l : forall n m p:Z, p + n - (p + m) = n - m. Proof. -intros n m p; unfold Zminus in |- *; rewrite Zopp_plus_distr; - rewrite Zplus_assoc; rewrite (Zplus_comm p); rewrite <- (Zplus_assoc n p); - rewrite Zplus_opp_r; rewrite Zplus_0_r; trivial with arith. + intros n m p; unfold Zminus in |- *; rewrite Zopp_plus_distr; + rewrite Zplus_assoc; rewrite (Zplus_comm p); rewrite <- (Zplus_assoc n p); + rewrite Zplus_opp_r; rewrite Zplus_0_r; trivial with arith. Qed. Lemma Zminus_plus_simpl_l_reverse : forall n m p:Z, n - m = p + n - (p + m). Proof. -intros; symmetry in |- *; apply Zminus_plus_simpl_l. + intros; symmetry in |- *; apply Zminus_plus_simpl_l. Qed. Lemma Zminus_plus_simpl_r : forall n m p:Z, n + p - (m + p) = n - m. -intros x y n. -unfold Zminus in |- *. -rewrite Zopp_plus_distr. -rewrite (Zplus_comm (- y) (- n)). -rewrite Zplus_assoc. -rewrite <- (Zplus_assoc x n (- n)). -rewrite (Zplus_opp_r n). -rewrite <- Zplus_0_r_reverse. -reflexivity. +Proof. + intros x y n. + unfold Zminus in |- *. + rewrite Zopp_plus_distr. + rewrite (Zplus_comm (- y) (- n)). + rewrite Zplus_assoc. + rewrite <- (Zplus_assoc x n (- n)). + rewrite (Zplus_opp_r n). + rewrite <- Zplus_0_r_reverse. + reflexivity. Qed. -(** Misc redundant properties *) - +(** ** Misc redundant properties *) Lemma Zeq_minus : forall n m:Z, n = m -> n - m = Z0. Proof. -intros x y H; rewrite H; symmetry in |- *; apply Zminus_diag_reverse. + intros x y H; rewrite H; symmetry in |- *; apply Zminus_diag_reverse. Qed. Lemma Zminus_eq : forall n m:Z, n - m = Z0 -> n = m. Proof. -intros x y H; rewrite <- (Zplus_minus y x); rewrite H; apply Zplus_0_r. + intros x y H; rewrite <- (Zplus_minus y x); rewrite H; apply Zplus_0_r. Qed. (**********************************************************************) -(** Properties of multiplication on binary integer numbers *) +(** * Properties of multiplication on binary integer numbers *) Theorem Zpos_mult_morphism : - forall p q:positive, Zpos (p*q) = Zpos p * Zpos q. + forall p q:positive, Zpos (p*q) = Zpos p * Zpos q. Proof. -auto. + auto. Qed. -(** One is neutral for multiplication *) +(** ** One is neutral for multiplication *) Theorem Zmult_1_l : forall n:Z, Zpos 1 * n = n. Proof. -intro x; destruct x; reflexivity. + intro x; destruct x; reflexivity. Qed. Theorem Zmult_1_r : forall n:Z, n * Zpos 1 = n. Proof. -intro x; destruct x; simpl in |- *; try rewrite Pmult_1_r; reflexivity. + intro x; destruct x; simpl in |- *; try rewrite Pmult_1_r; reflexivity. Qed. -(** Zero property of multiplication *) +(** ** Zero property of multiplication *) Theorem Zmult_0_l : forall n:Z, Z0 * n = Z0. Proof. -intro x; destruct x; reflexivity. + intro x; destruct x; reflexivity. Qed. Theorem Zmult_0_r : forall n:Z, n * Z0 = Z0. Proof. -intro x; destruct x; reflexivity. + intro x; destruct x; reflexivity. Qed. Hint Local Resolve Zmult_0_l Zmult_0_r. Lemma Zmult_0_r_reverse : forall n:Z, Z0 = n * Z0. Proof. -intro x; destruct x; reflexivity. + intro x; destruct x; reflexivity. Qed. -(** Commutativity of multiplication *) +(** ** Commutativity of multiplication *) Theorem Zmult_comm : forall n m:Z, n * m = m * n. Proof. -intros x y; destruct x as [| p| p]; destruct y as [| q| q]; simpl in |- *; - try rewrite (Pmult_comm p q); reflexivity. + intros x y; destruct x as [| p| p]; destruct y as [| q| q]; simpl in |- *; + try rewrite (Pmult_comm p q); reflexivity. Qed. -(** Associativity of multiplication *) +(** ** Associativity of multiplication *) Theorem Zmult_assoc : forall n m p:Z, n * (m * p) = n * m * p. Proof. -intros x y z; destruct x; destruct y; destruct z; simpl in |- *; - try rewrite Pmult_assoc; reflexivity. + intros x y z; destruct x; destruct y; destruct z; simpl in |- *; + try rewrite Pmult_assoc; reflexivity. Qed. Lemma Zmult_assoc_reverse : forall n m p:Z, n * m * p = n * (m * p). Proof. -intros n m p; rewrite Zmult_assoc; trivial with arith. + intros n m p; rewrite Zmult_assoc; trivial with arith. Qed. -(** Associativity mixed with commutativity *) +(** ** Associativity mixed with commutativity *) Theorem Zmult_permute : forall n m p:Z, n * (m * p) = m * (n * p). Proof. -intros x y z; rewrite (Zmult_assoc y x z); rewrite (Zmult_comm y x). -apply Zmult_assoc. + intros x y z; rewrite (Zmult_assoc y x z); rewrite (Zmult_comm y x). + apply Zmult_assoc. Qed. -(** Z is integral *) +(** ** Z is integral *) Theorem Zmult_integral_l : forall n m:Z, n <> Z0 -> m * n = Z0 -> m = Z0. Proof. -intros x y; destruct x as [| p| p]. + intros x y; destruct x as [| p| p]. intro H; absurd (Z0 = Z0); trivial. intros _ H; destruct y as [| q| q]; reflexivity || discriminate. intros _ H; destruct y as [| q| q]; reflexivity || discriminate. @@ -782,214 +791,220 @@ Qed. Theorem Zmult_integral : forall n m:Z, n * m = Z0 -> n = Z0 \/ m = Z0. Proof. -intros x y; destruct x; destruct y; auto; simpl in |- *; intro H; - discriminate H. + intros x y; destruct x; destruct y; auto; simpl in |- *; intro H; + discriminate H. Qed. Lemma Zmult_1_inversion_l : - forall n m:Z, n * m = Zpos 1 -> n = Zpos 1 \/ n = Zneg 1. + forall n m:Z, n * m = Zpos 1 -> n = Zpos 1 \/ n = Zneg 1. Proof. -intros x y; destruct x as [| p| p]; intro; [ discriminate | left | right ]; - (destruct y as [| q| q]; try discriminate; simpl in H; injection H; clear H; - intro H; rewrite Pmult_1_inversion_l with (1 := H); - reflexivity). + intros x y; destruct x as [| p| p]; intro; [ discriminate | left | right ]; + (destruct y as [| q| q]; try discriminate; simpl in H; injection H; clear H; + intro H; rewrite Pmult_1_inversion_l with (1 := H); + reflexivity). Qed. -(** Multiplication and Opposite *) +(** ** Multiplication and Opposite *) Theorem Zopp_mult_distr_l : forall n m:Z, - (n * m) = - n * m. Proof. -intros x y; destruct x; destruct y; reflexivity. + intros x y; destruct x; destruct y; reflexivity. Qed. Theorem Zopp_mult_distr_r : forall n m:Z, - (n * m) = n * - m. -intros x y; rewrite (Zmult_comm x y); rewrite Zopp_mult_distr_l; - apply Zmult_comm. +Proof. + intros x y; rewrite (Zmult_comm x y); rewrite Zopp_mult_distr_l; + apply Zmult_comm. Qed. Lemma Zopp_mult_distr_l_reverse : forall n m:Z, - n * m = - (n * m). Proof. -intros x y; symmetry in |- *; apply Zopp_mult_distr_l. + intros x y; symmetry in |- *; apply Zopp_mult_distr_l. Qed. Theorem Zmult_opp_comm : forall n m:Z, - n * m = n * - m. -intros x y; rewrite Zopp_mult_distr_l_reverse; rewrite Zopp_mult_distr_r; - trivial with arith. +Proof. + intros x y; rewrite Zopp_mult_distr_l_reverse; rewrite Zopp_mult_distr_r; + trivial with arith. Qed. Theorem Zmult_opp_opp : forall n m:Z, - n * - m = n * m. Proof. -intros x y; destruct x; destruct y; reflexivity. + intros x y; destruct x; destruct y; reflexivity. Qed. Theorem Zopp_eq_mult_neg_1 : forall n:Z, - n = n * Zneg 1. -intro x; induction x; intros; rewrite Zmult_comm; auto with arith. +Proof. + intro x; induction x; intros; rewrite Zmult_comm; auto with arith. Qed. -(** Distributivity of multiplication over addition *) +(** ** Distributivity of multiplication over addition *) Lemma weak_Zmult_plus_distr_r : - forall (p:positive) (n m:Z), Zpos p * (n + m) = Zpos p * n + Zpos p * m. -Proof. -intros x y' z'; case y'; case z'; auto with arith; intros y z; - (simpl in |- *; rewrite Pmult_plus_distr_l; trivial with arith) || - (simpl in |- *; ElimPcompare z y; intros E0; rewrite E0; - [ rewrite (Pcompare_Eq_eq z y E0); rewrite (Pcompare_refl (x * y)); - trivial with arith - | cut ((x * z ?= x * y)%positive Eq = Lt); - [ intros E; rewrite E; rewrite Pmult_minus_distr_l; - [ trivial with arith | apply ZC2; assumption ] - | apply nat_of_P_lt_Lt_compare_complement_morphism; - do 2 rewrite nat_of_P_mult_morphism; elim (ZL4 x); - intros h H1; rewrite H1; apply mult_S_lt_compat_l; - exact (nat_of_P_lt_Lt_compare_morphism z y E0) ] - | cut ((x * z ?= x * y)%positive Eq = Gt); - [ intros E; rewrite E; rewrite Pmult_minus_distr_l; auto with arith - | apply nat_of_P_gt_Gt_compare_complement_morphism; unfold gt in |- *; - do 2 rewrite nat_of_P_mult_morphism; elim (ZL4 x); - intros h H1; rewrite H1; apply mult_S_lt_compat_l; - exact (nat_of_P_gt_Gt_compare_morphism z y E0) ] ]). + forall (p:positive) (n m:Z), Zpos p * (n + m) = Zpos p * n + Zpos p * m. +Proof. + intros x y' z'; case y'; case z'; auto with arith; intros y z; + (simpl in |- *; rewrite Pmult_plus_distr_l; trivial with arith) || + (simpl in |- *; ElimPcompare z y; intros E0; rewrite E0; + [ rewrite (Pcompare_Eq_eq z y E0); rewrite (Pcompare_refl (x * y)); + trivial with arith + | cut ((x * z ?= x * y)%positive Eq = Lt); + [ intros E; rewrite E; rewrite Pmult_minus_distr_l; + [ trivial with arith | apply ZC2; assumption ] + | apply nat_of_P_lt_Lt_compare_complement_morphism; + do 2 rewrite nat_of_P_mult_morphism; elim (ZL4 x); + intros h H1; rewrite H1; apply mult_S_lt_compat_l; + exact (nat_of_P_lt_Lt_compare_morphism z y E0) ] + | cut ((x * z ?= x * y)%positive Eq = Gt); + [ intros E; rewrite E; rewrite Pmult_minus_distr_l; auto with arith + | apply nat_of_P_gt_Gt_compare_complement_morphism; unfold gt in |- *; + do 2 rewrite nat_of_P_mult_morphism; elim (ZL4 x); + intros h H1; rewrite H1; apply mult_S_lt_compat_l; + exact (nat_of_P_gt_Gt_compare_morphism z y E0) ] ]). Qed. Theorem Zmult_plus_distr_r : forall n m p:Z, n * (m + p) = n * m + n * p. Proof. -intros x y z; case x; - [ auto with arith - | intros x'; apply weak_Zmult_plus_distr_r - | intros p; apply Zopp_inj; rewrite Zopp_plus_distr; - do 3 rewrite <- Zopp_mult_distr_l_reverse; rewrite Zopp_neg; - apply weak_Zmult_plus_distr_r ]. + intros x y z; case x; + [ auto with arith + | intros x'; apply weak_Zmult_plus_distr_r + | intros p; apply Zopp_inj; rewrite Zopp_plus_distr; + do 3 rewrite <- Zopp_mult_distr_l_reverse; rewrite Zopp_neg; + apply weak_Zmult_plus_distr_r ]. Qed. Theorem Zmult_plus_distr_l : forall n m p:Z, (n + m) * p = n * p + m * p. Proof. -intros n m p; rewrite Zmult_comm; rewrite Zmult_plus_distr_r; - do 2 rewrite (Zmult_comm p); trivial with arith. + intros n m p; rewrite Zmult_comm; rewrite Zmult_plus_distr_r; + do 2 rewrite (Zmult_comm p); trivial with arith. Qed. -(** Distributivity of multiplication over subtraction *) +(** ** Distributivity of multiplication over subtraction *) Lemma Zmult_minus_distr_r : forall n m p:Z, (n - m) * p = n * p - m * p. Proof. -intros x y z; unfold Zminus in |- *. -rewrite <- Zopp_mult_distr_l_reverse. -apply Zmult_plus_distr_l. + intros x y z; unfold Zminus in |- *. + rewrite <- Zopp_mult_distr_l_reverse. + apply Zmult_plus_distr_l. Qed. Lemma Zmult_minus_distr_l : forall n m p:Z, p * (n - m) = p * n - p * m. Proof. -intros x y z; rewrite (Zmult_comm z (x - y)). -rewrite (Zmult_comm z x). -rewrite (Zmult_comm z y). -apply Zmult_minus_distr_r. + intros x y z; rewrite (Zmult_comm z (x - y)). + rewrite (Zmult_comm z x). + rewrite (Zmult_comm z y). + apply Zmult_minus_distr_r. Qed. -(** Simplification of multiplication for non-zero integers *) +(** ** Simplification of multiplication for non-zero integers *) Lemma Zmult_reg_l : forall n m p:Z, p <> Z0 -> p * n = p * m -> n = m. Proof. -intros x y z H H0. -generalize (Zeq_minus _ _ H0). -intro. -apply Zminus_eq. -rewrite <- Zmult_minus_distr_l in H1. -clear H0; destruct (Zmult_integral _ _ H1). -contradiction. -trivial. + intros x y z H H0. + generalize (Zeq_minus _ _ H0). + intro. + apply Zminus_eq. + rewrite <- Zmult_minus_distr_l in H1. + clear H0; destruct (Zmult_integral _ _ H1). + contradiction. + trivial. Qed. Lemma Zmult_reg_r : forall n m p:Z, p <> Z0 -> n * p = m * p -> n = m. Proof. -intros x y z Hz. -rewrite (Zmult_comm x z). -rewrite (Zmult_comm y z). -intro; apply Zmult_reg_l with z; assumption. + intros x y z Hz. + rewrite (Zmult_comm x z). + rewrite (Zmult_comm y z). + intro; apply Zmult_reg_l with z; assumption. Qed. -(** Addition and multiplication by 2 *) +(** ** Addition and multiplication by 2 *) Lemma Zplus_diag_eq_mult_2 : forall n:Z, n + n = n * Zpos 2. Proof. -intros x; pattern x at 1 2 in |- *; rewrite <- (Zmult_1_r x); - rewrite <- Zmult_plus_distr_r; reflexivity. + intros x; pattern x at 1 2 in |- *; rewrite <- (Zmult_1_r x); + rewrite <- Zmult_plus_distr_r; reflexivity. Qed. -(** Multiplication and successor *) +(** ** Multiplication and successor *) Lemma Zmult_succ_r : forall n m:Z, n * Zsucc m = n * m + n. Proof. -intros n m; unfold Zsucc in |- *; rewrite Zmult_plus_distr_r; - rewrite (Zmult_comm n (Zpos 1)); rewrite Zmult_1_l; - trivial with arith. + intros n m; unfold Zsucc in |- *; rewrite Zmult_plus_distr_r; + rewrite (Zmult_comm n (Zpos 1)); rewrite Zmult_1_l; + trivial with arith. Qed. Lemma Zmult_succ_r_reverse : forall n m:Z, n * m + n = n * Zsucc m. Proof. -intros; symmetry in |- *; apply Zmult_succ_r. + intros; symmetry in |- *; apply Zmult_succ_r. Qed. Lemma Zmult_succ_l : forall n m:Z, Zsucc n * m = n * m + m. Proof. -intros n m; unfold Zsucc in |- *; rewrite Zmult_plus_distr_l; - rewrite Zmult_1_l; trivial with arith. + intros n m; unfold Zsucc in |- *; rewrite Zmult_plus_distr_l; + rewrite Zmult_1_l; trivial with arith. Qed. Lemma Zmult_succ_l_reverse : forall n m:Z, n * m + m = Zsucc n * m. Proof. -intros; symmetry in |- *; apply Zmult_succ_l. + intros; symmetry in |- *; apply Zmult_succ_l. Qed. -(** Misc redundant properties *) +(** ** Misc redundant properties *) Lemma Z_eq_mult : forall n m:Z, m = Z0 -> m * n = Z0. -intros x y H; rewrite H; auto with arith. +Proof. + intros x y H; rewrite H; auto with arith. Qed. + + (**********************************************************************) -(** Relating binary positive numbers and binary integers *) +(** * Relating binary positive numbers and binary integers *) Lemma Zpos_xI : forall p:positive, Zpos (xI p) = Zpos 2 * Zpos p + Zpos 1. Proof. -intro; apply refl_equal. + intro; apply refl_equal. Qed. Lemma Zpos_xO : forall p:positive, Zpos (xO p) = Zpos 2 * Zpos p. Proof. -intro; apply refl_equal. + intro; apply refl_equal. Qed. Lemma Zneg_xI : forall p:positive, Zneg (xI p) = Zpos 2 * Zneg p - Zpos 1. Proof. -intro; apply refl_equal. + intro; apply refl_equal. Qed. Lemma Zneg_xO : forall p:positive, Zneg (xO p) = Zpos 2 * Zneg p. Proof. -reflexivity. + reflexivity. Qed. Lemma Zpos_plus_distr : forall p q:positive, Zpos (p + q) = Zpos p + Zpos q. Proof. -intros p p'; destruct p; - [ destruct p' as [p0| p0| ] - | destruct p' as [p0| p0| ] - | destruct p' as [p| p| ] ]; reflexivity. + intros p p'; destruct p; + [ destruct p' as [p0| p0| ] + | destruct p' as [p0| p0| ] + | destruct p' as [p| p| ] ]; reflexivity. Qed. Lemma Zneg_plus_distr : forall p q:positive, Zneg (p + q) = Zneg p + Zneg q. Proof. -intros p p'; destruct p; - [ destruct p' as [p0| p0| ] - | destruct p' as [p0| p0| ] - | destruct p' as [p| p| ] ]; reflexivity. + intros p p'; destruct p; + [ destruct p' as [p0| p0| ] + | destruct p' as [p0| p0| ] + | destruct p' as [p| p| ] ]; reflexivity. Qed. (**********************************************************************) -(** Order relations *) +(** * Order relations *) Definition Zlt (x y:Z) := (x ?= y) = Lt. Definition Zgt (x y:Z) := (x ?= y) = Gt. @@ -1008,41 +1023,41 @@ Notation "x < y < z" := (x < y /\ y < z) : Z_scope. Notation "x < y <= z" := (x < y /\ y <= z) : Z_scope. (**********************************************************************) -(** Absolute value on integers *) +(** * Absolute value on integers *) Definition Zabs_nat (x:Z) : nat := match x with - | Z0 => 0%nat - | Zpos p => nat_of_P p - | Zneg p => nat_of_P p + | Z0 => 0%nat + | Zpos p => nat_of_P p + | Zneg p => nat_of_P p end. Definition Zabs (z:Z) : Z := match z with - | Z0 => Z0 - | Zpos p => Zpos p - | Zneg p => Zpos p + | Z0 => Z0 + | Zpos p => Zpos p + | Zneg p => Zpos p end. (**********************************************************************) -(** From [nat] to [Z] *) +(** * From [nat] to [Z] *) Definition Z_of_nat (x:nat) := match x with - | O => Z0 - | S y => Zpos (P_of_succ_nat y) + | O => Z0 + | S y => Zpos (P_of_succ_nat y) end. Require Import BinNat. Definition Zabs_N (z:Z) := match z with - | Z0 => 0%N - | Zpos p => Npos p - | Zneg p => Npos p + | Z0 => 0%N + | Zpos p => Npos p + | Zneg p => Npos p end. Definition Z_of_N (x:N) := match x with - | N0 => Z0 - | Npos p => Zpos p + | N0 => Z0 + | Npos p => Zpos p end. diff --git a/theories/ZArith/Int.v b/theories/ZArith/Int.v index cb51b9d2..3cee9190 100644 --- a/theories/ZArith/Int.v +++ b/theories/ZArith/Int.v @@ -7,120 +7,126 @@ (***********************************************************************) (* Finite sets library. - * Authors: Pierre Letouzey and Jean-Christophe Filliâtre - * Institution: LRI, CNRS UMR 8623 - Université Paris Sud + * Authors: Pierre Letouzey and Jean-Christophe Filliâtre + * Institution: LRI, CNRS UMR 8623 - Université Paris Sud * 91405 Orsay, France *) -(* $Id: Int.v 8933 2006-06-09 14:08:38Z herbelin $ *) +(* $Id: Int.v 9319 2006-10-30 12:41:21Z barras $ *) -(** * An axiomatization of integers. *) +(** An axiomatization of integers. *) (** We define a signature for an integer datatype based on [Z]. - The goal is to allow a switch after extraction to ocaml's - [big_int] or even [int] when finiteness isn't a problem - (typically : when mesuring the height of an AVL tree). + The goal is to allow a switch after extraction to ocaml's + [big_int] or even [int] when finiteness isn't a problem + (typically : when mesuring the height of an AVL tree). *) Require Import ZArith. Require Import ROmega. Delimit Scope Int_scope with I. + +(** * a specification of integers *) + Module Type Int. - Open Scope Int_scope. - - Parameter int : Set. - - Parameter i2z : int -> Z. - Arguments Scope i2z [ Int_scope ]. - - Parameter _0 : int. - Parameter _1 : int. - Parameter _2 : int. - Parameter _3 : int. - Parameter plus : int -> int -> int. - Parameter opp : int -> int. - Parameter minus : int -> int -> int. - Parameter mult : int -> int -> int. - Parameter max : int -> int -> int. - - Notation "0" := _0 : Int_scope. - Notation "1" := _1 : Int_scope. - Notation "2" := _2 : Int_scope. - Notation "3" := _3 : Int_scope. - Infix "+" := plus : Int_scope. - Infix "-" := minus : Int_scope. - Infix "*" := mult : Int_scope. - Notation "- x" := (opp x) : Int_scope. - -(** For logical relations, we can rely on their counterparts in Z, - since they don't appear after extraction. Moreover, using tactics - like omega is easier this way. *) - - Notation "x == y" := (i2z x = i2z y) - (at level 70, y at next level, no associativity) : Int_scope. - Notation "x <= y" := (Zle (i2z x) (i2z y)): Int_scope. - Notation "x < y" := (Zlt (i2z x) (i2z y)) : Int_scope. - Notation "x >= y" := (Zge (i2z x) (i2z y)) : Int_scope. - Notation "x > y" := (Zgt (i2z x) (i2z y)): Int_scope. - Notation "x <= y <= z" := (x <= y /\ y <= z) : Int_scope. - Notation "x <= y < z" := (x <= y /\ y < z) : Int_scope. - Notation "x < y < z" := (x < y /\ y < z) : Int_scope. - Notation "x < y <= z" := (x < y /\ y <= z) : Int_scope. - - (** Some decidability fonctions (informative). *) - - Axiom gt_le_dec : forall x y: int, {x > y} + {x <= y}. - Axiom ge_lt_dec : forall x y : int, {x >= y} + {x < y}. - Axiom eq_dec : forall x y : int, { x == y } + {~ x==y }. - - (** Specifications *) - - (** First, we ask [i2z] to be injective. Said otherwise, our ad-hoc equality - [==] and the generic [=] are in fact equivalent. We define [==] - nonetheless since the translation to [Z] for using automatic tactic is easier. *) - - Axiom i2z_eq : forall n p : int, n == p -> n = p. - - (** Then, we express the specifications of the above parameters using their - Z counterparts. *) - - Open Scope Z_scope. - Axiom i2z_0 : i2z _0 = 0. - Axiom i2z_1 : i2z _1 = 1. - Axiom i2z_2 : i2z _2 = 2. - Axiom i2z_3 : i2z _3 = 3. - Axiom i2z_plus : forall n p, i2z (n + p) = i2z n + i2z p. - Axiom i2z_opp : forall n, i2z (-n) = -i2z n. - Axiom i2z_minus : forall n p, i2z (n - p) = i2z n - i2z p. - Axiom i2z_mult : forall n p, i2z (n * p) = i2z n * i2z p. - Axiom i2z_max : forall n p, i2z (max n p) = Zmax (i2z n) (i2z p). + Open Scope Int_scope. + + Parameter int : Set. + + Parameter i2z : int -> Z. + Arguments Scope i2z [ Int_scope ]. + + Parameter _0 : int. + Parameter _1 : int. + Parameter _2 : int. + Parameter _3 : int. + Parameter plus : int -> int -> int. + Parameter opp : int -> int. + Parameter minus : int -> int -> int. + Parameter mult : int -> int -> int. + Parameter max : int -> int -> int. + + Notation "0" := _0 : Int_scope. + Notation "1" := _1 : Int_scope. + Notation "2" := _2 : Int_scope. + Notation "3" := _3 : Int_scope. + Infix "+" := plus : Int_scope. + Infix "-" := minus : Int_scope. + Infix "*" := mult : Int_scope. + Notation "- x" := (opp x) : Int_scope. + + (** For logical relations, we can rely on their counterparts in Z, + since they don't appear after extraction. Moreover, using tactics + like omega is easier this way. *) + + Notation "x == y" := (i2z x = i2z y) + (at level 70, y at next level, no associativity) : Int_scope. + Notation "x <= y" := (Zle (i2z x) (i2z y)): Int_scope. + Notation "x < y" := (Zlt (i2z x) (i2z y)) : Int_scope. + Notation "x >= y" := (Zge (i2z x) (i2z y)) : Int_scope. + Notation "x > y" := (Zgt (i2z x) (i2z y)): Int_scope. + Notation "x <= y <= z" := (x <= y /\ y <= z) : Int_scope. + Notation "x <= y < z" := (x <= y /\ y < z) : Int_scope. + Notation "x < y < z" := (x < y /\ y < z) : Int_scope. + Notation "x < y <= z" := (x < y /\ y <= z) : Int_scope. + + (** Some decidability fonctions (informative). *) + + Axiom gt_le_dec : forall x y: int, {x > y} + {x <= y}. + Axiom ge_lt_dec : forall x y : int, {x >= y} + {x < y}. + Axiom eq_dec : forall x y : int, { x == y } + {~ x==y }. + + (** Specifications *) + + (** First, we ask [i2z] to be injective. Said otherwise, our ad-hoc equality + [==] and the generic [=] are in fact equivalent. We define [==] + nonetheless since the translation to [Z] for using automatic tactic is easier. *) + + Axiom i2z_eq : forall n p : int, n == p -> n = p. + + (** Then, we express the specifications of the above parameters using their + Z counterparts. *) + + Open Scope Z_scope. + Axiom i2z_0 : i2z _0 = 0. + Axiom i2z_1 : i2z _1 = 1. + Axiom i2z_2 : i2z _2 = 2. + Axiom i2z_3 : i2z _3 = 3. + Axiom i2z_plus : forall n p, i2z (n + p) = i2z n + i2z p. + Axiom i2z_opp : forall n, i2z (-n) = -i2z n. + Axiom i2z_minus : forall n p, i2z (n - p) = i2z n - i2z p. + Axiom i2z_mult : forall n p, i2z (n * p) = i2z n * i2z p. + Axiom i2z_max : forall n p, i2z (max n p) = Zmax (i2z n) (i2z p). End Int. -Module MoreInt (I:Int). - Import I. - Open Scope Int_scope. +(** * Facts and tactics using [Int] *) + +Module MoreInt (I:Int). + Import I. + + Open Scope Int_scope. - (** A magic (but costly) tactic that goes from [int] back to the [Z] - friendly world ... *) + (** A magic (but costly) tactic that goes from [int] back to the [Z] + friendly world ... *) - Hint Rewrite -> - i2z_0 i2z_1 i2z_2 i2z_3 i2z_plus i2z_opp i2z_minus i2z_mult i2z_max : i2z. + Hint Rewrite -> + i2z_0 i2z_1 i2z_2 i2z_3 i2z_plus i2z_opp i2z_minus i2z_mult i2z_max : i2z. - Ltac i2z := match goal with - | H : (eq (A:=int) ?a ?b) |- _ => - generalize (f_equal i2z H); - try autorewrite with i2z; clear H; intro H; i2z - | |- (eq (A:=int) ?a ?b) => apply (i2z_eq a b); try autorewrite with i2z; i2z - | H : _ |- _ => progress autorewrite with i2z in H; i2z - | _ => try autorewrite with i2z - end. + Ltac i2z := match goal with + | H : (eq (A:=int) ?a ?b) |- _ => + generalize (f_equal i2z H); + try autorewrite with i2z; clear H; intro H; i2z + | |- (eq (A:=int) ?a ?b) => apply (i2z_eq a b); try autorewrite with i2z; i2z + | H : _ |- _ => progress autorewrite with i2z in H; i2z + | _ => try autorewrite with i2z + end. - (** A reflexive version of the [i2z] tactic *) + (** A reflexive version of the [i2z] tactic *) - (** this [i2z_refl] is actually weaker than [i2z]. For instance, if a + (** this [i2z_refl] is actually weaker than [i2z]. For instance, if a [i2z] is buried deep inside a subterm, [i2z_refl] may miss it. See also the limitation about [Set] or [Type] part below. Anyhow, [i2z_refl] is enough for applying [romega]. *) @@ -150,228 +156,228 @@ Module MoreInt (I:Int). end. Inductive ExprI : Set := - | EI0 : ExprI - | EI1 : ExprI - | EI2 : ExprI - | EI3 : ExprI - | EIplus : ExprI -> ExprI -> ExprI - | EIopp : ExprI -> ExprI - | EIminus : ExprI -> ExprI -> ExprI - | EImult : ExprI -> ExprI -> ExprI - | EImax : ExprI -> ExprI -> ExprI - | EIraw : int -> ExprI. + | EI0 : ExprI + | EI1 : ExprI + | EI2 : ExprI + | EI3 : ExprI + | EIplus : ExprI -> ExprI -> ExprI + | EIopp : ExprI -> ExprI + | EIminus : ExprI -> ExprI -> ExprI + | EImult : ExprI -> ExprI -> ExprI + | EImax : ExprI -> ExprI -> ExprI + | EIraw : int -> ExprI. Inductive ExprZ : Set := - | EZplus : ExprZ -> ExprZ -> ExprZ - | EZopp : ExprZ -> ExprZ - | EZminus : ExprZ -> ExprZ -> ExprZ - | EZmult : ExprZ -> ExprZ -> ExprZ - | EZmax : ExprZ -> ExprZ -> ExprZ - | EZofI : ExprI -> ExprZ - | EZraw : Z -> ExprZ. + | EZplus : ExprZ -> ExprZ -> ExprZ + | EZopp : ExprZ -> ExprZ + | EZminus : ExprZ -> ExprZ -> ExprZ + | EZmult : ExprZ -> ExprZ -> ExprZ + | EZmax : ExprZ -> ExprZ -> ExprZ + | EZofI : ExprI -> ExprZ + | EZraw : Z -> ExprZ. Inductive ExprP : Type := - | EPeq : ExprZ -> ExprZ -> ExprP - | EPlt : ExprZ -> ExprZ -> ExprP - | EPle : ExprZ -> ExprZ -> ExprP - | EPgt : ExprZ -> ExprZ -> ExprP - | EPge : ExprZ -> ExprZ -> ExprP - | EPimpl : ExprP -> ExprP -> ExprP - | EPequiv : ExprP -> ExprP -> ExprP - | EPand : ExprP -> ExprP -> ExprP - | EPor : ExprP -> ExprP -> ExprP - | EPneg : ExprP -> ExprP - | EPraw : Prop -> ExprP. - - (** [int] to [ExprI] *) - - Ltac i2ei trm := - match constr:trm with - | 0 => constr:EI0 - | 1 => constr:EI1 - | 2 => constr:EI2 - | 3 => constr:EI3 - | ?x + ?y => let ex := i2ei x with ey := i2ei y in constr:(EIplus ex ey) - | ?x - ?y => let ex := i2ei x with ey := i2ei y in constr:(EIminus ex ey) - | ?x * ?y => let ex := i2ei x with ey := i2ei y in constr:(EImult ex ey) - | max ?x ?y => let ex := i2ei x with ey := i2ei y in constr:(EImax ex ey) - | - ?x => let ex := i2ei x in constr:(EIopp ex) - | ?x => constr:(EIraw x) - end - - (** [Z] to [ExprZ] *) - - with z2ez trm := - match constr:trm with - | (?x+?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EZplus ex ey) - | (?x-?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EZminus ex ey) - | (?x*?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EZmult ex ey) - | (Zmax ?x ?y) => let ex := z2ez x with ey := z2ez y in constr:(EZmax ex ey) - | (-?x)%Z => let ex := z2ez x in constr:(EZopp ex) - | i2z ?x => let ex := i2ei x in constr:(EZofI ex) - | ?x => constr:(EZraw x) - end. + | EPeq : ExprZ -> ExprZ -> ExprP + | EPlt : ExprZ -> ExprZ -> ExprP + | EPle : ExprZ -> ExprZ -> ExprP + | EPgt : ExprZ -> ExprZ -> ExprP + | EPge : ExprZ -> ExprZ -> ExprP + | EPimpl : ExprP -> ExprP -> ExprP + | EPequiv : ExprP -> ExprP -> ExprP + | EPand : ExprP -> ExprP -> ExprP + | EPor : ExprP -> ExprP -> ExprP + | EPneg : ExprP -> ExprP + | EPraw : Prop -> ExprP. + + (** [int] to [ExprI] *) + + Ltac i2ei trm := + match constr:trm with + | 0 => constr:EI0 + | 1 => constr:EI1 + | 2 => constr:EI2 + | 3 => constr:EI3 + | ?x + ?y => let ex := i2ei x with ey := i2ei y in constr:(EIplus ex ey) + | ?x - ?y => let ex := i2ei x with ey := i2ei y in constr:(EIminus ex ey) + | ?x * ?y => let ex := i2ei x with ey := i2ei y in constr:(EImult ex ey) + | max ?x ?y => let ex := i2ei x with ey := i2ei y in constr:(EImax ex ey) + | - ?x => let ex := i2ei x in constr:(EIopp ex) + | ?x => constr:(EIraw x) + end + + (** [Z] to [ExprZ] *) + + with z2ez trm := + match constr:trm with + | (?x+?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EZplus ex ey) + | (?x-?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EZminus ex ey) + | (?x*?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EZmult ex ey) + | (Zmax ?x ?y) => let ex := z2ez x with ey := z2ez y in constr:(EZmax ex ey) + | (-?x)%Z => let ex := z2ez x in constr:(EZopp ex) + | i2z ?x => let ex := i2ei x in constr:(EZofI ex) + | ?x => constr:(EZraw x) + end. - (** [Prop] to [ExprP] *) - - Ltac p2ep trm := - match constr:trm with - | (?x <-> ?y) => let ex := p2ep x with ey := p2ep y in constr:(EPequiv ex ey) - | (?x -> ?y) => let ex := p2ep x with ey := p2ep y in constr:(EPimpl ex ey) - | (?x /\ ?y) => let ex := p2ep x with ey := p2ep y in constr:(EPand ex ey) - | (?x \/ ?y) => let ex := p2ep x with ey := p2ep y in constr:(EPor ex ey) - | (~ ?x) => let ex := p2ep x in constr:(EPneg ex) - | (eq (A:=Z) ?x ?y) => let ex := z2ez x with ey := z2ez y in constr:(EPeq ex ey) - | (?x<?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPlt ex ey) - | (?x<=?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPle ex ey) - | (?x>?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPgt ex ey) - | (?x>=?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPge ex ey) - | ?x => constr:(EPraw x) - end. - - (** [ExprI] to [int] *) - - Fixpoint ei2i (e:ExprI) : int := - match e with - | EI0 => 0 - | EI1 => 1 - | EI2 => 2 - | EI3 => 3 - | EIplus e1 e2 => (ei2i e1)+(ei2i e2) - | EIminus e1 e2 => (ei2i e1)-(ei2i e2) - | EImult e1 e2 => (ei2i e1)*(ei2i e2) - | EImax e1 e2 => max (ei2i e1) (ei2i e2) - | EIopp e => -(ei2i e) - | EIraw i => i - end. - - (** [ExprZ] to [Z] *) - - Fixpoint ez2z (e:ExprZ) : Z := - match e with - | EZplus e1 e2 => ((ez2z e1)+(ez2z e2))%Z - | EZminus e1 e2 => ((ez2z e1)-(ez2z e2))%Z - | EZmult e1 e2 => ((ez2z e1)*(ez2z e2))%Z - | EZmax e1 e2 => Zmax (ez2z e1) (ez2z e2) - | EZopp e => (-(ez2z e))%Z - | EZofI e => i2z (ei2i e) - | EZraw z => z - end. - - (** [ExprP] to [Prop] *) - - Fixpoint ep2p (e:ExprP) : Prop := - match e with - | EPeq e1 e2 => (ez2z e1) = (ez2z e2) - | EPlt e1 e2 => ((ez2z e1)<(ez2z e2))%Z - | EPle e1 e2 => ((ez2z e1)<=(ez2z e2))%Z - | EPgt e1 e2 => ((ez2z e1)>(ez2z e2))%Z - | EPge e1 e2 => ((ez2z e1)>=(ez2z e2))%Z - | EPimpl e1 e2 => (ep2p e1) -> (ep2p e2) - | EPequiv e1 e2 => (ep2p e1) <-> (ep2p e2) - | EPand e1 e2 => (ep2p e1) /\ (ep2p e2) - | EPor e1 e2 => (ep2p e1) \/ (ep2p e2) - | EPneg e => ~ (ep2p e) - | EPraw p => p - end. - - (** [ExprI] (supposed under a [i2z]) to a simplified [ExprZ] *) + (** [Prop] to [ExprP] *) + + Ltac p2ep trm := + match constr:trm with + | (?x <-> ?y) => let ex := p2ep x with ey := p2ep y in constr:(EPequiv ex ey) + | (?x -> ?y) => let ex := p2ep x with ey := p2ep y in constr:(EPimpl ex ey) + | (?x /\ ?y) => let ex := p2ep x with ey := p2ep y in constr:(EPand ex ey) + | (?x \/ ?y) => let ex := p2ep x with ey := p2ep y in constr:(EPor ex ey) + | (~ ?x) => let ex := p2ep x in constr:(EPneg ex) + | (eq (A:=Z) ?x ?y) => let ex := z2ez x with ey := z2ez y in constr:(EPeq ex ey) + | (?x<?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPlt ex ey) + | (?x<=?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPle ex ey) + | (?x>?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPgt ex ey) + | (?x>=?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPge ex ey) + | ?x => constr:(EPraw x) + end. + + (** [ExprI] to [int] *) + + Fixpoint ei2i (e:ExprI) : int := + match e with + | EI0 => 0 + | EI1 => 1 + | EI2 => 2 + | EI3 => 3 + | EIplus e1 e2 => (ei2i e1)+(ei2i e2) + | EIminus e1 e2 => (ei2i e1)-(ei2i e2) + | EImult e1 e2 => (ei2i e1)*(ei2i e2) + | EImax e1 e2 => max (ei2i e1) (ei2i e2) + | EIopp e => -(ei2i e) + | EIraw i => i + end. + + (** [ExprZ] to [Z] *) + + Fixpoint ez2z (e:ExprZ) : Z := + match e with + | EZplus e1 e2 => ((ez2z e1)+(ez2z e2))%Z + | EZminus e1 e2 => ((ez2z e1)-(ez2z e2))%Z + | EZmult e1 e2 => ((ez2z e1)*(ez2z e2))%Z + | EZmax e1 e2 => Zmax (ez2z e1) (ez2z e2) + | EZopp e => (-(ez2z e))%Z + | EZofI e => i2z (ei2i e) + | EZraw z => z + end. + + (** [ExprP] to [Prop] *) + + Fixpoint ep2p (e:ExprP) : Prop := + match e with + | EPeq e1 e2 => (ez2z e1) = (ez2z e2) + | EPlt e1 e2 => ((ez2z e1)<(ez2z e2))%Z + | EPle e1 e2 => ((ez2z e1)<=(ez2z e2))%Z + | EPgt e1 e2 => ((ez2z e1)>(ez2z e2))%Z + | EPge e1 e2 => ((ez2z e1)>=(ez2z e2))%Z + | EPimpl e1 e2 => (ep2p e1) -> (ep2p e2) + | EPequiv e1 e2 => (ep2p e1) <-> (ep2p e2) + | EPand e1 e2 => (ep2p e1) /\ (ep2p e2) + | EPor e1 e2 => (ep2p e1) \/ (ep2p e2) + | EPneg e => ~ (ep2p e) + | EPraw p => p + end. + + (** [ExprI] (supposed under a [i2z]) to a simplified [ExprZ] *) - Fixpoint norm_ei (e:ExprI) : ExprZ := - match e with - | EI0 => EZraw (0%Z) - | EI1 => EZraw (1%Z) - | EI2 => EZraw (2%Z) - | EI3 => EZraw (3%Z) - | EIplus e1 e2 => EZplus (norm_ei e1) (norm_ei e2) - | EIminus e1 e2 => EZminus (norm_ei e1) (norm_ei e2) - | EImult e1 e2 => EZmult (norm_ei e1) (norm_ei e2) - | EImax e1 e2 => EZmax (norm_ei e1) (norm_ei e2) - | EIopp e => EZopp (norm_ei e) - | EIraw i => EZofI (EIraw i) - end. - - (** [ExprZ] to a simplified [ExprZ] *) - - Fixpoint norm_ez (e:ExprZ) : ExprZ := - match e with - | EZplus e1 e2 => EZplus (norm_ez e1) (norm_ez e2) - | EZminus e1 e2 => EZminus (norm_ez e1) (norm_ez e2) - | EZmult e1 e2 => EZmult (norm_ez e1) (norm_ez e2) - | EZmax e1 e2 => EZmax (norm_ez e1) (norm_ez e2) - | EZopp e => EZopp (norm_ez e) - | EZofI e => norm_ei e - | EZraw z => EZraw z - end. - - (** [ExprP] to a simplified [ExprP] *) - - Fixpoint norm_ep (e:ExprP) : ExprP := - match e with - | EPeq e1 e2 => EPeq (norm_ez e1) (norm_ez e2) - | EPlt e1 e2 => EPlt (norm_ez e1) (norm_ez e2) - | EPle e1 e2 => EPle (norm_ez e1) (norm_ez e2) - | EPgt e1 e2 => EPgt (norm_ez e1) (norm_ez e2) - | EPge e1 e2 => EPge (norm_ez e1) (norm_ez e2) - | EPimpl e1 e2 => EPimpl (norm_ep e1) (norm_ep e2) - | EPequiv e1 e2 => EPequiv (norm_ep e1) (norm_ep e2) - | EPand e1 e2 => EPand (norm_ep e1) (norm_ep e2) - | EPor e1 e2 => EPor (norm_ep e1) (norm_ep e2) - | EPneg e => EPneg (norm_ep e) - | EPraw p => EPraw p - end. - - Lemma norm_ei_correct : forall e:ExprI, ez2z (norm_ei e) = i2z (ei2i e). - Proof. - induction e; simpl; intros; i2z; auto; try congruence. - Qed. - - Lemma norm_ez_correct : forall e:ExprZ, ez2z (norm_ez e) = ez2z e. - Proof. - induction e; simpl; intros; i2z; auto; try congruence; apply norm_ei_correct. - Qed. - - Lemma norm_ep_correct : - forall e:ExprP, ep2p (norm_ep e) <-> ep2p e. - Proof. - induction e; simpl; repeat (rewrite norm_ez_correct); intuition. - Qed. - - Lemma norm_ep_correct2 : - forall e:ExprP, ep2p (norm_ep e) -> ep2p e. - Proof. - intros; destruct (norm_ep_correct e); auto. - Qed. - - Ltac i2z_refl := - i2z_gen; - match goal with |- ?t => - let e := p2ep t - in - (change (ep2p e); - apply norm_ep_correct2; - simpl) - end. + Fixpoint norm_ei (e:ExprI) : ExprZ := + match e with + | EI0 => EZraw (0%Z) + | EI1 => EZraw (1%Z) + | EI2 => EZraw (2%Z) + | EI3 => EZraw (3%Z) + | EIplus e1 e2 => EZplus (norm_ei e1) (norm_ei e2) + | EIminus e1 e2 => EZminus (norm_ei e1) (norm_ei e2) + | EImult e1 e2 => EZmult (norm_ei e1) (norm_ei e2) + | EImax e1 e2 => EZmax (norm_ei e1) (norm_ei e2) + | EIopp e => EZopp (norm_ei e) + | EIraw i => EZofI (EIraw i) + end. + + (** [ExprZ] to a simplified [ExprZ] *) + + Fixpoint norm_ez (e:ExprZ) : ExprZ := + match e with + | EZplus e1 e2 => EZplus (norm_ez e1) (norm_ez e2) + | EZminus e1 e2 => EZminus (norm_ez e1) (norm_ez e2) + | EZmult e1 e2 => EZmult (norm_ez e1) (norm_ez e2) + | EZmax e1 e2 => EZmax (norm_ez e1) (norm_ez e2) + | EZopp e => EZopp (norm_ez e) + | EZofI e => norm_ei e + | EZraw z => EZraw z + end. + + (** [ExprP] to a simplified [ExprP] *) + + Fixpoint norm_ep (e:ExprP) : ExprP := + match e with + | EPeq e1 e2 => EPeq (norm_ez e1) (norm_ez e2) + | EPlt e1 e2 => EPlt (norm_ez e1) (norm_ez e2) + | EPle e1 e2 => EPle (norm_ez e1) (norm_ez e2) + | EPgt e1 e2 => EPgt (norm_ez e1) (norm_ez e2) + | EPge e1 e2 => EPge (norm_ez e1) (norm_ez e2) + | EPimpl e1 e2 => EPimpl (norm_ep e1) (norm_ep e2) + | EPequiv e1 e2 => EPequiv (norm_ep e1) (norm_ep e2) + | EPand e1 e2 => EPand (norm_ep e1) (norm_ep e2) + | EPor e1 e2 => EPor (norm_ep e1) (norm_ep e2) + | EPneg e => EPneg (norm_ep e) + | EPraw p => EPraw p + end. + + Lemma norm_ei_correct : forall e:ExprI, ez2z (norm_ei e) = i2z (ei2i e). + Proof. + induction e; simpl; intros; i2z; auto; try congruence. + Qed. + + Lemma norm_ez_correct : forall e:ExprZ, ez2z (norm_ez e) = ez2z e. + Proof. + induction e; simpl; intros; i2z; auto; try congruence; apply norm_ei_correct. + Qed. + + Lemma norm_ep_correct : + forall e:ExprP, ep2p (norm_ep e) <-> ep2p e. + Proof. + induction e; simpl; repeat (rewrite norm_ez_correct); intuition. + Qed. + + Lemma norm_ep_correct2 : + forall e:ExprP, ep2p (norm_ep e) -> ep2p e. + Proof. + intros; destruct (norm_ep_correct e); auto. + Qed. + + Ltac i2z_refl := + i2z_gen; + match goal with |- ?t => + let e := p2ep t + in + (change (ep2p e); + apply norm_ep_correct2; + simpl) + end. - Ltac iauto := i2z_refl; auto. - Ltac iomega := i2z_refl; intros; romega. + Ltac iauto := i2z_refl; auto. + Ltac iomega := i2z_refl; intros; romega. - Open Scope Z_scope. + Open Scope Z_scope. - Lemma max_spec : forall (x y:Z), - x >= y /\ Zmax x y = x \/ - x < y /\ Zmax x y = y. - Proof. - intros; unfold Zmax, Zlt, Zge. - destruct (Zcompare x y); [ left | right | left ]; split; auto; discriminate. - Qed. + Lemma max_spec : forall (x y:Z), + x >= y /\ Zmax x y = x \/ + x < y /\ Zmax x y = y. + Proof. + intros; unfold Zmax, Zlt, Zge. + destruct (Zcompare x y); [ left | right | left ]; split; auto; discriminate. + Qed. - Ltac omega_max_genspec x y := + Ltac omega_max_genspec x y := generalize (max_spec x y); - let z := fresh "z" in let Hz := fresh "Hz" in - (set (z:=Zmax x y); clearbody z). + (let z := fresh "z" in let Hz := fresh "Hz" in + set (z:=Zmax x y); clearbody z). - Ltac omega_max_loop := + Ltac omega_max_loop := match goal with (* hack: we don't want [i2z (height ...)] to be reduced by romega later... *) | |- context [ i2z (?f ?x) ] => @@ -380,42 +386,45 @@ Module MoreInt (I:Int). | _ => intros end. - Ltac omega_max := i2z_refl; omega_max_loop; try romega. + Ltac omega_max := i2z_refl; omega_max_loop; try romega. + + Ltac false_omega := i2z_refl; intros; romega. + Ltac false_omega_max := elimtype False; omega_max. - Ltac false_omega := i2z_refl; intros; romega. - Ltac false_omega_max := elimtype False; omega_max. - - Open Scope Int_scope. + Open Scope Int_scope. End MoreInt. + +(** * An implementation of [Int] *) + (** It's always nice to know that our [Int] interface is realizable :-) *) Module Z_as_Int <: Int. - Open Scope Z_scope. - Definition int := Z. - Definition _0 := 0. - Definition _1 := 1. - Definition _2 := 2. - Definition _3 := 3. - Definition plus := Zplus. - Definition opp := Zopp. - Definition minus := Zminus. - Definition mult := Zmult. - Definition max := Zmax. - Definition gt_le_dec := Z_gt_le_dec. - Definition ge_lt_dec := Z_ge_lt_dec. - Definition eq_dec := Z_eq_dec. - Definition i2z : int -> Z := fun n => n. - Lemma i2z_eq : forall n p, i2z n=i2z p -> n = p. Proof. auto. Qed. - Lemma i2z_0 : i2z _0 = 0. Proof. auto. Qed. - Lemma i2z_1 : i2z _1 = 1. Proof. auto. Qed. - Lemma i2z_2 : i2z _2 = 2. Proof. auto. Qed. - Lemma i2z_3 : i2z _3 = 3. Proof. auto. Qed. - Lemma i2z_plus : forall n p, i2z (n + p) = i2z n + i2z p. Proof. auto. Qed. - Lemma i2z_opp : forall n, i2z (- n) = - i2z n. Proof. auto. Qed. - Lemma i2z_minus : forall n p, i2z (n - p) = i2z n - i2z p. Proof. auto. Qed. - Lemma i2z_mult : forall n p, i2z (n * p) = i2z n * i2z p. Proof. auto. Qed. - Lemma i2z_max : forall n p, i2z (max n p) = Zmax (i2z n) (i2z p). Proof. auto. Qed. + Open Scope Z_scope. + Definition int := Z. + Definition _0 := 0. + Definition _1 := 1. + Definition _2 := 2. + Definition _3 := 3. + Definition plus := Zplus. + Definition opp := Zopp. + Definition minus := Zminus. + Definition mult := Zmult. + Definition max := Zmax. + Definition gt_le_dec := Z_gt_le_dec. + Definition ge_lt_dec := Z_ge_lt_dec. + Definition eq_dec := Z_eq_dec. + Definition i2z : int -> Z := fun n => n. + Lemma i2z_eq : forall n p, i2z n=i2z p -> n = p. Proof. auto. Qed. + Lemma i2z_0 : i2z _0 = 0. Proof. auto. Qed. + Lemma i2z_1 : i2z _1 = 1. Proof. auto. Qed. + Lemma i2z_2 : i2z _2 = 2. Proof. auto. Qed. + Lemma i2z_3 : i2z _3 = 3. Proof. auto. Qed. + Lemma i2z_plus : forall n p, i2z (n + p) = i2z n + i2z p. Proof. auto. Qed. + Lemma i2z_opp : forall n, i2z (- n) = - i2z n. Proof. auto. Qed. + Lemma i2z_minus : forall n p, i2z (n - p) = i2z n - i2z p. Proof. auto. Qed. + Lemma i2z_mult : forall n p, i2z (n * p) = i2z n * i2z p. Proof. auto. Qed. + Lemma i2z_max : forall n p, i2z (max n p) = Zmax (i2z n) (i2z p). Proof. auto. Qed. End Z_as_Int. diff --git a/theories/ZArith/Wf_Z.v b/theories/ZArith/Wf_Z.v index af1fdd0b..1d7948a5 100644 --- a/theories/ZArith/Wf_Z.v +++ b/theories/ZArith/Wf_Z.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Wf_Z.v 6984 2005-05-02 10:50:15Z herbelin $ i*) +(*i $Id: Wf_Z.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import BinInt. Require Import Zcompare. @@ -35,222 +35,229 @@ Open Local Scope Z_scope. Then the diagram will be closed and the theorem proved. *) Lemma Z_of_nat_complete : - forall x:Z, 0 <= x -> exists n : nat, x = Z_of_nat n. -intro x; destruct x; intros; - [ exists 0%nat; auto with arith - | specialize (ZL4 p); intros Hp; elim Hp; intros; exists (S x); intros; - simpl in |- *; specialize (nat_of_P_o_P_of_succ_nat_eq_succ x); - intro Hx0; rewrite <- H0 in Hx0; apply f_equal with (f := Zpos); - apply nat_of_P_inj; auto with arith - | absurd (0 <= Zneg p); - [ unfold Zle in |- *; simpl in |- *; do 2 unfold not in |- *; - auto with arith - | assumption ] ]. + forall x:Z, 0 <= x -> exists n : nat, x = Z_of_nat n. +Proof. + intro x; destruct x; intros; + [ exists 0%nat; auto with arith + | specialize (ZL4 p); intros Hp; elim Hp; intros; exists (S x); intros; + simpl in |- *; specialize (nat_of_P_o_P_of_succ_nat_eq_succ x); + intro Hx0; rewrite <- H0 in Hx0; apply f_equal with (f := Zpos); + apply nat_of_P_inj; auto with arith + | absurd (0 <= Zneg p); + [ unfold Zle in |- *; simpl in |- *; do 2 unfold not in |- *; + auto with arith + | assumption ] ]. Qed. Lemma ZL4_inf : forall y:positive, {h : nat | nat_of_P y = S h}. -intro y; induction y as [p H| p H1| ]; - [ elim H; intros x H1; exists (S x + S x)%nat; unfold nat_of_P in |- *; - simpl in |- *; rewrite ZL0; rewrite Pmult_nat_r_plus_morphism; - unfold nat_of_P in H1; rewrite H1; auto with arith - | elim H1; intros x H2; exists (x + S x)%nat; unfold nat_of_P in |- *; - simpl in |- *; rewrite ZL0; rewrite Pmult_nat_r_plus_morphism; - unfold nat_of_P in H2; rewrite H2; auto with arith - | exists 0%nat; auto with arith ]. +Proof. + intro y; induction y as [p H| p H1| ]; + [ elim H; intros x H1; exists (S x + S x)%nat; unfold nat_of_P in |- *; + simpl in |- *; rewrite ZL0; rewrite Pmult_nat_r_plus_morphism; + unfold nat_of_P in H1; rewrite H1; auto with arith + | elim H1; intros x H2; exists (x + S x)%nat; unfold nat_of_P in |- *; + simpl in |- *; rewrite ZL0; rewrite Pmult_nat_r_plus_morphism; + unfold nat_of_P in H2; rewrite H2; auto with arith + | exists 0%nat; auto with arith ]. Qed. Lemma Z_of_nat_complete_inf : forall x:Z, 0 <= x -> {n : nat | x = Z_of_nat n}. -intro x; destruct x; intros; - [ exists 0%nat; auto with arith - | specialize (ZL4_inf p); intros Hp; elim Hp; intros x0 H0; exists (S x0); - intros; simpl in |- *; specialize (nat_of_P_o_P_of_succ_nat_eq_succ x0); - intro Hx0; rewrite <- H0 in Hx0; apply f_equal with (f := Zpos); - apply nat_of_P_inj; auto with arith - | absurd (0 <= Zneg p); - [ unfold Zle in |- *; simpl in |- *; do 2 unfold not in |- *; - auto with arith - | assumption ] ]. +Proof. + intro x; destruct x; intros; + [ exists 0%nat; auto with arith + | specialize (ZL4_inf p); intros Hp; elim Hp; intros x0 H0; exists (S x0); + intros; simpl in |- *; specialize (nat_of_P_o_P_of_succ_nat_eq_succ x0); + intro Hx0; rewrite <- H0 in Hx0; apply f_equal with (f := Zpos); + apply nat_of_P_inj; auto with arith + | absurd (0 <= Zneg p); + [ unfold Zle in |- *; simpl in |- *; do 2 unfold not in |- *; + auto with arith + | assumption ] ]. Qed. Lemma Z_of_nat_prop : - forall P:Z -> Prop, - (forall n:nat, P (Z_of_nat n)) -> forall x:Z, 0 <= x -> P x. -intros P H x H0. -specialize (Z_of_nat_complete x H0). -intros Hn; elim Hn; intros. -rewrite H1; apply H. + forall P:Z -> Prop, + (forall n:nat, P (Z_of_nat n)) -> forall x:Z, 0 <= x -> P x. +Proof. + intros P H x H0. + specialize (Z_of_nat_complete x H0). + intros Hn; elim Hn; intros. + rewrite H1; apply H. Qed. Lemma Z_of_nat_set : forall P:Z -> Set, (forall n:nat, P (Z_of_nat n)) -> forall x:Z, 0 <= x -> P x. -intros P H x H0. -specialize (Z_of_nat_complete_inf x H0). -intros Hn; elim Hn; intros. -rewrite p; apply H. +Proof. + intros P H x H0. + specialize (Z_of_nat_complete_inf x H0). + intros Hn; elim Hn; intros. + rewrite p; apply H. Qed. Lemma natlike_ind : forall P:Z -> Prop, P 0 -> (forall x:Z, 0 <= x -> P x -> P (Zsucc x)) -> forall x:Z, 0 <= x -> P x. -intros P H H0 x H1; apply Z_of_nat_prop; - [ simple induction n; - [ simpl in |- *; assumption - | intros; rewrite (inj_S n0); exact (H0 (Z_of_nat n0) (Zle_0_nat n0) H2) ] - | assumption ]. +Proof. + intros P H H0 x H1; apply Z_of_nat_prop; + [ simple induction n; + [ simpl in |- *; assumption + | intros; rewrite (inj_S n0); exact (H0 (Z_of_nat n0) (Zle_0_nat n0) H2) ] + | assumption ]. Qed. Lemma natlike_rec : forall P:Z -> Set, P 0 -> (forall x:Z, 0 <= x -> P x -> P (Zsucc x)) -> forall x:Z, 0 <= x -> P x. -intros P H H0 x H1; apply Z_of_nat_set; - [ simple induction n; - [ simpl in |- *; assumption - | intros; rewrite (inj_S n0); exact (H0 (Z_of_nat n0) (Zle_0_nat n0) H2) ] - | assumption ]. +Proof. + intros P H H0 x H1; apply Z_of_nat_set; + [ simple induction n; + [ simpl in |- *; assumption + | intros; rewrite (inj_S n0); exact (H0 (Z_of_nat n0) (Zle_0_nat n0) H2) ] + | assumption ]. Qed. Section Efficient_Rec. -(** [natlike_rec2] is the same as [natlike_rec], but with a different proof, designed - to give a better extracted term. *) + (** [natlike_rec2] is the same as [natlike_rec], but with a different proof, designed + to give a better extracted term. *) -Let R (a b:Z) := 0 <= a /\ a < b. + Let R (a b:Z) := 0 <= a /\ a < b. + + Let R_wf : well_founded R. + Proof. + set + (f := + fun z => + match z with + | Zpos p => nat_of_P p + | Z0 => 0%nat + | Zneg _ => 0%nat + end) in *. + apply well_founded_lt_compat with f. + unfold R, f in |- *; clear f R. + intros x y; case x; intros; elim H; clear H. + case y; intros; apply lt_O_nat_of_P || inversion H0. + case y; intros; apply nat_of_P_lt_Lt_compare_morphism || inversion H0; auto. + intros; elim H; auto. + Qed. -Let R_wf : well_founded R. -Proof. -set - (f := - fun z => - match z with - | Zpos p => nat_of_P p - | Z0 => 0%nat - | Zneg _ => 0%nat - end) in *. -apply well_founded_lt_compat with f. -unfold R, f in |- *; clear f R. -intros x y; case x; intros; elim H; clear H. -case y; intros; apply lt_O_nat_of_P || inversion H0. -case y; intros; apply nat_of_P_lt_Lt_compare_morphism || inversion H0; auto. -intros; elim H; auto. -Qed. + Lemma natlike_rec2 : + forall P:Z -> Type, + P 0 -> + (forall z:Z, 0 <= z -> P z -> P (Zsucc z)) -> forall z:Z, 0 <= z -> P z. + Proof. + intros P Ho Hrec z; pattern z in |- *; + apply (well_founded_induction_type R_wf). + intro x; case x. + trivial. + intros. + assert (0 <= Zpred (Zpos p)). + apply Zorder.Zlt_0_le_0_pred; unfold Zlt in |- *; simpl in |- *; trivial. + rewrite Zsucc_pred. + apply Hrec. + auto. + apply X; auto; unfold R in |- *; intuition; apply Zlt_pred. + intros; elim H; simpl in |- *; trivial. + Qed. -Lemma natlike_rec2 : - forall P:Z -> Type, - P 0 -> - (forall z:Z, 0 <= z -> P z -> P (Zsucc z)) -> forall z:Z, 0 <= z -> P z. -Proof. -intros P Ho Hrec z; pattern z in |- *; - apply (well_founded_induction_type R_wf). -intro x; case x. -trivial. -intros. -assert (0 <= Zpred (Zpos p)). -apply Zorder.Zlt_0_le_0_pred; unfold Zlt in |- *; simpl in |- *; trivial. -rewrite Zsucc_pred. -apply Hrec. -auto. -apply X; auto; unfold R in |- *; intuition; apply Zlt_pred. -intros; elim H; simpl in |- *; trivial. -Qed. + (** A variant of the previous using [Zpred] instead of [Zs]. *) -(** A variant of the previous using [Zpred] instead of [Zs]. *) + Lemma natlike_rec3 : + forall P:Z -> Type, + P 0 -> + (forall z:Z, 0 < z -> P (Zpred z) -> P z) -> forall z:Z, 0 <= z -> P z. + Proof. + intros P Ho Hrec z; pattern z in |- *; + apply (well_founded_induction_type R_wf). + intro x; case x. + trivial. + intros; apply Hrec. + unfold Zlt in |- *; trivial. + assert (0 <= Zpred (Zpos p)). + apply Zorder.Zlt_0_le_0_pred; unfold Zlt in |- *; simpl in |- *; trivial. + apply X; auto; unfold R in |- *; intuition; apply Zlt_pred. + intros; elim H; simpl in |- *; trivial. + Qed. -Lemma natlike_rec3 : - forall P:Z -> Type, - P 0 -> - (forall z:Z, 0 < z -> P (Zpred z) -> P z) -> forall z:Z, 0 <= z -> P z. -Proof. -intros P Ho Hrec z; pattern z in |- *; - apply (well_founded_induction_type R_wf). -intro x; case x. -trivial. -intros; apply Hrec. -unfold Zlt in |- *; trivial. -assert (0 <= Zpred (Zpos p)). -apply Zorder.Zlt_0_le_0_pred; unfold Zlt in |- *; simpl in |- *; trivial. -apply X; auto; unfold R in |- *; intuition; apply Zlt_pred. -intros; elim H; simpl in |- *; trivial. -Qed. + (** A more general induction principle on non-negative numbers using [Zlt]. *) -(** A more general induction principle on non-negative numbers using [Zlt]. *) + Lemma Zlt_0_rec : + forall P:Z -> Type, + (forall x:Z, (forall y:Z, 0 <= y < x -> P y) -> 0 <= x -> P x) -> + forall x:Z, 0 <= x -> P x. + Proof. + intros P Hrec z; pattern z in |- *; apply (well_founded_induction_type R_wf). + intro x; case x; intros. + apply Hrec; intros. + assert (H2 : 0 < 0). + apply Zle_lt_trans with y; intuition. + inversion H2. + assumption. + firstorder. + unfold Zle, Zcompare in H; elim H; auto. + Defined. -Lemma Zlt_0_rec : - forall P:Z -> Type, - (forall x:Z, (forall y:Z, 0 <= y < x -> P y) -> 0 <= x -> P x) -> - forall x:Z, 0 <= x -> P x. -Proof. -intros P Hrec z; pattern z in |- *; apply (well_founded_induction_type R_wf). -intro x; case x; intros. -apply Hrec; intros. -assert (H2 : 0 < 0). - apply Zle_lt_trans with y; intuition. -inversion H2. -assumption. -firstorder. -unfold Zle, Zcompare in H; elim H; auto. -Defined. + Lemma Zlt_0_ind : + forall P:Z -> Prop, + (forall x:Z, (forall y:Z, 0 <= y < x -> P y) -> 0 <= x -> P x) -> + forall x:Z, 0 <= x -> P x. + Proof. + exact Zlt_0_rec. + Qed. -Lemma Zlt_0_ind : - forall P:Z -> Prop, - (forall x:Z, (forall y:Z, 0 <= y < x -> P y) -> 0 <= x -> P x) -> - forall x:Z, 0 <= x -> P x. -Proof. -exact Zlt_0_rec. -Qed. + (** Obsolete version of [Zlt] induction principle on non-negative numbers *) -(** Obsolete version of [Zlt] induction principle on non-negative numbers *) + Lemma Z_lt_rec : + forall P:Z -> Type, + (forall x:Z, (forall y:Z, 0 <= y < x -> P y) -> P x) -> + forall x:Z, 0 <= x -> P x. + Proof. + intros P Hrec; apply Zlt_0_rec; auto. + Qed. -Lemma Z_lt_rec : - forall P:Z -> Type, - (forall x:Z, (forall y:Z, 0 <= y < x -> P y) -> P x) -> - forall x:Z, 0 <= x -> P x. -Proof. -intros P Hrec; apply Zlt_0_rec; auto. -Qed. + Lemma Z_lt_induction : + forall P:Z -> Prop, + (forall x:Z, (forall y:Z, 0 <= y < x -> P y) -> P x) -> + forall x:Z, 0 <= x -> P x. + Proof. + exact Z_lt_rec. + Qed. -Lemma Z_lt_induction : - forall P:Z -> Prop, - (forall x:Z, (forall y:Z, 0 <= y < x -> P y) -> P x) -> - forall x:Z, 0 <= x -> P x. -Proof. -exact Z_lt_rec. -Qed. + (** An even more general induction principle using [Zlt]. *) -(** An even more general induction principle using [Zlt]. *) + Lemma Zlt_lower_bound_rec : + forall P:Z -> Type, forall z:Z, + (forall x:Z, (forall y:Z, z <= y < x -> P y) -> z <= x -> P x) -> + forall x:Z, z <= x -> P x. + Proof. + intros P z Hrec x. + assert (Hexpand : forall x, x = x - z + z). + intro; unfold Zminus; rewrite <- Zplus_assoc; rewrite Zplus_opp_l; + rewrite Zplus_0_r; trivial. + intro Hz. + rewrite (Hexpand x); pattern (x - z) in |- *; apply Zlt_0_rec. + 2: apply Zplus_le_reg_r with z; rewrite <- Hexpand; assumption. + intros x0 Hlt_x0 H. + apply Hrec. + 2: change z with (0+z); apply Zplus_le_compat_r; assumption. + intro y; rewrite (Hexpand y); intros. + destruct H0. + apply Hlt_x0. + split. + apply Zplus_le_reg_r with z; assumption. + apply Zplus_lt_reg_r with z; assumption. + Qed. -Lemma Zlt_lower_bound_rec : - forall P:Z -> Type, forall z:Z, - (forall x:Z, (forall y:Z, z <= y < x -> P y) -> z <= x -> P x) -> - forall x:Z, z <= x -> P x. -Proof. -intros P z Hrec x. -assert (Hexpand : forall x, x = x - z + z). - intro; unfold Zminus; rewrite <- Zplus_assoc; rewrite Zplus_opp_l; - rewrite Zplus_0_r; trivial. -intro Hz. -rewrite (Hexpand x); pattern (x - z) in |- *; apply Zlt_0_rec. -2: apply Zplus_le_reg_r with z; rewrite <- Hexpand; assumption. -intros x0 Hlt_x0 H. -apply Hrec. - 2: change z with (0+z); apply Zplus_le_compat_r; assumption. - intro y; rewrite (Hexpand y); intros. -destruct H0. -apply Hlt_x0. -split. - apply Zplus_le_reg_r with z; assumption. - apply Zplus_lt_reg_r with z; assumption. -Qed. - -Lemma Zlt_lower_bound_ind : - forall P:Z -> Prop, forall z:Z, - (forall x:Z, (forall y:Z, z <= y < x -> P y) -> z <= x -> P x) -> - forall x:Z, z <= x -> P x. -Proof. -exact Zlt_lower_bound_rec. -Qed. + Lemma Zlt_lower_bound_ind : + forall P:Z -> Prop, forall z:Z, + (forall x:Z, (forall y:Z, z <= y < x -> P y) -> z <= x -> P x) -> + forall x:Z, z <= x -> P x. + Proof. + exact Zlt_lower_bound_rec. + Qed. End Efficient_Rec. diff --git a/theories/ZArith/ZArith.v b/theories/ZArith/ZArith.v index 45749fa3..66e0bda8 100644 --- a/theories/ZArith/ZArith.v +++ b/theories/ZArith/ZArith.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: ZArith.v 6013 2004-08-03 17:56:19Z herbelin $ i*) +(*i $Id: ZArith.v 9210 2006-10-05 10:12:15Z barras $ i*) (** Library for manipulating integers based on binary encoding *) @@ -19,3 +19,5 @@ Require Export Zsqrt. Require Export Zpower. Require Export Zdiv. Require Export Zlogarithm. + +Export ZArithRing. diff --git a/theories/ZArith/ZArith_dec.v b/theories/ZArith/ZArith_dec.v index 40c5860c..84249955 100644 --- a/theories/ZArith/ZArith_dec.v +++ b/theories/ZArith/ZArith_dec.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: ZArith_dec.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: ZArith_dec.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Sumbool. @@ -17,210 +17,210 @@ Open Local Scope Z_scope. Lemma Dcompare_inf : forall r:comparison, {r = Eq} + {r = Lt} + {r = Gt}. Proof. -simple induction r; auto with arith. + simple induction r; auto with arith. Defined. Lemma Zcompare_rec : - forall (P:Set) (n m:Z), - ((n ?= m) = Eq -> P) -> ((n ?= m) = Lt -> P) -> ((n ?= m) = Gt -> P) -> P. + forall (P:Set) (n m:Z), + ((n ?= m) = Eq -> P) -> ((n ?= m) = Lt -> P) -> ((n ?= m) = Gt -> P) -> P. Proof. -intros P x y H1 H2 H3. -elim (Dcompare_inf (x ?= y)). -intro H. elim H; auto with arith. auto with arith. + intros P x y H1 H2 H3. + elim (Dcompare_inf (x ?= y)). + intro H. elim H; auto with arith. auto with arith. Defined. Section decidability. -Variables x y : Z. - -(** Decidability of equality on binary integers *) - -Definition Z_eq_dec : {x = y} + {x <> y}. -Proof. -apply Zcompare_rec with (n := x) (m := y). -intro. left. elim (Zcompare_Eq_iff_eq x y); auto with arith. -intro H3. right. elim (Zcompare_Eq_iff_eq x y). intros H1 H2. unfold not in |- *. intro H4. - rewrite (H2 H4) in H3. discriminate H3. -intro H3. right. elim (Zcompare_Eq_iff_eq x y). intros H1 H2. unfold not in |- *. intro H4. - rewrite (H2 H4) in H3. discriminate H3. -Defined. - -(** Decidability of order on binary integers *) - -Definition Z_lt_dec : {x < y} + {~ x < y}. -Proof. -unfold Zlt in |- *. -apply Zcompare_rec with (n := x) (m := y); intro H. -right. rewrite H. discriminate. -left; assumption. -right. rewrite H. discriminate. -Defined. - -Definition Z_le_dec : {x <= y} + {~ x <= y}. -Proof. -unfold Zle in |- *. -apply Zcompare_rec with (n := x) (m := y); intro H. -left. rewrite H. discriminate. -left. rewrite H. discriminate. -right. tauto. -Defined. - -Definition Z_gt_dec : {x > y} + {~ x > y}. -Proof. -unfold Zgt in |- *. -apply Zcompare_rec with (n := x) (m := y); intro H. -right. rewrite H. discriminate. -right. rewrite H. discriminate. -left; assumption. -Defined. - -Definition Z_ge_dec : {x >= y} + {~ x >= y}. -Proof. -unfold Zge in |- *. -apply Zcompare_rec with (n := x) (m := y); intro H. -left. rewrite H. discriminate. -right. tauto. -left. rewrite H. discriminate. -Defined. - -Definition Z_lt_ge_dec : {x < y} + {x >= y}. -Proof. -exact Z_lt_dec. -Defined. - -Lemma Z_lt_le_dec : {x < y} + {y <= x}. -Proof. -intros. -elim Z_lt_ge_dec. -intros; left; assumption. -intros; right; apply Zge_le; assumption. -Qed. - -Definition Z_le_gt_dec : {x <= y} + {x > y}. -Proof. -elim Z_le_dec; auto with arith. -intro. right. apply Znot_le_gt; auto with arith. -Defined. - -Definition Z_gt_le_dec : {x > y} + {x <= y}. -Proof. -exact Z_gt_dec. -Defined. - -Definition Z_ge_lt_dec : {x >= y} + {x < y}. -Proof. -elim Z_ge_dec; auto with arith. -intro. right. apply Znot_ge_lt; auto with arith. -Defined. - -Definition Z_le_lt_eq_dec : x <= y -> {x < y} + {x = y}. -Proof. -intro H. -apply Zcompare_rec with (n := x) (m := y). -intro. right. elim (Zcompare_Eq_iff_eq x y); auto with arith. -intro. left. elim (Zcompare_Eq_iff_eq x y); auto with arith. -intro H1. absurd (x > y); auto with arith. -Defined. + Variables x y : Z. + + (** * Decidability of equality on binary integers *) + + Definition Z_eq_dec : {x = y} + {x <> y}. + Proof. + apply Zcompare_rec with (n := x) (m := y). + intro. left. elim (Zcompare_Eq_iff_eq x y); auto with arith. + intro H3. right. elim (Zcompare_Eq_iff_eq x y). intros H1 H2. unfold not in |- *. intro H4. + rewrite (H2 H4) in H3. discriminate H3. + intro H3. right. elim (Zcompare_Eq_iff_eq x y). intros H1 H2. unfold not in |- *. intro H4. + rewrite (H2 H4) in H3. discriminate H3. + Defined. + + (** * Decidability of order on binary integers *) + + Definition Z_lt_dec : {x < y} + {~ x < y}. + Proof. + unfold Zlt in |- *. + apply Zcompare_rec with (n := x) (m := y); intro H. + right. rewrite H. discriminate. + left; assumption. + right. rewrite H. discriminate. + Defined. + + Definition Z_le_dec : {x <= y} + {~ x <= y}. + Proof. + unfold Zle in |- *. + apply Zcompare_rec with (n := x) (m := y); intro H. + left. rewrite H. discriminate. + left. rewrite H. discriminate. + right. tauto. + Defined. + + Definition Z_gt_dec : {x > y} + {~ x > y}. + Proof. + unfold Zgt in |- *. + apply Zcompare_rec with (n := x) (m := y); intro H. + right. rewrite H. discriminate. + right. rewrite H. discriminate. + left; assumption. + Defined. + + Definition Z_ge_dec : {x >= y} + {~ x >= y}. + Proof. + unfold Zge in |- *. + apply Zcompare_rec with (n := x) (m := y); intro H. + left. rewrite H. discriminate. + right. tauto. + left. rewrite H. discriminate. + Defined. + + Definition Z_lt_ge_dec : {x < y} + {x >= y}. + Proof. + exact Z_lt_dec. + Defined. + + Lemma Z_lt_le_dec : {x < y} + {y <= x}. + Proof. + intros. + elim Z_lt_ge_dec. + intros; left; assumption. + intros; right; apply Zge_le; assumption. + Qed. + + Definition Z_le_gt_dec : {x <= y} + {x > y}. + Proof. + elim Z_le_dec; auto with arith. + intro. right. apply Znot_le_gt; auto with arith. + Defined. + + Definition Z_gt_le_dec : {x > y} + {x <= y}. + Proof. + exact Z_gt_dec. + Defined. + + Definition Z_ge_lt_dec : {x >= y} + {x < y}. + Proof. + elim Z_ge_dec; auto with arith. + intro. right. apply Znot_ge_lt; auto with arith. + Defined. + + Definition Z_le_lt_eq_dec : x <= y -> {x < y} + {x = y}. + Proof. + intro H. + apply Zcompare_rec with (n := x) (m := y). + intro. right. elim (Zcompare_Eq_iff_eq x y); auto with arith. + intro. left. elim (Zcompare_Eq_iff_eq x y); auto with arith. + intro H1. absurd (x > y); auto with arith. + Defined. End decidability. -(** Cotransitivity of order on binary integers *) +(** * Cotransitivity of order on binary integers *) Lemma Zlt_cotrans : forall n m:Z, n < m -> forall p:Z, {n < p} + {p < m}. Proof. - intros x y H z. - case (Z_lt_ge_dec x z). - intro. - left. - assumption. - intro. - right. - apply Zle_lt_trans with (m := x). - apply Zge_le. - assumption. - assumption. + intros x y H z. + case (Z_lt_ge_dec x z). + intro. + left. + assumption. + intro. + right. + apply Zle_lt_trans with (m := x). + apply Zge_le. + assumption. + assumption. Defined. Lemma Zlt_cotrans_pos : forall n m:Z, 0 < n + m -> {0 < n} + {0 < m}. Proof. - intros x y H. - case (Zlt_cotrans 0 (x + y) H x). - intro. - left. - assumption. - intro. - right. - apply Zplus_lt_reg_l with (p := x). - rewrite Zplus_0_r. - assumption. + intros x y H. + case (Zlt_cotrans 0 (x + y) H x). + intro. + left. + assumption. + intro. + right. + apply Zplus_lt_reg_l with (p := x). + rewrite Zplus_0_r. + assumption. Defined. Lemma Zlt_cotrans_neg : forall n m:Z, n + m < 0 -> {n < 0} + {m < 0}. Proof. - intros x y H; case (Zlt_cotrans (x + y) 0 H x); intro Hxy; - [ right; apply Zplus_lt_reg_l with (p := x); rewrite Zplus_0_r | left ]; - assumption. + intros x y H; case (Zlt_cotrans (x + y) 0 H x); intro Hxy; + [ right; apply Zplus_lt_reg_l with (p := x); rewrite Zplus_0_r | left ]; + assumption. Defined. Lemma not_Zeq_inf : forall n m:Z, n <> m -> {n < m} + {m < n}. Proof. - intros x y H. - case Z_lt_ge_dec with x y. - intro. - left. - assumption. - intro H0. - generalize (Zge_le _ _ H0). - intro. - case (Z_le_lt_eq_dec _ _ H1). - intro. - right. - assumption. - intro. - apply False_rec. - apply H. - symmetry in |- *. - assumption. + intros x y H. + case Z_lt_ge_dec with x y. + intro. + left. + assumption. + intro H0. + generalize (Zge_le _ _ H0). + intro. + case (Z_le_lt_eq_dec _ _ H1). + intro. + right. + assumption. + intro. + apply False_rec. + apply H. + symmetry in |- *. + assumption. Defined. Lemma Z_dec : forall n m:Z, {n < m} + {n > m} + {n = m}. Proof. - intros x y. - case (Z_lt_ge_dec x y). - intro H. - left. - left. - assumption. - intro H. - generalize (Zge_le _ _ H). - intro H0. - case (Z_le_lt_eq_dec y x H0). - intro H1. - left. - right. - apply Zlt_gt. - assumption. - intro. - right. - symmetry in |- *. - assumption. + intros x y. + case (Z_lt_ge_dec x y). + intro H. + left. + left. + assumption. + intro H. + generalize (Zge_le _ _ H). + intro H0. + case (Z_le_lt_eq_dec y x H0). + intro H1. + left. + right. + apply Zlt_gt. + assumption. + intro. + right. + symmetry in |- *. + assumption. Defined. Lemma Z_dec' : forall n m:Z, {n < m} + {m < n} + {n = m}. Proof. - intros x y. - case (Z_eq_dec x y); intro H; - [ right; assumption | left; apply (not_Zeq_inf _ _ H) ]. + intros x y. + case (Z_eq_dec x y); intro H; + [ right; assumption | left; apply (not_Zeq_inf _ _ H) ]. Defined. Definition Z_zerop : forall x:Z, {x = 0} + {x <> 0}. Proof. -exact (fun x:Z => Z_eq_dec x 0). + exact (fun x:Z => Z_eq_dec x 0). Defined. Definition Z_notzerop (x:Z) := sumbool_not _ _ (Z_zerop x). -Definition Z_noteq_dec (x y:Z) := sumbool_not _ _ (Z_eq_dec x y).
\ No newline at end of file +Definition Z_noteq_dec (x y:Z) := sumbool_not _ _ (Z_eq_dec x y). diff --git a/theories/ZArith/Zabs.v b/theories/ZArith/Zabs.v index fed6ad76..ed641358 100644 --- a/theories/ZArith/Zabs.v +++ b/theories/ZArith/Zabs.v @@ -5,11 +5,11 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Zabs.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Zabs.v 9302 2006-10-27 21:21:17Z barras $ i*) (** Binary Integers (Pierre Crégut (CNET, Lannion, France) *) -Require Import Arith. +Require Import Arith_base. Require Import BinPos. Require Import BinInt. Require Import Zorder. @@ -18,111 +18,113 @@ Require Import ZArith_dec. Open Local Scope Z_scope. (**********************************************************************) -(** Properties of absolute value *) +(** * Properties of absolute value *) Lemma Zabs_eq : forall n:Z, 0 <= n -> Zabs n = n. -intro x; destruct x; auto with arith. -compute in |- *; intros; absurd (Gt = Gt); trivial with arith. +Proof. + intro x; destruct x; auto with arith. + compute in |- *; intros; absurd (Gt = Gt); trivial with arith. Qed. Lemma Zabs_non_eq : forall n:Z, n <= 0 -> Zabs n = - n. Proof. -intro x; destruct x; auto with arith. -compute in |- *; intros; absurd (Gt = Gt); trivial with arith. + intro x; destruct x; auto with arith. + compute in |- *; intros; absurd (Gt = Gt); trivial with arith. Qed. Theorem Zabs_Zopp : forall n:Z, Zabs (- n) = Zabs n. Proof. -intros z; case z; simpl in |- *; auto. + intros z; case z; simpl in |- *; auto. Qed. -(** Proving a property of the absolute value by cases *) +(** * Proving a property of the absolute value by cases *) Lemma Zabs_ind : - forall (P:Z -> Prop) (n:Z), - (n >= 0 -> P n) -> (n <= 0 -> P (- n)) -> P (Zabs n). + forall (P:Z -> Prop) (n:Z), + (n >= 0 -> P n) -> (n <= 0 -> P (- n)) -> P (Zabs n). Proof. -intros P x H H0; elim (Z_lt_ge_dec x 0); intro. -assert (x <= 0). apply Zlt_le_weak; assumption. -rewrite Zabs_non_eq. apply H0. assumption. assumption. -rewrite Zabs_eq. apply H; assumption. apply Zge_le. assumption. + intros P x H H0; elim (Z_lt_ge_dec x 0); intro. + assert (x <= 0). apply Zlt_le_weak; assumption. + rewrite Zabs_non_eq. apply H0. assumption. assumption. + rewrite Zabs_eq. apply H; assumption. apply Zge_le. assumption. Qed. Theorem Zabs_intro : forall P (n:Z), P (- n) -> P n -> P (Zabs n). -intros P z; case z; simpl in |- *; auto. +Proof. + intros P z; case z; simpl in |- *; auto. Qed. Definition Zabs_dec : forall x:Z, {x = Zabs x} + {x = - Zabs x}. Proof. -intro x; destruct x; auto with arith. + intro x; destruct x; auto with arith. Defined. Lemma Zabs_pos : forall n:Z, 0 <= Zabs n. -intro x; destruct x; auto with arith; compute in |- *; intros H; inversion H. + intro x; destruct x; auto with arith; compute in |- *; intros H; inversion H. Qed. Theorem Zabs_eq_case : forall n m:Z, Zabs n = Zabs m -> n = m \/ n = - m. Proof. -intros z1 z2; case z1; case z2; simpl in |- *; auto; - try (intros; discriminate); intros p1 p2 H1; injection H1; - (intros H2; rewrite H2); auto. + intros z1 z2; case z1; case z2; simpl in |- *; auto; + try (intros; discriminate); intros p1 p2 H1; injection H1; + (intros H2; rewrite H2); auto. Qed. -(** Triangular inequality *) +(** * Triangular inequality *) Hint Local Resolve Zle_neg_pos: zarith. Theorem Zabs_triangle : forall n m:Z, Zabs (n + m) <= Zabs n + Zabs m. Proof. -intros z1 z2; case z1; case z2; try (simpl in |- *; auto with zarith; fail). -intros p1 p2; - apply Zabs_intro with (P := fun x => x <= Zabs (Zpos p2) + Zabs (Zneg p1)); - try rewrite Zopp_plus_distr; auto with zarith. -apply Zplus_le_compat; simpl in |- *; auto with zarith. -apply Zplus_le_compat; simpl in |- *; auto with zarith. -intros p1 p2; - apply Zabs_intro with (P := fun x => x <= Zabs (Zpos p2) + Zabs (Zneg p1)); - try rewrite Zopp_plus_distr; auto with zarith. -apply Zplus_le_compat; simpl in |- *; auto with zarith. -apply Zplus_le_compat; simpl in |- *; auto with zarith. + intros z1 z2; case z1; case z2; try (simpl in |- *; auto with zarith; fail). + intros p1 p2; + apply Zabs_intro with (P := fun x => x <= Zabs (Zpos p2) + Zabs (Zneg p1)); + try rewrite Zopp_plus_distr; auto with zarith. + apply Zplus_le_compat; simpl in |- *; auto with zarith. + apply Zplus_le_compat; simpl in |- *; auto with zarith. + intros p1 p2; + apply Zabs_intro with (P := fun x => x <= Zabs (Zpos p2) + Zabs (Zneg p1)); + try rewrite Zopp_plus_distr; auto with zarith. + apply Zplus_le_compat; simpl in |- *; auto with zarith. + apply Zplus_le_compat; simpl in |- *; auto with zarith. Qed. -(** Absolute value and multiplication *) +(** * Absolute value and multiplication *) Lemma Zsgn_Zabs : forall n:Z, n * Zsgn n = Zabs n. Proof. -intro x; destruct x; rewrite Zmult_comm; auto with arith. + intro x; destruct x; rewrite Zmult_comm; auto with arith. Qed. Lemma Zabs_Zsgn : forall n:Z, Zabs n * Zsgn n = n. Proof. -intro x; destruct x; rewrite Zmult_comm; auto with arith. + intro x; destruct x; rewrite Zmult_comm; auto with arith. Qed. Theorem Zabs_Zmult : forall n m:Z, Zabs (n * m) = Zabs n * Zabs m. Proof. -intros z1 z2; case z1; case z2; simpl in |- *; auto. + intros z1 z2; case z1; case z2; simpl in |- *; auto. Qed. -(** absolute value in nat is compatible with order *) +(** * Absolute value in nat is compatible with order *) Lemma Zabs_nat_lt : - forall n m:Z, 0 <= n /\ n < m -> (Zabs_nat n < Zabs_nat m)%nat. + forall n m:Z, 0 <= n /\ n < m -> (Zabs_nat n < Zabs_nat m)%nat. Proof. -intros x y. case x; simpl in |- *. case y; simpl in |- *. - -intro. absurd (0 < 0). compute in |- *. intro H0. discriminate H0. intuition. -intros. elim (ZL4 p). intros. rewrite H0. auto with arith. -intros. elim (ZL4 p). intros. rewrite H0. auto with arith. - -case y; simpl in |- *. -intros. absurd (Zpos p < 0). compute in |- *. intro H0. discriminate H0. intuition. -intros. change (nat_of_P p > nat_of_P p0)%nat in |- *. -apply nat_of_P_gt_Gt_compare_morphism. -elim H; auto with arith. intro. exact (ZC2 p0 p). - -intros. absurd (Zpos p0 < Zneg p). -compute in |- *. intro H0. discriminate H0. intuition. - -intros. absurd (0 <= Zneg p). compute in |- *. auto with arith. intuition. -Qed.
\ No newline at end of file + intros x y. case x; simpl in |- *. case y; simpl in |- *. + + intro. absurd (0 < 0). compute in |- *. intro H0. discriminate H0. intuition. + intros. elim (ZL4 p). intros. rewrite H0. auto with arith. + intros. elim (ZL4 p). intros. rewrite H0. auto with arith. + + case y; simpl in |- *. + intros. absurd (Zpos p < 0). compute in |- *. intro H0. discriminate H0. intuition. + intros. change (nat_of_P p > nat_of_P p0)%nat in |- *. + apply nat_of_P_gt_Gt_compare_morphism. + elim H; auto with arith. intro. exact (ZC2 p0 p). + + intros. absurd (Zpos p0 < Zneg p). + compute in |- *. intro H0. discriminate H0. intuition. + + intros. absurd (0 <= Zneg p). compute in |- *. auto with arith. intuition. +Qed. diff --git a/theories/ZArith/Zbinary.v b/theories/ZArith/Zbinary.v index 353f0d5d..08f08e12 100644 --- a/theories/ZArith/Zbinary.v +++ b/theories/ZArith/Zbinary.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Zbinary.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Zbinary.v 9245 2006-10-17 12:53:34Z notin $ i*) (** Bit vectors interpreted as integers. Contribution by Jean Duprat (ENS Lyon). *) @@ -16,11 +16,10 @@ Require Import ZArith. Require Export Zpower. Require Import Omega. -(* -L'évaluation des vecteurs de booléens se font à la fois en binaire et -en complément à deux. Le nombre appartient à Z. -On utilise donc Omega pour faire les calculs dans Z. -De plus, on utilise les fonctions 2^n où n est un naturel, ici la longueur. +(** L'évaluation des vecteurs de booléens se font à la fois en binaire et + en complément à deux. Le nombre appartient à Z. + On utilise donc Omega pour faire les calculs dans Z. + De plus, on utilise les fonctions 2^n où n est un naturel, ici la longueur. two_power_nat = [n:nat](POS (shift_nat n xH)) : nat->Z two_power_nat_S @@ -32,395 +31,322 @@ De plus, on utilise les fonctions 2^n où n est un naturel, ici la longueur. Section VALUE_OF_BOOLEAN_VECTORS. -(* -Les calculs sont effectués dans la convention positive usuelle. -Les valeurs correspondent soit à l'écriture binaire (nat), -soit au complément à deux (int). -On effectue le calcul suivant le schéma de Horner. -Le complément à deux n'a de sens que sur les vecteurs de taille -supérieure ou égale à un, le bit de signe étant évalué négativement. +(** Les calculs sont effectués dans la convention positive usuelle. + Les valeurs correspondent soit à l'écriture binaire (nat), + soit au complément à deux (int). + On effectue le calcul suivant le schéma de Horner. + Le complément à deux n'a de sens que sur les vecteurs de taille + supérieure ou égale à un, le bit de signe étant évalué négativement. *) -Definition bit_value (b:bool) : Z := - match b with - | true => 1%Z - | false => 0%Z - end. - -Lemma binary_value : forall n:nat, Bvector n -> Z. -Proof. - simple induction n; intros. - exact 0%Z. - - inversion H0. - exact (bit_value a + 2 * H H2)%Z. -Defined. - -Lemma two_compl_value : forall n:nat, Bvector (S n) -> Z. -Proof. - simple induction n; intros. - inversion H. - exact (- bit_value a)%Z. - - inversion H0. - exact (bit_value a + 2 * H H2)%Z. -Defined. - -(* -Coq < Eval Compute in (binary_value (3) (Bcons true (2) (Bcons false (1) (Bcons true (0) Bnil)))). - = `5` - : Z -*) - -(* -Coq < Eval Compute in (two_compl_value (3) (Bcons true (3) (Bcons false (2) (Bcons true (1) (Bcons true (0) Bnil))))). - = `-3` - : Z -*) + Definition bit_value (b:bool) : Z := + match b with + | true => 1%Z + | false => 0%Z + end. + + Lemma binary_value : forall n:nat, Bvector n -> Z. + Proof. + simple induction n; intros. + exact 0%Z. + + inversion H0. + exact (bit_value a + 2 * H H2)%Z. + Defined. + + Lemma two_compl_value : forall n:nat, Bvector (S n) -> Z. + Proof. + simple induction n; intros. + inversion H. + exact (- bit_value a)%Z. + + inversion H0. + exact (bit_value a + 2 * H H2)%Z. + Defined. End VALUE_OF_BOOLEAN_VECTORS. Section ENCODING_VALUE. -(* -On calcule la valeur binaire selon un schema de Horner. -Le calcul s'arrete à la longueur du vecteur sans vérification. -On definit une fonction Zmod2 calquee sur Zdiv2 mais donnant le quotient -de la division z=2q+r avec 0<=r<=1. -La valeur en complément à deux est calculée selon un schema de Horner -avec Zmod2, le paramètre est la taille moins un. -*) - -Definition Zmod2 (z:Z) := - match z with - | Z0 => 0%Z - | Zpos p => match p with - | xI q => Zpos q - | xO q => Zpos q - | xH => 0%Z - end - | Zneg p => - match p with - | xI q => (Zneg q - 1)%Z - | xO q => Zneg q - | xH => (-1)%Z - end - end. - - -Lemma Zmod2_twice : - forall z:Z, z = (2 * Zmod2 z + bit_value (Zeven.Zodd_bool z))%Z. -Proof. - destruct z; simpl in |- *. - trivial. - - destruct p; simpl in |- *; trivial. - - destruct p; simpl in |- *. - destruct p as [p| p| ]; simpl in |- *. - rewrite <- (Pdouble_minus_one_o_succ_eq_xI p); trivial. - - trivial. - - trivial. - - trivial. - - trivial. -Qed. - -Lemma Z_to_binary : forall n:nat, Z -> Bvector n. -Proof. - simple induction n; intros. - exact Bnil. - - exact (Bcons (Zeven.Zodd_bool H0) n0 (H (Zeven.Zdiv2 H0))). -Defined. - -(* -Eval Compute in (Z_to_binary (5) `5`). - = (Vcons bool true (4) - (Vcons bool false (3) - (Vcons bool true (2) - (Vcons bool false (1) (Vcons bool false (0) (Vnil bool)))))) - : (Bvector (5)) +(** On calcule la valeur binaire selon un schema de Horner. + Le calcul s'arrete à la longueur du vecteur sans vérification. + On definit une fonction Zmod2 calquee sur Zdiv2 mais donnant le quotient + de la division z=2q+r avec 0<=r<=1. + La valeur en complément à deux est calculée selon un schema de Horner + avec Zmod2, le paramètre est la taille moins un. *) -Lemma Z_to_two_compl : forall n:nat, Z -> Bvector (S n). -Proof. - simple induction n; intros. - exact (Bcons (Zeven.Zodd_bool H) 0 Bnil). - - exact (Bcons (Zeven.Zodd_bool H0) (S n0) (H (Zmod2 H0))). -Defined. - -(* -Eval Compute in (Z_to_two_compl (3) `0`). - = (Vcons bool false (3) - (Vcons bool false (2) - (Vcons bool false (1) (Vcons bool false (0) (Vnil bool))))) - : (vector bool (4)) - -Eval Compute in (Z_to_two_compl (3) `5`). - = (Vcons bool true (3) - (Vcons bool false (2) - (Vcons bool true (1) (Vcons bool false (0) (Vnil bool))))) - : (vector bool (4)) - -Eval Compute in (Z_to_two_compl (3) `-5`). - = (Vcons bool true (3) - (Vcons bool true (2) - (Vcons bool false (1) (Vcons bool true (0) (Vnil bool))))) - : (vector bool (4)) -*) + Definition Zmod2 (z:Z) := + match z with + | Z0 => 0%Z + | Zpos p => match p with + | xI q => Zpos q + | xO q => Zpos q + | xH => 0%Z + end + | Zneg p => + match p with + | xI q => (Zneg q - 1)%Z + | xO q => Zneg q + | xH => (-1)%Z + end + end. + + + Lemma Zmod2_twice : + forall z:Z, z = (2 * Zmod2 z + bit_value (Zeven.Zodd_bool z))%Z. + Proof. + destruct z; simpl in |- *. + trivial. + + destruct p; simpl in |- *; trivial. + + destruct p; simpl in |- *. + destruct p as [p| p| ]; simpl in |- *. + rewrite <- (Pdouble_minus_one_o_succ_eq_xI p); trivial. + + trivial. + + trivial. + + trivial. + + trivial. + Qed. + + Lemma Z_to_binary : forall n:nat, Z -> Bvector n. + Proof. + simple induction n; intros. + exact Bnil. + + exact (Bcons (Zeven.Zodd_bool H0) n0 (H (Zeven.Zdiv2 H0))). + Defined. + + Lemma Z_to_two_compl : forall n:nat, Z -> Bvector (S n). + Proof. + simple induction n; intros. + exact (Bcons (Zeven.Zodd_bool H) 0 Bnil). + + exact (Bcons (Zeven.Zodd_bool H0) (S n0) (H (Zmod2 H0))). + Defined. End ENCODING_VALUE. Section Z_BRIC_A_BRAC. -(* -Bibliotheque de lemmes utiles dans la section suivante. -Utilise largement ZArith. -Meriterait d'etre reecrite. -*) - -Lemma binary_value_Sn : - forall (n:nat) (b:bool) (bv:Bvector n), - binary_value (S n) (Vcons bool b n bv) = - (bit_value b + 2 * binary_value n bv)%Z. -Proof. - intros; auto. -Qed. - -Lemma Z_to_binary_Sn : - forall (n:nat) (b:bool) (z:Z), - (z >= 0)%Z -> - Z_to_binary (S n) (bit_value b + 2 * z) = Bcons b n (Z_to_binary n z). -Proof. - destruct b; destruct z; simpl in |- *; auto. - intro H; elim H; trivial. -Qed. - -Lemma binary_value_pos : - forall (n:nat) (bv:Bvector n), (binary_value n bv >= 0)%Z. -Proof. - induction bv as [| a n v IHbv]; simpl in |- *. - omega. - - destruct a; destruct (binary_value n v); simpl in |- *; auto. - auto with zarith. -Qed. - - -Lemma two_compl_value_Sn : - forall (n:nat) (bv:Bvector (S n)) (b:bool), - two_compl_value (S n) (Bcons b (S n) bv) = - (bit_value b + 2 * two_compl_value n bv)%Z. -Proof. - intros; auto. -Qed. - -Lemma Z_to_two_compl_Sn : - forall (n:nat) (b:bool) (z:Z), - Z_to_two_compl (S n) (bit_value b + 2 * z) = - Bcons b (S n) (Z_to_two_compl n z). -Proof. - destruct b; destruct z as [| p| p]; auto. - destruct p as [p| p| ]; auto. - destruct p as [p| p| ]; simpl in |- *; auto. - intros; rewrite (Psucc_o_double_minus_one_eq_xO p); trivial. -Qed. - -Lemma Z_to_binary_Sn_z : - forall (n:nat) (z:Z), - Z_to_binary (S n) z = - Bcons (Zeven.Zodd_bool z) n (Z_to_binary n (Zeven.Zdiv2 z)). -Proof. - intros; auto. -Qed. - -Lemma Z_div2_value : - forall z:Z, - (z >= 0)%Z -> (bit_value (Zeven.Zodd_bool z) + 2 * Zeven.Zdiv2 z)%Z = z. -Proof. - destruct z as [| p| p]; auto. - destruct p; auto. - intro H; elim H; trivial. -Qed. - -Lemma Pdiv2 : forall z:Z, (z >= 0)%Z -> (Zeven.Zdiv2 z >= 0)%Z. -Proof. - destruct z as [| p| p]. - auto. - - destruct p; auto. - simpl in |- *; intros; omega. - - intro H; elim H; trivial. - -Qed. - -Lemma Zdiv2_two_power_nat : - forall (z:Z) (n:nat), - (z >= 0)%Z -> - (z < two_power_nat (S n))%Z -> (Zeven.Zdiv2 z < two_power_nat n)%Z. -Proof. - intros. - cut (2 * Zeven.Zdiv2 z < 2 * two_power_nat n)%Z; intros. - omega. - - rewrite <- two_power_nat_S. - destruct (Zeven.Zeven_odd_dec z); intros. - rewrite <- Zeven.Zeven_div2; auto. - - generalize (Zeven.Zodd_div2 z H z0); omega. -Qed. - -(* - -Lemma Z_minus_one_or_zero : (z:Z) - `z >= -1` -> - `z < 1` -> - {`z=-1`} + {`z=0`}. -Proof. - NewDestruct z; Auto. - NewDestruct p; Auto. - Tauto. - - Tauto. - - Intros. - Right; Omega. - - NewDestruct p. - Tauto. - - Tauto. - - Intros; Left; Omega. -Save. -*) - -Lemma Z_to_two_compl_Sn_z : - forall (n:nat) (z:Z), - Z_to_two_compl (S n) z = - Bcons (Zeven.Zodd_bool z) (S n) (Z_to_two_compl n (Zmod2 z)). -Proof. - intros; auto. -Qed. - -Lemma Zeven_bit_value : - forall z:Z, Zeven.Zeven z -> bit_value (Zeven.Zodd_bool z) = 0%Z. -Proof. - destruct z; unfold bit_value in |- *; auto. - destruct p; tauto || (intro H; elim H). - destruct p; tauto || (intro H; elim H). -Qed. - -Lemma Zodd_bit_value : - forall z:Z, Zeven.Zodd z -> bit_value (Zeven.Zodd_bool z) = 1%Z. -Proof. - destruct z; unfold bit_value in |- *; auto. - intros; elim H. - destruct p; tauto || (intros; elim H). - destruct p; tauto || (intros; elim H). -Qed. - -Lemma Zge_minus_two_power_nat_S : - forall (n:nat) (z:Z), - (z >= - two_power_nat (S n))%Z -> (Zmod2 z >= - two_power_nat n)%Z. -Proof. - intros n z; rewrite (two_power_nat_S n). - generalize (Zmod2_twice z). - destruct (Zeven.Zeven_odd_dec z) as [H| H]. - rewrite (Zeven_bit_value z H); intros; omega. - - rewrite (Zodd_bit_value z H); intros; omega. -Qed. - -Lemma Zlt_two_power_nat_S : - forall (n:nat) (z:Z), - (z < two_power_nat (S n))%Z -> (Zmod2 z < two_power_nat n)%Z. -Proof. - intros n z; rewrite (two_power_nat_S n). - generalize (Zmod2_twice z). - destruct (Zeven.Zeven_odd_dec z) as [H| H]. - rewrite (Zeven_bit_value z H); intros; omega. - - rewrite (Zodd_bit_value z H); intros; omega. -Qed. + (** Bibliotheque de lemmes utiles dans la section suivante. + Utilise largement ZArith. + Mériterait d'être récrite. + *) + + Lemma binary_value_Sn : + forall (n:nat) (b:bool) (bv:Bvector n), + binary_value (S n) (Vcons bool b n bv) = + (bit_value b + 2 * binary_value n bv)%Z. + Proof. + intros; auto. + Qed. + + Lemma Z_to_binary_Sn : + forall (n:nat) (b:bool) (z:Z), + (z >= 0)%Z -> + Z_to_binary (S n) (bit_value b + 2 * z) = Bcons b n (Z_to_binary n z). + Proof. + destruct b; destruct z; simpl in |- *; auto. + intro H; elim H; trivial. + Qed. + + Lemma binary_value_pos : + forall (n:nat) (bv:Bvector n), (binary_value n bv >= 0)%Z. + Proof. + induction bv as [| a n v IHbv]; simpl in |- *. + omega. + + destruct a; destruct (binary_value n v); simpl in |- *; auto. + auto with zarith. + Qed. + + Lemma two_compl_value_Sn : + forall (n:nat) (bv:Bvector (S n)) (b:bool), + two_compl_value (S n) (Bcons b (S n) bv) = + (bit_value b + 2 * two_compl_value n bv)%Z. + Proof. + intros; auto. + Qed. + + Lemma Z_to_two_compl_Sn : + forall (n:nat) (b:bool) (z:Z), + Z_to_two_compl (S n) (bit_value b + 2 * z) = + Bcons b (S n) (Z_to_two_compl n z). + Proof. + destruct b; destruct z as [| p| p]; auto. + destruct p as [p| p| ]; auto. + destruct p as [p| p| ]; simpl in |- *; auto. + intros; rewrite (Psucc_o_double_minus_one_eq_xO p); trivial. + Qed. + + Lemma Z_to_binary_Sn_z : + forall (n:nat) (z:Z), + Z_to_binary (S n) z = + Bcons (Zeven.Zodd_bool z) n (Z_to_binary n (Zeven.Zdiv2 z)). + Proof. + intros; auto. + Qed. + + Lemma Z_div2_value : + forall z:Z, + (z >= 0)%Z -> (bit_value (Zeven.Zodd_bool z) + 2 * Zeven.Zdiv2 z)%Z = z. + Proof. + destruct z as [| p| p]; auto. + destruct p; auto. + intro H; elim H; trivial. + Qed. + + Lemma Pdiv2 : forall z:Z, (z >= 0)%Z -> (Zeven.Zdiv2 z >= 0)%Z. + Proof. + destruct z as [| p| p]. + auto. + + destruct p; auto. + simpl in |- *; intros; omega. + + intro H; elim H; trivial. + Qed. + + Lemma Zdiv2_two_power_nat : + forall (z:Z) (n:nat), + (z >= 0)%Z -> + (z < two_power_nat (S n))%Z -> (Zeven.Zdiv2 z < two_power_nat n)%Z. + Proof. + intros. + cut (2 * Zeven.Zdiv2 z < 2 * two_power_nat n)%Z; intros. + omega. + + rewrite <- two_power_nat_S. + destruct (Zeven.Zeven_odd_dec z); intros. + rewrite <- Zeven.Zeven_div2; auto. + + generalize (Zeven.Zodd_div2 z H z0); omega. + Qed. + + Lemma Z_to_two_compl_Sn_z : + forall (n:nat) (z:Z), + Z_to_two_compl (S n) z = + Bcons (Zeven.Zodd_bool z) (S n) (Z_to_two_compl n (Zmod2 z)). + Proof. + intros; auto. + Qed. + + Lemma Zeven_bit_value : + forall z:Z, Zeven.Zeven z -> bit_value (Zeven.Zodd_bool z) = 0%Z. + Proof. + destruct z; unfold bit_value in |- *; auto. + destruct p; tauto || (intro H; elim H). + destruct p; tauto || (intro H; elim H). + Qed. + + Lemma Zodd_bit_value : + forall z:Z, Zeven.Zodd z -> bit_value (Zeven.Zodd_bool z) = 1%Z. + Proof. + destruct z; unfold bit_value in |- *; auto. + intros; elim H. + destruct p; tauto || (intros; elim H). + destruct p; tauto || (intros; elim H). + Qed. + + Lemma Zge_minus_two_power_nat_S : + forall (n:nat) (z:Z), + (z >= - two_power_nat (S n))%Z -> (Zmod2 z >= - two_power_nat n)%Z. + Proof. + intros n z; rewrite (two_power_nat_S n). + generalize (Zmod2_twice z). + destruct (Zeven.Zeven_odd_dec z) as [H| H]. + rewrite (Zeven_bit_value z H); intros; omega. + + rewrite (Zodd_bit_value z H); intros; omega. + Qed. + + Lemma Zlt_two_power_nat_S : + forall (n:nat) (z:Z), + (z < two_power_nat (S n))%Z -> (Zmod2 z < two_power_nat n)%Z. + Proof. + intros n z; rewrite (two_power_nat_S n). + generalize (Zmod2_twice z). + destruct (Zeven.Zeven_odd_dec z) as [H| H]. + rewrite (Zeven_bit_value z H); intros; omega. + + rewrite (Zodd_bit_value z H); intros; omega. + Qed. End Z_BRIC_A_BRAC. Section COHERENT_VALUE. -(* -On vérifie que dans l'intervalle de définition les fonctions sont -réciproques l'une de l'autre. -Elles utilisent les lemmes du bric-a-brac. +(** On vérifie que dans l'intervalle de définition les fonctions sont + réciproques l'une de l'autre. Elles utilisent les lemmes du bric-a-brac. *) -Lemma binary_to_Z_to_binary : - forall (n:nat) (bv:Bvector n), Z_to_binary n (binary_value n bv) = bv. -Proof. - induction bv as [| a n bv IHbv]. - auto. - - rewrite binary_value_Sn. - rewrite Z_to_binary_Sn. - rewrite IHbv; trivial. - - apply binary_value_pos. -Qed. - -Lemma two_compl_to_Z_to_two_compl : - forall (n:nat) (bv:Bvector n) (b:bool), - Z_to_two_compl n (two_compl_value n (Bcons b n bv)) = Bcons b n bv. -Proof. - induction bv as [| a n bv IHbv]; intro b. - destruct b; auto. - - rewrite two_compl_value_Sn. - rewrite Z_to_two_compl_Sn. - rewrite IHbv; trivial. -Qed. - -Lemma Z_to_binary_to_Z : - forall (n:nat) (z:Z), - (z >= 0)%Z -> - (z < two_power_nat n)%Z -> binary_value n (Z_to_binary n z) = z. -Proof. - induction n as [| n IHn]. - unfold two_power_nat, shift_nat in |- *; simpl in |- *; intros; omega. - - intros; rewrite Z_to_binary_Sn_z. - rewrite binary_value_Sn. - rewrite IHn. - apply Z_div2_value; auto. - - apply Pdiv2; trivial. - - apply Zdiv2_two_power_nat; trivial. -Qed. - -Lemma Z_to_two_compl_to_Z : - forall (n:nat) (z:Z), - (z >= - two_power_nat n)%Z -> - (z < two_power_nat n)%Z -> two_compl_value n (Z_to_two_compl n z) = z. -Proof. - induction n as [| n IHn]. - unfold two_power_nat, shift_nat in |- *; simpl in |- *; intros. - assert (z = (-1)%Z \/ z = 0%Z). omega. -intuition; subst z; trivial. - - intros; rewrite Z_to_two_compl_Sn_z. - rewrite two_compl_value_Sn. - rewrite IHn. - generalize (Zmod2_twice z); omega. - - apply Zge_minus_two_power_nat_S; auto. - - apply Zlt_two_power_nat_S; auto. -Qed. + Lemma binary_to_Z_to_binary : + forall (n:nat) (bv:Bvector n), Z_to_binary n (binary_value n bv) = bv. + Proof. + induction bv as [| a n bv IHbv]. + auto. + + rewrite binary_value_Sn. + rewrite Z_to_binary_Sn. + rewrite IHbv; trivial. + + apply binary_value_pos. + Qed. + + Lemma two_compl_to_Z_to_two_compl : + forall (n:nat) (bv:Bvector n) (b:bool), + Z_to_two_compl n (two_compl_value n (Bcons b n bv)) = Bcons b n bv. + Proof. + induction bv as [| a n bv IHbv]; intro b. + destruct b; auto. + + rewrite two_compl_value_Sn. + rewrite Z_to_two_compl_Sn. + rewrite IHbv; trivial. + Qed. + + Lemma Z_to_binary_to_Z : + forall (n:nat) (z:Z), + (z >= 0)%Z -> + (z < two_power_nat n)%Z -> binary_value n (Z_to_binary n z) = z. + Proof. + induction n as [| n IHn]. + unfold two_power_nat, shift_nat in |- *; simpl in |- *; intros; omega. + + intros; rewrite Z_to_binary_Sn_z. + rewrite binary_value_Sn. + rewrite IHn. + apply Z_div2_value; auto. + + apply Pdiv2; trivial. + + apply Zdiv2_two_power_nat; trivial. + Qed. + + Lemma Z_to_two_compl_to_Z : + forall (n:nat) (z:Z), + (z >= - two_power_nat n)%Z -> + (z < two_power_nat n)%Z -> two_compl_value n (Z_to_two_compl n z) = z. + Proof. + induction n as [| n IHn]. + unfold two_power_nat, shift_nat in |- *; simpl in |- *; intros. + assert (z = (-1)%Z \/ z = 0%Z). omega. + intuition; subst z; trivial. + + intros; rewrite Z_to_two_compl_Sn_z. + rewrite two_compl_value_Sn. + rewrite IHn. + generalize (Zmod2_twice z); omega. + + apply Zge_minus_two_power_nat_S; auto. + + apply Zlt_two_power_nat_S; auto. + Qed. End COHERENT_VALUE. diff --git a/theories/ZArith/Zbool.v b/theories/ZArith/Zbool.v index a195b951..7da91c44 100644 --- a/theories/ZArith/Zbool.v +++ b/theories/ZArith/Zbool.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: Zbool.v 6295 2004-11-12 16:40:39Z gregoire $ *) +(* $Id: Zbool.v 9245 2006-10-17 12:53:34Z notin $ *) Require Import BinInt. Require Import Zeven. @@ -17,6 +17,8 @@ Require Import Sumbool. Unset Boxed Definitions. + +(** * Boolean operations from decidabilty of order *) (** The decidability of equality and order relations over type [Z] give some boolean functions with the adequate specification. *) @@ -32,65 +34,70 @@ Definition Z_noteq_bool (x y:Z) := bool_of_sumbool (Z_noteq_dec x y). Definition Zeven_odd_bool (x:Z) := bool_of_sumbool (Zeven_odd_dec x). (**********************************************************************) -(** Boolean comparisons of binary integers *) +(** * Boolean comparisons of binary integers *) Definition Zle_bool (x y:Z) := match (x ?= y)%Z with - | Gt => false - | _ => true + | Gt => false + | _ => true end. + Definition Zge_bool (x y:Z) := match (x ?= y)%Z with - | Lt => false - | _ => true + | Lt => false + | _ => true end. + Definition Zlt_bool (x y:Z) := match (x ?= y)%Z with - | Lt => true - | _ => false + | Lt => true + | _ => false end. + Definition Zgt_bool (x y:Z) := match (x ?= y)%Z with - | Gt => true - | _ => false + | Gt => true + | _ => false end. + Definition Zeq_bool (x y:Z) := match (x ?= y)%Z with - | Eq => true - | _ => false + | Eq => true + | _ => false end. + Definition Zneq_bool (x y:Z) := match (x ?= y)%Z with - | Eq => false - | _ => true + | Eq => false + | _ => true end. Lemma Zle_cases : - forall n m:Z, if Zle_bool n m then (n <= m)%Z else (n > m)%Z. + forall n m:Z, if Zle_bool n m then (n <= m)%Z else (n > m)%Z. Proof. -intros x y; unfold Zle_bool, Zle, Zgt in |- *. -case (x ?= y)%Z; auto; discriminate. + intros x y; unfold Zle_bool, Zle, Zgt in |- *. + case (x ?= y)%Z; auto; discriminate. Qed. Lemma Zlt_cases : - forall n m:Z, if Zlt_bool n m then (n < m)%Z else (n >= m)%Z. + forall n m:Z, if Zlt_bool n m then (n < m)%Z else (n >= m)%Z. Proof. -intros x y; unfold Zlt_bool, Zlt, Zge in |- *. -case (x ?= y)%Z; auto; discriminate. + intros x y; unfold Zlt_bool, Zlt, Zge in |- *. + case (x ?= y)%Z; auto; discriminate. Qed. Lemma Zge_cases : - forall n m:Z, if Zge_bool n m then (n >= m)%Z else (n < m)%Z. + forall n m:Z, if Zge_bool n m then (n >= m)%Z else (n < m)%Z. Proof. -intros x y; unfold Zge_bool, Zge, Zlt in |- *. -case (x ?= y)%Z; auto; discriminate. + intros x y; unfold Zge_bool, Zge, Zlt in |- *. + case (x ?= y)%Z; auto; discriminate. Qed. Lemma Zgt_cases : - forall n m:Z, if Zgt_bool n m then (n > m)%Z else (n <= m)%Z. + forall n m:Z, if Zgt_bool n m then (n > m)%Z else (n <= m)%Z. Proof. -intros x y; unfold Zgt_bool, Zgt, Zle in |- *. -case (x ?= y)%Z; auto; discriminate. + intros x y; unfold Zgt_bool, Zgt, Zle in |- *. + case (x ?= y)%Z; auto; discriminate. Qed. (** Lemmas on [Zle_bool] used in contrib/graphs *) @@ -112,15 +119,15 @@ Proof. Qed. Lemma Zle_bool_antisym : - forall n m:Z, Zle_bool n m = true -> Zle_bool m n = true -> n = m. + forall n m:Z, Zle_bool n m = true -> Zle_bool m n = true -> n = m. Proof. intros. apply Zle_antisym. apply Zle_bool_imp_le. assumption. apply Zle_bool_imp_le. assumption. Qed. Lemma Zle_bool_trans : - forall n m p:Z, - Zle_bool n m = true -> Zle_bool m p = true -> Zle_bool n p = true. + forall n m p:Z, + Zle_bool n m = true -> Zle_bool m p = true -> Zle_bool n p = true. Proof. intros x y z; intros. apply Zle_imp_le_bool. apply Zle_trans with (m := y). apply Zle_bool_imp_le. assumption. apply Zle_bool_imp_le. assumption. @@ -137,9 +144,9 @@ Proof. Defined. Lemma Zle_bool_plus_mono : - forall n m p q:Z, - Zle_bool n m = true -> - Zle_bool p q = true -> Zle_bool (n + p) (m + q) = true. + forall n m p q:Z, + Zle_bool n m = true -> + Zle_bool p q = true -> Zle_bool (n + p) (m + q) = true. Proof. intros. apply Zle_imp_le_bool. apply Zplus_le_compat. apply Zle_bool_imp_le. assumption. apply Zle_bool_imp_le. assumption. @@ -159,30 +166,30 @@ Proof. Qed. - Lemma Zle_is_le_bool : forall n m:Z, (n <= m)%Z <-> Zle_bool n m = true. - Proof. - intros. split. intro. apply Zle_imp_le_bool. assumption. - intro. apply Zle_bool_imp_le. assumption. - Qed. - - Lemma Zge_is_le_bool : forall n m:Z, (n >= m)%Z <-> Zle_bool m n = true. - Proof. - intros. split. intro. apply Zle_imp_le_bool. apply Zge_le. assumption. - intro. apply Zle_ge. apply Zle_bool_imp_le. assumption. - Qed. - - Lemma Zlt_is_le_bool : - forall n m:Z, (n < m)%Z <-> Zle_bool n (m - 1) = true. - Proof. - intros x y. split. intro. apply Zle_imp_le_bool. apply Zlt_succ_le. rewrite (Zsucc_pred y) in H. - assumption. - intro. rewrite (Zsucc_pred y). apply Zle_lt_succ. apply Zle_bool_imp_le. assumption. - Qed. - - Lemma Zgt_is_le_bool : - forall n m:Z, (n > m)%Z <-> Zle_bool m (n - 1) = true. - Proof. - intros x y. apply iff_trans with (y < x)%Z. split. exact (Zgt_lt x y). - exact (Zlt_gt y x). - exact (Zlt_is_le_bool y x). - Qed. +Lemma Zle_is_le_bool : forall n m:Z, (n <= m)%Z <-> Zle_bool n m = true. +Proof. + intros. split. intro. apply Zle_imp_le_bool. assumption. + intro. apply Zle_bool_imp_le. assumption. +Qed. + +Lemma Zge_is_le_bool : forall n m:Z, (n >= m)%Z <-> Zle_bool m n = true. +Proof. + intros. split. intro. apply Zle_imp_le_bool. apply Zge_le. assumption. + intro. apply Zle_ge. apply Zle_bool_imp_le. assumption. +Qed. + +Lemma Zlt_is_le_bool : + forall n m:Z, (n < m)%Z <-> Zle_bool n (m - 1) = true. +Proof. + intros x y. split. intro. apply Zle_imp_le_bool. apply Zlt_succ_le. rewrite (Zsucc_pred y) in H. + assumption. + intro. rewrite (Zsucc_pred y). apply Zle_lt_succ. apply Zle_bool_imp_le. assumption. +Qed. + +Lemma Zgt_is_le_bool : + forall n m:Z, (n > m)%Z <-> Zle_bool m (n - 1) = true. +Proof. + intros x y. apply iff_trans with (y < x)%Z. split. exact (Zgt_lt x y). + exact (Zlt_gt y x). + exact (Zlt_is_le_bool y x). +Qed. diff --git a/theories/ZArith/Zcompare.v b/theories/ZArith/Zcompare.v index 4003c338..6c5b07d2 100644 --- a/theories/ZArith/Zcompare.v +++ b/theories/ZArith/Zcompare.v @@ -8,6 +8,10 @@ (*i $$ i*) +(**********************************************************************) +(** Binary Integers (Pierre Crégut, CNET, Lannion, France) *) +(**********************************************************************) + Require Export BinPos. Require Export BinInt. Require Import Lt. @@ -17,485 +21,480 @@ Require Import Mult. Open Local Scope Z_scope. -(**********************************************************************) -(** Binary Integers (Pierre Crégut, CNET, Lannion, France) *) -(**********************************************************************) - -(**********************************************************************) -(** Comparison on integers *) +(***************************) +(** * Comparison on integers *) Lemma Zcompare_refl : forall n:Z, (n ?= n) = Eq. Proof. -intro x; destruct x as [| p| p]; simpl in |- *; - [ reflexivity | apply Pcompare_refl | rewrite Pcompare_refl; reflexivity ]. + intro x; destruct x as [| p| p]; simpl in |- *; + [ reflexivity | apply Pcompare_refl | rewrite Pcompare_refl; reflexivity ]. Qed. Lemma Zcompare_Eq_eq : forall n m:Z, (n ?= m) = Eq -> n = m. Proof. -intros x y; destruct x as [| x'| x']; destruct y as [| y'| y']; simpl in |- *; - intro H; reflexivity || (try discriminate H); - [ rewrite (Pcompare_Eq_eq x' y' H); reflexivity - | rewrite (Pcompare_Eq_eq x' y'); - [ reflexivity - | destruct ((x' ?= y')%positive Eq); reflexivity || discriminate ] ]. + intros x y; destruct x as [| x'| x']; destruct y as [| y'| y']; simpl in |- *; + intro H; reflexivity || (try discriminate H); + [ rewrite (Pcompare_Eq_eq x' y' H); reflexivity + | rewrite (Pcompare_Eq_eq x' y'); + [ reflexivity + | destruct ((x' ?= y')%positive Eq); reflexivity || discriminate ] ]. Qed. Lemma Zcompare_Eq_iff_eq : forall n m:Z, (n ?= m) = Eq <-> n = m. Proof. -intros x y; split; intro E; - [ apply Zcompare_Eq_eq; assumption | rewrite E; apply Zcompare_refl ]. + intros x y; split; intro E; + [ apply Zcompare_Eq_eq; assumption | rewrite E; apply Zcompare_refl ]. Qed. Lemma Zcompare_antisym : forall n m:Z, CompOpp (n ?= m) = (m ?= n). Proof. -intros x y; destruct x; destruct y; simpl in |- *; - reflexivity || discriminate H || rewrite Pcompare_antisym; - reflexivity. + intros x y; destruct x; destruct y; simpl in |- *; + reflexivity || discriminate H || rewrite Pcompare_antisym; + reflexivity. Qed. Lemma Zcompare_Gt_Lt_antisym : forall n m:Z, (n ?= m) = Gt <-> (m ?= n) = Lt. Proof. -intros x y; split; intro H; - [ change Lt with (CompOpp Gt) in |- *; rewrite <- Zcompare_antisym; - rewrite H; reflexivity - | change Gt with (CompOpp Lt) in |- *; rewrite <- Zcompare_antisym; - rewrite H; reflexivity ]. + intros x y; split; intro H; + [ change Lt with (CompOpp Gt) in |- *; rewrite <- Zcompare_antisym; + rewrite H; reflexivity + | change Gt with (CompOpp Lt) in |- *; rewrite <- Zcompare_antisym; + rewrite H; reflexivity ]. Qed. -(** Transitivity of comparison *) +(** * Transitivity of comparison *) Lemma Zcompare_Gt_trans : - forall n m p:Z, (n ?= m) = Gt -> (m ?= p) = Gt -> (n ?= p) = Gt. + forall n m p:Z, (n ?= m) = Gt -> (m ?= p) = Gt -> (n ?= p) = Gt. Proof. -intros x y z; case x; case y; case z; simpl in |- *; - try (intros; discriminate H || discriminate H0); auto with arith; - [ intros p q r H H0; apply nat_of_P_gt_Gt_compare_complement_morphism; - unfold gt in |- *; apply lt_trans with (m := nat_of_P q); - apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; - assumption - | intros p q r; do 3 rewrite <- ZC4; intros H H0; - apply nat_of_P_gt_Gt_compare_complement_morphism; - unfold gt in |- *; apply lt_trans with (m := nat_of_P q); - apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; - assumption ]. + intros x y z; case x; case y; case z; simpl in |- *; + try (intros; discriminate H || discriminate H0); auto with arith; + [ intros p q r H H0; apply nat_of_P_gt_Gt_compare_complement_morphism; + unfold gt in |- *; apply lt_trans with (m := nat_of_P q); + apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; + assumption + | intros p q r; do 3 rewrite <- ZC4; intros H H0; + apply nat_of_P_gt_Gt_compare_complement_morphism; + unfold gt in |- *; apply lt_trans with (m := nat_of_P q); + apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; + assumption ]. Qed. -(** Comparison and opposite *) +(** * Comparison and opposite *) Lemma Zcompare_opp : forall n m:Z, (n ?= m) = (- m ?= - n). Proof. -intros x y; case x; case y; simpl in |- *; auto with arith; intros; - rewrite <- ZC4; trivial with arith. + intros x y; case x; case y; simpl in |- *; auto with arith; intros; + rewrite <- ZC4; trivial with arith. Qed. Hint Local Resolve Pcompare_refl. -(** Comparison first-order specification *) +(** * Comparison first-order specification *) Lemma Zcompare_Gt_spec : - forall n m:Z, (n ?= m) = Gt -> exists h : positive, n + - m = Zpos h. + forall n m:Z, (n ?= m) = Gt -> exists h : positive, n + - m = Zpos h. Proof. -intros x y; case x; case y; - [ simpl in |- *; intros H; discriminate H - | simpl in |- *; intros p H; discriminate H - | intros p H; exists p; simpl in |- *; auto with arith - | intros p H; exists p; simpl in |- *; auto with arith - | intros q p H; exists (p - q)%positive; unfold Zplus, Zopp in |- *; - unfold Zcompare in H; rewrite H; trivial with arith - | intros q p H; exists (p + q)%positive; simpl in |- *; trivial with arith - | simpl in |- *; intros p H; discriminate H - | simpl in |- *; intros q p H; discriminate H - | unfold Zcompare in |- *; intros q p; rewrite <- ZC4; intros H; - exists (q - p)%positive; simpl in |- *; rewrite (ZC1 q p H); - trivial with arith ]. + intros x y; case x; case y; + [ simpl in |- *; intros H; discriminate H + | simpl in |- *; intros p H; discriminate H + | intros p H; exists p; simpl in |- *; auto with arith + | intros p H; exists p; simpl in |- *; auto with arith + | intros q p H; exists (p - q)%positive; unfold Zplus, Zopp in |- *; + unfold Zcompare in H; rewrite H; trivial with arith + | intros q p H; exists (p + q)%positive; simpl in |- *; trivial with arith + | simpl in |- *; intros p H; discriminate H + | simpl in |- *; intros q p H; discriminate H + | unfold Zcompare in |- *; intros q p; rewrite <- ZC4; intros H; + exists (q - p)%positive; simpl in |- *; rewrite (ZC1 q p H); + trivial with arith ]. Qed. -(** Comparison and addition *) +(** * Comparison and addition *) Lemma weaken_Zcompare_Zplus_compatible : - (forall (n m:Z) (p:positive), (Zpos p + n ?= Zpos p + m) = (n ?= m)) -> - forall n m p:Z, (p + n ?= p + m) = (n ?= m). + (forall (n m:Z) (p:positive), (Zpos p + n ?= Zpos p + m) = (n ?= m)) -> + forall n m p:Z, (p + n ?= p + m) = (n ?= m). Proof. -intros H x y z; destruct z; - [ reflexivity - | apply H - | rewrite (Zcompare_opp x y); rewrite Zcompare_opp; - do 2 rewrite Zopp_plus_distr; rewrite Zopp_neg; - apply H ]. + intros H x y z; destruct z; + [ reflexivity + | apply H + | rewrite (Zcompare_opp x y); rewrite Zcompare_opp; + do 2 rewrite Zopp_plus_distr; rewrite Zopp_neg; + apply H ]. Qed. Hint Local Resolve ZC4. Lemma weak_Zcompare_Zplus_compatible : - forall (n m:Z) (p:positive), (Zpos p + n ?= Zpos p + m) = (n ?= m). + forall (n m:Z) (p:positive), (Zpos p + n ?= Zpos p + m) = (n ?= m). Proof. -intros x y z; case x; case y; simpl in |- *; auto with arith; - [ intros p; apply nat_of_P_lt_Lt_compare_complement_morphism; apply ZL17 - | intros p; ElimPcompare z p; intros E; rewrite E; auto with arith; - apply nat_of_P_gt_Gt_compare_complement_morphism; - rewrite nat_of_P_minus_morphism; - [ unfold gt in |- *; apply ZL16 | assumption ] - | intros p; ElimPcompare z p; intros E; auto with arith; - apply nat_of_P_gt_Gt_compare_complement_morphism; - unfold gt in |- *; apply ZL17 - | intros p q; ElimPcompare q p; intros E; rewrite E; - [ rewrite (Pcompare_Eq_eq q p E); apply Pcompare_refl - | apply nat_of_P_lt_Lt_compare_complement_morphism; - do 2 rewrite nat_of_P_plus_morphism; apply plus_lt_compat_l; - apply nat_of_P_lt_Lt_compare_morphism with (1 := E) - | apply nat_of_P_gt_Gt_compare_complement_morphism; unfold gt in |- *; - do 2 rewrite nat_of_P_plus_morphism; apply plus_lt_compat_l; - exact (nat_of_P_gt_Gt_compare_morphism q p E) ] - | intros p q; ElimPcompare z p; intros E; rewrite E; auto with arith; - apply nat_of_P_gt_Gt_compare_complement_morphism; - rewrite nat_of_P_minus_morphism; - [ unfold gt in |- *; apply lt_trans with (m := nat_of_P z); - [ apply ZL16 | apply ZL17 ] - | assumption ] - | intros p; ElimPcompare z p; intros E; rewrite E; auto with arith; - simpl in |- *; apply nat_of_P_lt_Lt_compare_complement_morphism; - rewrite nat_of_P_minus_morphism; [ apply ZL16 | assumption ] - | intros p q; ElimPcompare z q; intros E; rewrite E; auto with arith; - simpl in |- *; apply nat_of_P_lt_Lt_compare_complement_morphism; - rewrite nat_of_P_minus_morphism; - [ apply lt_trans with (m := nat_of_P z); [ apply ZL16 | apply ZL17 ] - | assumption ] - | intros p q; ElimPcompare z q; intros E0; rewrite E0; ElimPcompare z p; - intros E1; rewrite E1; ElimPcompare q p; intros E2; - rewrite E2; auto with arith; - [ absurd ((q ?= p)%positive Eq = Lt); - [ rewrite <- (Pcompare_Eq_eq z q E0); - rewrite <- (Pcompare_Eq_eq z p E1); rewrite (Pcompare_refl z); - discriminate - | assumption ] - | absurd ((q ?= p)%positive Eq = Gt); - [ rewrite <- (Pcompare_Eq_eq z q E0); - rewrite <- (Pcompare_Eq_eq z p E1); rewrite (Pcompare_refl z); - discriminate - | assumption ] - | absurd ((z ?= p)%positive Eq = Lt); - [ rewrite (Pcompare_Eq_eq z q E0); rewrite <- (Pcompare_Eq_eq q p E2); - rewrite (Pcompare_refl q); discriminate - | assumption ] - | absurd ((z ?= p)%positive Eq = Lt); - [ rewrite (Pcompare_Eq_eq z q E0); rewrite E2; discriminate - | assumption ] - | absurd ((z ?= p)%positive Eq = Gt); - [ rewrite (Pcompare_Eq_eq z q E0); rewrite <- (Pcompare_Eq_eq q p E2); - rewrite (Pcompare_refl q); discriminate - | assumption ] - | absurd ((z ?= p)%positive Eq = Gt); - [ rewrite (Pcompare_Eq_eq z q E0); rewrite E2; discriminate - | assumption ] - | absurd ((z ?= q)%positive Eq = Lt); - [ rewrite (Pcompare_Eq_eq z p E1); rewrite (Pcompare_Eq_eq q p E2); - rewrite (Pcompare_refl p); discriminate - | assumption ] - | absurd ((p ?= q)%positive Eq = Gt); - [ rewrite <- (Pcompare_Eq_eq z p E1); rewrite E0; discriminate - | apply ZC2; assumption ] - | simpl in |- *; rewrite (Pcompare_Eq_eq q p E2); - rewrite (Pcompare_refl (p - z)); auto with arith - | simpl in |- *; rewrite <- ZC4; - apply nat_of_P_gt_Gt_compare_complement_morphism; - rewrite nat_of_P_minus_morphism; - [ rewrite nat_of_P_minus_morphism; - [ unfold gt in |- *; apply plus_lt_reg_l with (p := nat_of_P z); - rewrite le_plus_minus_r; - [ rewrite le_plus_minus_r; - [ apply nat_of_P_lt_Lt_compare_morphism; assumption - | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; - assumption ] - | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; - assumption ] - | apply ZC2; assumption ] - | apply ZC2; assumption ] - | simpl in |- *; rewrite <- ZC4; - apply nat_of_P_lt_Lt_compare_complement_morphism; - rewrite nat_of_P_minus_morphism; - [ rewrite nat_of_P_minus_morphism; - [ apply plus_lt_reg_l with (p := nat_of_P z); - rewrite le_plus_minus_r; - [ rewrite le_plus_minus_r; - [ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; - assumption - | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; - assumption ] - | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; - assumption ] - | apply ZC2; assumption ] - | apply ZC2; assumption ] - | absurd ((z ?= q)%positive Eq = Lt); - [ rewrite (Pcompare_Eq_eq q p E2); rewrite E1; discriminate - | assumption ] - | absurd ((q ?= p)%positive Eq = Lt); - [ cut ((q ?= p)%positive Eq = Gt); - [ intros E; rewrite E; discriminate - | apply nat_of_P_gt_Gt_compare_complement_morphism; - unfold gt in |- *; apply lt_trans with (m := nat_of_P z); - [ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; assumption - | apply nat_of_P_lt_Lt_compare_morphism; assumption ] ] - | assumption ] - | absurd ((z ?= q)%positive Eq = Gt); - [ rewrite (Pcompare_Eq_eq z p E1); rewrite (Pcompare_Eq_eq q p E2); - rewrite (Pcompare_refl p); discriminate - | assumption ] - | absurd ((z ?= q)%positive Eq = Gt); - [ rewrite (Pcompare_Eq_eq z p E1); rewrite ZC1; - [ discriminate | assumption ] - | assumption ] - | absurd ((z ?= q)%positive Eq = Gt); - [ rewrite (Pcompare_Eq_eq q p E2); rewrite E1; discriminate - | assumption ] - | absurd ((q ?= p)%positive Eq = Gt); - [ rewrite ZC1; - [ discriminate - | apply nat_of_P_gt_Gt_compare_complement_morphism; - unfold gt in |- *; apply lt_trans with (m := nat_of_P z); - [ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; assumption - | apply nat_of_P_lt_Lt_compare_morphism; assumption ] ] - | assumption ] - | simpl in |- *; rewrite (Pcompare_Eq_eq q p E2); apply Pcompare_refl - | simpl in |- *; apply nat_of_P_gt_Gt_compare_complement_morphism; - unfold gt in |- *; rewrite nat_of_P_minus_morphism; - [ rewrite nat_of_P_minus_morphism; - [ apply plus_lt_reg_l with (p := nat_of_P p); - rewrite le_plus_minus_r; - [ rewrite plus_comm; apply plus_lt_reg_l with (p := nat_of_P q); - rewrite plus_assoc; rewrite le_plus_minus_r; - [ rewrite (plus_comm (nat_of_P q)); apply plus_lt_compat_l; - apply nat_of_P_lt_Lt_compare_morphism; - assumption - | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; - apply ZC1; assumption ] - | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; - apply ZC1; assumption ] - | assumption ] - | assumption ] - | simpl in |- *; apply nat_of_P_lt_Lt_compare_complement_morphism; - rewrite nat_of_P_minus_morphism; - [ rewrite nat_of_P_minus_morphism; - [ apply plus_lt_reg_l with (p := nat_of_P q); - rewrite le_plus_minus_r; - [ rewrite plus_comm; apply plus_lt_reg_l with (p := nat_of_P p); - rewrite plus_assoc; rewrite le_plus_minus_r; - [ rewrite (plus_comm (nat_of_P p)); apply plus_lt_compat_l; - apply nat_of_P_lt_Lt_compare_morphism; - apply ZC1; assumption - | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; - apply ZC1; assumption ] - | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; - apply ZC1; assumption ] - | assumption ] - | assumption ] ] ]. + intros x y z; case x; case y; simpl in |- *; auto with arith; + [ intros p; apply nat_of_P_lt_Lt_compare_complement_morphism; apply ZL17 + | intros p; ElimPcompare z p; intros E; rewrite E; auto with arith; + apply nat_of_P_gt_Gt_compare_complement_morphism; + rewrite nat_of_P_minus_morphism; + [ unfold gt in |- *; apply ZL16 | assumption ] + | intros p; ElimPcompare z p; intros E; auto with arith; + apply nat_of_P_gt_Gt_compare_complement_morphism; + unfold gt in |- *; apply ZL17 + | intros p q; ElimPcompare q p; intros E; rewrite E; + [ rewrite (Pcompare_Eq_eq q p E); apply Pcompare_refl + | apply nat_of_P_lt_Lt_compare_complement_morphism; + do 2 rewrite nat_of_P_plus_morphism; apply plus_lt_compat_l; + apply nat_of_P_lt_Lt_compare_morphism with (1 := E) + | apply nat_of_P_gt_Gt_compare_complement_morphism; unfold gt in |- *; + do 2 rewrite nat_of_P_plus_morphism; apply plus_lt_compat_l; + exact (nat_of_P_gt_Gt_compare_morphism q p E) ] + | intros p q; ElimPcompare z p; intros E; rewrite E; auto with arith; + apply nat_of_P_gt_Gt_compare_complement_morphism; + rewrite nat_of_P_minus_morphism; + [ unfold gt in |- *; apply lt_trans with (m := nat_of_P z); + [ apply ZL16 | apply ZL17 ] + | assumption ] + | intros p; ElimPcompare z p; intros E; rewrite E; auto with arith; + simpl in |- *; apply nat_of_P_lt_Lt_compare_complement_morphism; + rewrite nat_of_P_minus_morphism; [ apply ZL16 | assumption ] + | intros p q; ElimPcompare z q; intros E; rewrite E; auto with arith; + simpl in |- *; apply nat_of_P_lt_Lt_compare_complement_morphism; + rewrite nat_of_P_minus_morphism; + [ apply lt_trans with (m := nat_of_P z); [ apply ZL16 | apply ZL17 ] + | assumption ] + | intros p q; ElimPcompare z q; intros E0; rewrite E0; ElimPcompare z p; + intros E1; rewrite E1; ElimPcompare q p; intros E2; + rewrite E2; auto with arith; + [ absurd ((q ?= p)%positive Eq = Lt); + [ rewrite <- (Pcompare_Eq_eq z q E0); + rewrite <- (Pcompare_Eq_eq z p E1); rewrite (Pcompare_refl z); + discriminate + | assumption ] + | absurd ((q ?= p)%positive Eq = Gt); + [ rewrite <- (Pcompare_Eq_eq z q E0); + rewrite <- (Pcompare_Eq_eq z p E1); rewrite (Pcompare_refl z); + discriminate + | assumption ] + | absurd ((z ?= p)%positive Eq = Lt); + [ rewrite (Pcompare_Eq_eq z q E0); rewrite <- (Pcompare_Eq_eq q p E2); + rewrite (Pcompare_refl q); discriminate + | assumption ] + | absurd ((z ?= p)%positive Eq = Lt); + [ rewrite (Pcompare_Eq_eq z q E0); rewrite E2; discriminate + | assumption ] + | absurd ((z ?= p)%positive Eq = Gt); + [ rewrite (Pcompare_Eq_eq z q E0); rewrite <- (Pcompare_Eq_eq q p E2); + rewrite (Pcompare_refl q); discriminate + | assumption ] + | absurd ((z ?= p)%positive Eq = Gt); + [ rewrite (Pcompare_Eq_eq z q E0); rewrite E2; discriminate + | assumption ] + | absurd ((z ?= q)%positive Eq = Lt); + [ rewrite (Pcompare_Eq_eq z p E1); rewrite (Pcompare_Eq_eq q p E2); + rewrite (Pcompare_refl p); discriminate + | assumption ] + | absurd ((p ?= q)%positive Eq = Gt); + [ rewrite <- (Pcompare_Eq_eq z p E1); rewrite E0; discriminate + | apply ZC2; assumption ] + | simpl in |- *; rewrite (Pcompare_Eq_eq q p E2); + rewrite (Pcompare_refl (p - z)); auto with arith + | simpl in |- *; rewrite <- ZC4; + apply nat_of_P_gt_Gt_compare_complement_morphism; + rewrite nat_of_P_minus_morphism; + [ rewrite nat_of_P_minus_morphism; + [ unfold gt in |- *; apply plus_lt_reg_l with (p := nat_of_P z); + rewrite le_plus_minus_r; + [ rewrite le_plus_minus_r; + [ apply nat_of_P_lt_Lt_compare_morphism; assumption + | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; + assumption ] + | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; + assumption ] + | apply ZC2; assumption ] + | apply ZC2; assumption ] + | simpl in |- *; rewrite <- ZC4; + apply nat_of_P_lt_Lt_compare_complement_morphism; + rewrite nat_of_P_minus_morphism; + [ rewrite nat_of_P_minus_morphism; + [ apply plus_lt_reg_l with (p := nat_of_P z); + rewrite le_plus_minus_r; + [ rewrite le_plus_minus_r; + [ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; + assumption + | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; + assumption ] + | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; + assumption ] + | apply ZC2; assumption ] + | apply ZC2; assumption ] + | absurd ((z ?= q)%positive Eq = Lt); + [ rewrite (Pcompare_Eq_eq q p E2); rewrite E1; discriminate + | assumption ] + | absurd ((q ?= p)%positive Eq = Lt); + [ cut ((q ?= p)%positive Eq = Gt); + [ intros E; rewrite E; discriminate + | apply nat_of_P_gt_Gt_compare_complement_morphism; + unfold gt in |- *; apply lt_trans with (m := nat_of_P z); + [ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; assumption + | apply nat_of_P_lt_Lt_compare_morphism; assumption ] ] + | assumption ] + | absurd ((z ?= q)%positive Eq = Gt); + [ rewrite (Pcompare_Eq_eq z p E1); rewrite (Pcompare_Eq_eq q p E2); + rewrite (Pcompare_refl p); discriminate + | assumption ] + | absurd ((z ?= q)%positive Eq = Gt); + [ rewrite (Pcompare_Eq_eq z p E1); rewrite ZC1; + [ discriminate | assumption ] + | assumption ] + | absurd ((z ?= q)%positive Eq = Gt); + [ rewrite (Pcompare_Eq_eq q p E2); rewrite E1; discriminate + | assumption ] + | absurd ((q ?= p)%positive Eq = Gt); + [ rewrite ZC1; + [ discriminate + | apply nat_of_P_gt_Gt_compare_complement_morphism; + unfold gt in |- *; apply lt_trans with (m := nat_of_P z); + [ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; assumption + | apply nat_of_P_lt_Lt_compare_morphism; assumption ] ] + | assumption ] + | simpl in |- *; rewrite (Pcompare_Eq_eq q p E2); apply Pcompare_refl + | simpl in |- *; apply nat_of_P_gt_Gt_compare_complement_morphism; + unfold gt in |- *; rewrite nat_of_P_minus_morphism; + [ rewrite nat_of_P_minus_morphism; + [ apply plus_lt_reg_l with (p := nat_of_P p); + rewrite le_plus_minus_r; + [ rewrite plus_comm; apply plus_lt_reg_l with (p := nat_of_P q); + rewrite plus_assoc; rewrite le_plus_minus_r; + [ rewrite (plus_comm (nat_of_P q)); apply plus_lt_compat_l; + apply nat_of_P_lt_Lt_compare_morphism; + assumption + | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; + apply ZC1; assumption ] + | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; + apply ZC1; assumption ] + | assumption ] + | assumption ] + | simpl in |- *; apply nat_of_P_lt_Lt_compare_complement_morphism; + rewrite nat_of_P_minus_morphism; + [ rewrite nat_of_P_minus_morphism; + [ apply plus_lt_reg_l with (p := nat_of_P q); + rewrite le_plus_minus_r; + [ rewrite plus_comm; apply plus_lt_reg_l with (p := nat_of_P p); + rewrite plus_assoc; rewrite le_plus_minus_r; + [ rewrite (plus_comm (nat_of_P p)); apply plus_lt_compat_l; + apply nat_of_P_lt_Lt_compare_morphism; + apply ZC1; assumption + | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; + apply ZC1; assumption ] + | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism; + apply ZC1; assumption ] + | assumption ] + | assumption ] ] ]. Qed. Lemma Zcompare_plus_compat : forall n m p:Z, (p + n ?= p + m) = (n ?= m). Proof. -exact (weaken_Zcompare_Zplus_compatible weak_Zcompare_Zplus_compatible). + exact (weaken_Zcompare_Zplus_compatible weak_Zcompare_Zplus_compatible). Qed. Lemma Zplus_compare_compat : - forall (r:comparison) (n m p q:Z), - (n ?= m) = r -> (p ?= q) = r -> (n + p ?= m + q) = r. + forall (r:comparison) (n m p q:Z), + (n ?= m) = r -> (p ?= q) = r -> (n + p ?= m + q) = r. Proof. -intros r x y z t; case r; - [ intros H1 H2; elim (Zcompare_Eq_iff_eq x y); elim (Zcompare_Eq_iff_eq z t); - intros H3 H4 H5 H6; rewrite H3; - [ rewrite H5; - [ elim (Zcompare_Eq_iff_eq (y + t) (y + t)); auto with arith - | auto with arith ] - | auto with arith ] - | intros H1 H2; elim (Zcompare_Gt_Lt_antisym (y + t) (x + z)); intros H3 H4; - apply H3; apply Zcompare_Gt_trans with (m := y + z); - [ rewrite Zcompare_plus_compat; elim (Zcompare_Gt_Lt_antisym t z); - auto with arith - | do 2 rewrite <- (Zplus_comm z); rewrite Zcompare_plus_compat; - elim (Zcompare_Gt_Lt_antisym y x); auto with arith ] - | intros H1 H2; apply Zcompare_Gt_trans with (m := x + t); - [ rewrite Zcompare_plus_compat; assumption - | do 2 rewrite <- (Zplus_comm t); rewrite Zcompare_plus_compat; - assumption ] ]. + intros r x y z t; case r; + [ intros H1 H2; elim (Zcompare_Eq_iff_eq x y); elim (Zcompare_Eq_iff_eq z t); + intros H3 H4 H5 H6; rewrite H3; + [ rewrite H5; + [ elim (Zcompare_Eq_iff_eq (y + t) (y + t)); auto with arith + | auto with arith ] + | auto with arith ] + | intros H1 H2; elim (Zcompare_Gt_Lt_antisym (y + t) (x + z)); intros H3 H4; + apply H3; apply Zcompare_Gt_trans with (m := y + z); + [ rewrite Zcompare_plus_compat; elim (Zcompare_Gt_Lt_antisym t z); + auto with arith + | do 2 rewrite <- (Zplus_comm z); rewrite Zcompare_plus_compat; + elim (Zcompare_Gt_Lt_antisym y x); auto with arith ] + | intros H1 H2; apply Zcompare_Gt_trans with (m := x + t); + [ rewrite Zcompare_plus_compat; assumption + | do 2 rewrite <- (Zplus_comm t); rewrite Zcompare_plus_compat; + assumption ] ]. Qed. Lemma Zcompare_succ_Gt : forall n:Z, (Zsucc n ?= n) = Gt. Proof. -intro x; unfold Zsucc in |- *; pattern x at 2 in |- *; - rewrite <- (Zplus_0_r x); rewrite Zcompare_plus_compat; - reflexivity. + intro x; unfold Zsucc in |- *; pattern x at 2 in |- *; + rewrite <- (Zplus_0_r x); rewrite Zcompare_plus_compat; + reflexivity. Qed. Lemma Zcompare_Gt_not_Lt : forall n m:Z, (n ?= m) = Gt <-> (n ?= m + 1) <> Lt. Proof. -intros x y; split; - [ intro H; elim_compare x (y + 1); - [ intro H1; rewrite H1; discriminate - | intros H1; elim Zcompare_Gt_spec with (1 := H); intros h H2; - absurd ((nat_of_P h > 0)%nat /\ (nat_of_P h < 1)%nat); - [ unfold not in |- *; intros H3; elim H3; intros H4 H5; - absurd (nat_of_P h > 0)%nat; - [ unfold gt in |- *; apply le_not_lt; apply le_S_n; exact H5 - | assumption ] - | split; - [ elim (ZL4 h); intros i H3; rewrite H3; apply gt_Sn_O - | change (nat_of_P h < nat_of_P 1)%nat in |- *; - apply nat_of_P_lt_Lt_compare_morphism; - change ((Zpos h ?= 1) = Lt) in |- *; rewrite <- H2; - rewrite <- (fun m n:Z => Zcompare_plus_compat m n y); - rewrite (Zplus_comm x); rewrite Zplus_assoc; - rewrite Zplus_opp_r; simpl in |- *; exact H1 ] ] - | intros H1; rewrite H1; discriminate ] - | intros H; elim_compare x (y + 1); - [ intros H1; elim (Zcompare_Eq_iff_eq x (y + 1)); intros H2 H3; - rewrite (H2 H1); exact (Zcompare_succ_Gt y) - | intros H1; absurd ((x ?= y + 1) = Lt); assumption - | intros H1; apply Zcompare_Gt_trans with (m := Zsucc y); - [ exact H1 | exact (Zcompare_succ_Gt y) ] ] ]. + intros x y; split; + [ intro H; elim_compare x (y + 1); + [ intro H1; rewrite H1; discriminate + | intros H1; elim Zcompare_Gt_spec with (1 := H); intros h H2; + absurd ((nat_of_P h > 0)%nat /\ (nat_of_P h < 1)%nat); + [ unfold not in |- *; intros H3; elim H3; intros H4 H5; + absurd (nat_of_P h > 0)%nat; + [ unfold gt in |- *; apply le_not_lt; apply le_S_n; exact H5 + | assumption ] + | split; + [ elim (ZL4 h); intros i H3; rewrite H3; apply gt_Sn_O + | change (nat_of_P h < nat_of_P 1)%nat in |- *; + apply nat_of_P_lt_Lt_compare_morphism; + change ((Zpos h ?= 1) = Lt) in |- *; rewrite <- H2; + rewrite <- (fun m n:Z => Zcompare_plus_compat m n y); + rewrite (Zplus_comm x); rewrite Zplus_assoc; + rewrite Zplus_opp_r; simpl in |- *; exact H1 ] ] + | intros H1; rewrite H1; discriminate ] + | intros H; elim_compare x (y + 1); + [ intros H1; elim (Zcompare_Eq_iff_eq x (y + 1)); intros H2 H3; + rewrite (H2 H1); exact (Zcompare_succ_Gt y) + | intros H1; absurd ((x ?= y + 1) = Lt); assumption + | intros H1; apply Zcompare_Gt_trans with (m := Zsucc y); + [ exact H1 | exact (Zcompare_succ_Gt y) ] ] ]. Qed. -(** Successor and comparison *) +(** * Successor and comparison *) Lemma Zcompare_succ_compat : forall n m:Z, (Zsucc n ?= Zsucc m) = (n ?= m). Proof. -intros n m; unfold Zsucc in |- *; do 2 rewrite (fun t:Z => Zplus_comm t 1); - rewrite Zcompare_plus_compat; auto with arith. + intros n m; unfold Zsucc in |- *; do 2 rewrite (fun t:Z => Zplus_comm t 1); + rewrite Zcompare_plus_compat; auto with arith. Qed. -(** Multiplication and comparison *) +(** * Multiplication and comparison *) Lemma Zcompare_mult_compat : - forall (p:positive) (n m:Z), (Zpos p * n ?= Zpos p * m) = (n ?= m). + forall (p:positive) (n m:Z), (Zpos p * n ?= Zpos p * m) = (n ?= m). Proof. -intros x; induction x as [p H| p H| ]; - [ intros y z; cut (Zpos (xI p) = Zpos p + Zpos p + 1); - [ intros E; rewrite E; do 4 rewrite Zmult_plus_distr_l; - do 2 rewrite Zmult_1_l; apply Zplus_compare_compat; - [ apply Zplus_compare_compat; apply H | trivial with arith ] - | simpl in |- *; rewrite (Pplus_diag p); trivial with arith ] - | intros y z; cut (Zpos (xO p) = Zpos p + Zpos p); - [ intros E; rewrite E; do 2 rewrite Zmult_plus_distr_l; - apply Zplus_compare_compat; apply H - | simpl in |- *; rewrite (Pplus_diag p); trivial with arith ] - | intros y z; do 2 rewrite Zmult_1_l; trivial with arith ]. + intros x; induction x as [p H| p H| ]; + [ intros y z; cut (Zpos (xI p) = Zpos p + Zpos p + 1); + [ intros E; rewrite E; do 4 rewrite Zmult_plus_distr_l; + do 2 rewrite Zmult_1_l; apply Zplus_compare_compat; + [ apply Zplus_compare_compat; apply H | trivial with arith ] + | simpl in |- *; rewrite (Pplus_diag p); trivial with arith ] + | intros y z; cut (Zpos (xO p) = Zpos p + Zpos p); + [ intros E; rewrite E; do 2 rewrite Zmult_plus_distr_l; + apply Zplus_compare_compat; apply H + | simpl in |- *; rewrite (Pplus_diag p); trivial with arith ] + | intros y z; do 2 rewrite Zmult_1_l; trivial with arith ]. Qed. -(** Reverting [x ?= y] to trichotomy *) +(** * Reverting [x ?= y] to trichotomy *) Lemma rename : - forall (A:Type) (P:A -> Prop) (x:A), (forall y:A, x = y -> P y) -> P x. + forall (A:Type) (P:A -> Prop) (x:A), (forall y:A, x = y -> P y) -> P x. Proof. -auto with arith. + auto with arith. Qed. Lemma Zcompare_elim : - forall (c1 c2 c3:Prop) (n m:Z), - (n = m -> c1) -> - (n < m -> c2) -> - (n > m -> c3) -> match n ?= m with - | Eq => c1 - | Lt => c2 - | Gt => c3 - end. + forall (c1 c2 c3:Prop) (n m:Z), + (n = m -> c1) -> + (n < m -> c2) -> + (n > m -> c3) -> match n ?= m with + | Eq => c1 + | Lt => c2 + | Gt => c3 + end. Proof. -intros c1 c2 c3 x y; intros. -apply rename with (x := x ?= y); intro r; elim r; - [ intro; apply H; apply (Zcompare_Eq_eq x y); assumption - | unfold Zlt in H0; assumption - | unfold Zgt in H1; assumption ]. + intros c1 c2 c3 x y; intros. + apply rename with (x := x ?= y); intro r; elim r; + [ intro; apply H; apply (Zcompare_Eq_eq x y); assumption + | unfold Zlt in H0; assumption + | unfold Zgt in H1; assumption ]. Qed. Lemma Zcompare_eq_case : - forall (c1 c2 c3:Prop) (n m:Z), - c1 -> n = m -> match n ?= m with - | Eq => c1 - | Lt => c2 - | Gt => c3 - end. + forall (c1 c2 c3:Prop) (n m:Z), + c1 -> n = m -> match n ?= m with + | Eq => c1 + | Lt => c2 + | Gt => c3 + end. Proof. -intros c1 c2 c3 x y; intros. -rewrite H0; rewrite Zcompare_refl. -assumption. + intros c1 c2 c3 x y; intros. + rewrite H0; rewrite Zcompare_refl. + assumption. Qed. -(** Decompose an egality between two [?=] relations into 3 implications *) +(** * Decompose an egality between two [?=] relations into 3 implications *) Lemma Zcompare_egal_dec : - forall n m p q:Z, - (n < m -> p < q) -> - ((n ?= m) = Eq -> (p ?= q) = Eq) -> - (n > m -> p > q) -> (n ?= m) = (p ?= q). + forall n m p q:Z, + (n < m -> p < q) -> + ((n ?= m) = Eq -> (p ?= q) = Eq) -> + (n > m -> p > q) -> (n ?= m) = (p ?= q). Proof. -intros x1 y1 x2 y2. -unfold Zgt in |- *; unfold Zlt in |- *; case (x1 ?= y1); case (x2 ?= y2); - auto with arith; symmetry in |- *; auto with arith. + intros x1 y1 x2 y2. + unfold Zgt in |- *; unfold Zlt in |- *; case (x1 ?= y1); case (x2 ?= y2); + auto with arith; symmetry in |- *; auto with arith. Qed. -(** Relating [x ?= y] to [Zle], [Zlt], [Zge] or [Zgt] *) +(** * Relating [x ?= y] to [Zle], [Zlt], [Zge] or [Zgt] *) Lemma Zle_compare : - forall n m:Z, - n <= m -> match n ?= m with - | Eq => True - | Lt => True - | Gt => False - end. + forall n m:Z, + n <= m -> match n ?= m with + | Eq => True + | Lt => True + | Gt => False + end. Proof. -intros x y; unfold Zle in |- *; elim (x ?= y); auto with arith. + intros x y; unfold Zle in |- *; elim (x ?= y); auto with arith. Qed. Lemma Zlt_compare : - forall n m:Z, + forall n m:Z, n < m -> match n ?= m with - | Eq => False - | Lt => True - | Gt => False + | Eq => False + | Lt => True + | Gt => False end. Proof. -intros x y; unfold Zlt in |- *; elim (x ?= y); intros; - discriminate || trivial with arith. + intros x y; unfold Zlt in |- *; elim (x ?= y); intros; + discriminate || trivial with arith. Qed. Lemma Zge_compare : - forall n m:Z, - n >= m -> match n ?= m with - | Eq => True - | Lt => False - | Gt => True - end. + forall n m:Z, + n >= m -> match n ?= m with + | Eq => True + | Lt => False + | Gt => True + end. Proof. -intros x y; unfold Zge in |- *; elim (x ?= y); auto with arith. + intros x y; unfold Zge in |- *; elim (x ?= y); auto with arith. Qed. Lemma Zgt_compare : - forall n m:Z, - n > m -> match n ?= m with - | Eq => False - | Lt => False - | Gt => True - end. + forall n m:Z, + n > m -> match n ?= m with + | Eq => False + | Lt => False + | Gt => True + end. Proof. -intros x y; unfold Zgt in |- *; elim (x ?= y); intros; - discriminate || trivial with arith. + intros x y; unfold Zgt in |- *; elim (x ?= y); intros; + discriminate || trivial with arith. Qed. -(**********************************************************************) -(* Other properties *) - +(*********************) +(** * Other properties *) Lemma Zmult_compare_compat_l : - forall n m p:Z, p > 0 -> (n ?= m) = (p * n ?= p * m). + forall n m p:Z, p > 0 -> (n ?= m) = (p * n ?= p * m). Proof. -intros x y z H; destruct z. + intros x y z H; destruct z. discriminate H. rewrite Zcompare_mult_compat; reflexivity. discriminate H. Qed. Lemma Zmult_compare_compat_r : - forall n m p:Z, p > 0 -> (n ?= m) = (n * p ?= m * p). + forall n m p:Z, p > 0 -> (n ?= m) = (n * p ?= m * p). Proof. -intros x y z H; rewrite (Zmult_comm x z); rewrite (Zmult_comm y z); - apply Zmult_compare_compat_l; assumption. + intros x y z H; rewrite (Zmult_comm x z); rewrite (Zmult_comm y z); + apply Zmult_compare_compat_l; assumption. Qed. diff --git a/theories/ZArith/Zcomplements.v b/theories/ZArith/Zcomplements.v index 817fbc1b..78c8a976 100644 --- a/theories/ZArith/Zcomplements.v +++ b/theories/ZArith/Zcomplements.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Zcomplements.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Zcomplements.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import ZArithRing. Require Import ZArith_base. @@ -19,27 +19,27 @@ Open Local Scope Z_scope. (** About parity *) Lemma two_or_two_plus_one : - forall n:Z, {y : Z | n = 2 * y} + {y : Z | n = 2 * y + 1}. + forall n:Z, {y : Z | n = 2 * y} + {y : Z | n = 2 * y + 1}. Proof. -intro x; destruct x. -left; split with 0; reflexivity. - -destruct p. -right; split with (Zpos p); reflexivity. - -left; split with (Zpos p); reflexivity. - -right; split with 0; reflexivity. - -destruct p. -right; split with (Zneg (1 + p)). -rewrite BinInt.Zneg_xI. -rewrite BinInt.Zneg_plus_distr. -omega. - -left; split with (Zneg p); reflexivity. - -right; split with (-1); reflexivity. + intro x; destruct x. + left; split with 0; reflexivity. + + destruct p. + right; split with (Zpos p); reflexivity. + + left; split with (Zpos p); reflexivity. + + right; split with 0; reflexivity. + + destruct p. + right; split with (Zneg (1 + p)). + rewrite BinInt.Zneg_xI. + rewrite BinInt.Zneg_plus_distr. + omega. + + left; split with (Zneg p); reflexivity. + + right; split with (-1); reflexivity. Qed. (**********************************************************************) @@ -50,109 +50,109 @@ Qed. Fixpoint floor_pos (a:positive) : positive := match a with - | xH => 1%positive - | xO a' => xO (floor_pos a') - | xI b' => xO (floor_pos b') + | xH => 1%positive + | xO a' => xO (floor_pos a') + | xI b' => xO (floor_pos b') end. Definition floor (a:positive) := Zpos (floor_pos a). Lemma floor_gt0 : forall p:positive, floor p > 0. Proof. -intro. -compute in |- *. -trivial. + intro. + compute in |- *. + trivial. Qed. Lemma floor_ok : forall p:positive, floor p <= Zpos p < 2 * floor p. Proof. -unfold floor in |- *. -intro a; induction a as [p| p| ]. - -simpl in |- *. -repeat rewrite BinInt.Zpos_xI. -rewrite (BinInt.Zpos_xO (xO (floor_pos p))). -rewrite (BinInt.Zpos_xO (floor_pos p)). -omega. - -simpl in |- *. -repeat rewrite BinInt.Zpos_xI. -rewrite (BinInt.Zpos_xO (xO (floor_pos p))). -rewrite (BinInt.Zpos_xO (floor_pos p)). -rewrite (BinInt.Zpos_xO p). -omega. - -simpl in |- *; omega. + unfold floor in |- *. + intro a; induction a as [p| p| ]. + + simpl in |- *. + repeat rewrite BinInt.Zpos_xI. + rewrite (BinInt.Zpos_xO (xO (floor_pos p))). + rewrite (BinInt.Zpos_xO (floor_pos p)). + omega. + + simpl in |- *. + repeat rewrite BinInt.Zpos_xI. + rewrite (BinInt.Zpos_xO (xO (floor_pos p))). + rewrite (BinInt.Zpos_xO (floor_pos p)). + rewrite (BinInt.Zpos_xO p). + omega. + + simpl in |- *; omega. Qed. (**********************************************************************) (** Two more induction principles over [Z]. *) Theorem Z_lt_abs_rec : - forall P:Z -> Set, - (forall n:Z, (forall m:Z, Zabs m < Zabs n -> P m) -> P n) -> - forall n:Z, P n. + forall P:Z -> Set, + (forall n:Z, (forall m:Z, Zabs m < Zabs n -> P m) -> P n) -> + forall n:Z, P n. Proof. -intros P HP p. -set (Q := fun z => 0 <= z -> P z * P (- z)) in *. -cut (Q (Zabs p)); [ intros | apply (Z_lt_rec Q); auto with zarith ]. -elim (Zabs_dec p); intro eq; rewrite eq; elim H; auto with zarith. -unfold Q in |- *; clear Q; intros. -apply pair; apply HP. -rewrite Zabs_eq; auto; intros. -elim (H (Zabs m)); intros; auto with zarith. -elim (Zabs_dec m); intro eq; rewrite eq; trivial. -rewrite Zabs_non_eq; auto with zarith. -rewrite Zopp_involutive; intros. -elim (H (Zabs m)); intros; auto with zarith. -elim (Zabs_dec m); intro eq; rewrite eq; trivial. + intros P HP p. + set (Q := fun z => 0 <= z -> P z * P (- z)) in *. + cut (Q (Zabs p)); [ intros | apply (Z_lt_rec Q); auto with zarith ]. + elim (Zabs_dec p); intro eq; rewrite eq; elim H; auto with zarith. + unfold Q in |- *; clear Q; intros. + apply pair; apply HP. + rewrite Zabs_eq; auto; intros. + elim (H (Zabs m)); intros; auto with zarith. + elim (Zabs_dec m); intro eq; rewrite eq; trivial. + rewrite Zabs_non_eq; auto with zarith. + rewrite Zopp_involutive; intros. + elim (H (Zabs m)); intros; auto with zarith. + elim (Zabs_dec m); intro eq; rewrite eq; trivial. Qed. Theorem Z_lt_abs_induction : - forall P:Z -> Prop, - (forall n:Z, (forall m:Z, Zabs m < Zabs n -> P m) -> P n) -> - forall n:Z, P n. + forall P:Z -> Prop, + (forall n:Z, (forall m:Z, Zabs m < Zabs n -> P m) -> P n) -> + forall n:Z, P n. Proof. -intros P HP p. -set (Q := fun z => 0 <= z -> P z /\ P (- z)) in *. -cut (Q (Zabs p)); [ intros | apply (Z_lt_induction Q); auto with zarith ]. -elim (Zabs_dec p); intro eq; rewrite eq; elim H; auto with zarith. -unfold Q in |- *; clear Q; intros. -split; apply HP. -rewrite Zabs_eq; auto; intros. -elim (H (Zabs m)); intros; auto with zarith. -elim (Zabs_dec m); intro eq; rewrite eq; trivial. -rewrite Zabs_non_eq; auto with zarith. -rewrite Zopp_involutive; intros. -elim (H (Zabs m)); intros; auto with zarith. -elim (Zabs_dec m); intro eq; rewrite eq; trivial. + intros P HP p. + set (Q := fun z => 0 <= z -> P z /\ P (- z)) in *. + cut (Q (Zabs p)); [ intros | apply (Z_lt_induction Q); auto with zarith ]. + elim (Zabs_dec p); intro eq; rewrite eq; elim H; auto with zarith. + unfold Q in |- *; clear Q; intros. + split; apply HP. + rewrite Zabs_eq; auto; intros. + elim (H (Zabs m)); intros; auto with zarith. + elim (Zabs_dec m); intro eq; rewrite eq; trivial. + rewrite Zabs_non_eq; auto with zarith. + rewrite Zopp_involutive; intros. + elim (H (Zabs m)); intros; auto with zarith. + elim (Zabs_dec m); intro eq; rewrite eq; trivial. Qed. (** To do case analysis over the sign of [z] *) Lemma Zcase_sign : - forall (n:Z) (P:Prop), (n = 0 -> P) -> (n > 0 -> P) -> (n < 0 -> P) -> P. + forall (n:Z) (P:Prop), (n = 0 -> P) -> (n > 0 -> P) -> (n < 0 -> P) -> P. Proof. -intros x P Hzero Hpos Hneg. -induction x as [| p| p]. -apply Hzero; trivial. -apply Hpos; apply Zorder.Zgt_pos_0. -apply Hneg; apply Zorder.Zlt_neg_0. + intros x P Hzero Hpos Hneg. + induction x as [| p| p]. + apply Hzero; trivial. + apply Hpos; apply Zorder.Zgt_pos_0. + apply Hneg; apply Zorder.Zlt_neg_0. Qed. Lemma sqr_pos : forall n:Z, n * n >= 0. Proof. -intro x. -apply (Zcase_sign x (x * x >= 0)). -intros H; rewrite H; omega. -intros H; replace 0 with (0 * 0). -apply Zmult_ge_compat; omega. -omega. -intros H; replace 0 with (0 * 0). -replace (x * x) with (- x * - x). -apply Zmult_ge_compat; omega. -ring. -omega. + intro x. + apply (Zcase_sign x (x * x >= 0)). + intros H; rewrite H; omega. + intros H; replace 0 with (0 * 0). + apply Zmult_ge_compat; omega. + omega. + intros H; replace 0 with (0 * 0). + replace (x * x) with (- x * - x). + apply Zmult_ge_compat; omega. + ring. + omega. Qed. (**********************************************************************) @@ -162,8 +162,8 @@ Require Import List. Fixpoint Zlength_aux (acc:Z) (A:Set) (l:list A) {struct l} : Z := match l with - | nil => acc - | _ :: l => Zlength_aux (Zsucc acc) A l + | nil => acc + | _ :: l => Zlength_aux (Zsucc acc) A l end. Definition Zlength := Zlength_aux 0. @@ -171,42 +171,42 @@ Implicit Arguments Zlength [A]. Section Zlength_properties. -Variable A : Set. - -Implicit Type l : list A. - -Lemma Zlength_correct : forall l, Zlength l = Z_of_nat (length l). -Proof. -assert (forall l (acc:Z), Zlength_aux acc A l = acc + Z_of_nat (length l)). -simple induction l. -simpl in |- *; auto with zarith. -intros; simpl (length (a :: l0)) in |- *; rewrite Znat.inj_S. -simpl in |- *; rewrite H; auto with zarith. -unfold Zlength in |- *; intros; rewrite H; auto. -Qed. - -Lemma Zlength_nil : Zlength (A:=A) nil = 0. -Proof. -auto. -Qed. - -Lemma Zlength_cons : forall (x:A) l, Zlength (x :: l) = Zsucc (Zlength l). -Proof. -intros; do 2 rewrite Zlength_correct. -simpl (length (x :: l)) in |- *; rewrite Znat.inj_S; auto. -Qed. - -Lemma Zlength_nil_inv : forall l, Zlength l = 0 -> l = nil. -Proof. -intro l; rewrite Zlength_correct. -case l; auto. -intros x l'; simpl (length (x :: l')) in |- *. -rewrite Znat.inj_S. -intros; elimtype False; generalize (Zle_0_nat (length l')); omega. -Qed. + Variable A : Set. + + Implicit Type l : list A. + + Lemma Zlength_correct : forall l, Zlength l = Z_of_nat (length l). + Proof. + assert (forall l (acc:Z), Zlength_aux acc A l = acc + Z_of_nat (length l)). + simple induction l. + simpl in |- *; auto with zarith. + intros; simpl (length (a :: l0)) in |- *; rewrite Znat.inj_S. + simpl in |- *; rewrite H; auto with zarith. + unfold Zlength in |- *; intros; rewrite H; auto. + Qed. + + Lemma Zlength_nil : Zlength (A:=A) nil = 0. + Proof. + auto. + Qed. + + Lemma Zlength_cons : forall (x:A) l, Zlength (x :: l) = Zsucc (Zlength l). + Proof. + intros; do 2 rewrite Zlength_correct. + simpl (length (x :: l)) in |- *; rewrite Znat.inj_S; auto. + Qed. + + Lemma Zlength_nil_inv : forall l, Zlength l = 0 -> l = nil. + Proof. + intro l; rewrite Zlength_correct. + case l; auto. + intros x l'; simpl (length (x :: l')) in |- *. + rewrite Znat.inj_S. + intros; elimtype False; generalize (Zle_0_nat (length l')); omega. + Qed. End Zlength_properties. Implicit Arguments Zlength_correct [A]. Implicit Arguments Zlength_cons [A]. -Implicit Arguments Zlength_nil_inv [A].
\ No newline at end of file +Implicit Arguments Zlength_nil_inv [A]. diff --git a/theories/ZArith/Zdiv.v b/theories/ZArith/Zdiv.v index e391d087..31f68207 100644 --- a/theories/ZArith/Zdiv.v +++ b/theories/ZArith/Zdiv.v @@ -6,17 +6,14 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Zdiv.v 6295 2004-11-12 16:40:39Z gregoire $ i*) +(*i $Id: Zdiv.v 9245 2006-10-17 12:53:34Z notin $ i*) (* Contribution by Claude Marché and Xavier Urbain *) -(** - -Euclidean Division - -Defines first of function that allows Coq to normalize. -Then only after proves the main required property. +(** Euclidean Division + Defines first of function that allows Coq to normalize. + Then only after proves the main required property. *) Require Export ZArith_base. @@ -26,40 +23,37 @@ Require Import ZArithRing. Require Import Zcomplements. Open Local Scope Z_scope. -(** +(** * Definitions of Euclidian operations *) - Euclidean division of a positive by a integer - (that is supposed to be positive). +(** Euclidean division of a positive by a integer + (that is supposed to be positive). - total function than returns an arbitrary value when - divisor is not positive + Total function than returns an arbitrary value when + divisor is not positive *) Unboxed Fixpoint Zdiv_eucl_POS (a:positive) (b:Z) {struct a} : - Z * Z := + Z * Z := match a with - | xH => if Zge_bool b 2 then (0, 1) else (1, 0) - | xO a' => + | xH => if Zge_bool b 2 then (0, 1) else (1, 0) + | xO a' => let (q, r) := Zdiv_eucl_POS a' b in - let r' := 2 * r in - if Zgt_bool b r' then (2 * q, r') else (2 * q + 1, r' - b) - | xI a' => + let r' := 2 * r in + if Zgt_bool b r' then (2 * q, r') else (2 * q + 1, r' - b) + | xI a' => let (q, r) := Zdiv_eucl_POS a' b in - let r' := 2 * r + 1 in - if Zgt_bool b r' then (2 * q, r') else (2 * q + 1, r' - b) + let r' := 2 * r + 1 in + if Zgt_bool b r' then (2 * q, r') else (2 * q + 1, r' - b) end. -(** - - Euclidean division of integers. +(** Euclidean division of integers. - Total function than returns (0,0) when dividing by 0. - + Total function than returns (0,0) when dividing by 0. *) -(* +(** The pseudo-code is: @@ -82,22 +76,22 @@ Unboxed Fixpoint Zdiv_eucl_POS (a:positive) (b:Z) {struct a} : Definition Zdiv_eucl (a b:Z) : Z * Z := match a, b with - | Z0, _ => (0, 0) - | _, Z0 => (0, 0) - | Zpos a', Zpos _ => Zdiv_eucl_POS a' b - | Zneg a', Zpos _ => + | Z0, _ => (0, 0) + | _, Z0 => (0, 0) + | Zpos a', Zpos _ => Zdiv_eucl_POS a' b + | Zneg a', Zpos _ => let (q, r) := Zdiv_eucl_POS a' b in - match r with - | Z0 => (- q, 0) - | _ => (- (q + 1), b - r) - end - | Zneg a', Zneg b' => let (q, r) := Zdiv_eucl_POS a' (Zpos b') in (q, - r) - | Zpos a', Zneg b' => + match r with + | Z0 => (- q, 0) + | _ => (- (q + 1), b - r) + end + | Zneg a', Zneg b' => let (q, r) := Zdiv_eucl_POS a' (Zpos b') in (q, - r) + | Zpos a', Zneg b' => let (q, r) := Zdiv_eucl_POS a' (Zpos b') in - match r with - | Z0 => (- q, 0) - | _ => (- (q + 1), b + r) - end + match r with + | Z0 => (- q, 0) + | _ => (- (q + 1), b + r) + end end. @@ -107,6 +101,11 @@ Definition Zdiv (a b:Z) : Z := let (q, _) := Zdiv_eucl a b in q. Definition Zmod (a b:Z) : Z := let (_, r) := Zdiv_eucl a b in r. +(** Syntax *) + +Infix "/" := Zdiv : Z_scope. +Infix "mod" := Zmod (at level 40, no associativity) : Z_scope. + (* Tests: Eval Compute in `(Zdiv_eucl 7 3)`. @@ -120,19 +119,15 @@ Eval Compute in `(Zdiv_eucl (-7) (-3))`. *) -(** - - Main division theorem. - - First a lemma for positive +(** * Main division theorem *) -*) +(** First a lemma for positive *) Lemma Z_div_mod_POS : - forall b:Z, - b > 0 -> - forall a:positive, - let (q, r) := Zdiv_eucl_POS a b in Zpos a = b * q + r /\ 0 <= r < b. + forall b:Z, + b > 0 -> + forall a:positive, + let (q, r) := Zdiv_eucl_POS a b in Zpos a = b * q + r /\ 0 <= r < b. Proof. simple induction a; unfold Zdiv_eucl_POS in |- *; fold Zdiv_eucl_POS in |- *. @@ -148,276 +143,269 @@ case (Zgt_bool b (2 * r)); rewrite BinInt.Zpos_xO; (split; [ ring | omega ]). generalize (Zge_cases b 2). -case (Zge_bool b 2); (intros; split; [ ring | omega ]). +case (Zge_bool b 2); (intros; split; [ try ring | omega ]). omega. Qed. Theorem Z_div_mod : - forall a b:Z, - b > 0 -> let (q, r) := Zdiv_eucl a b in a = b * q + r /\ 0 <= r < b. + forall a b:Z, + b > 0 -> let (q, r) := Zdiv_eucl a b in a = b * q + r /\ 0 <= r < b. Proof. -intros a b; case a; case b; try (simpl in |- *; intros; omega). -unfold Zdiv_eucl in |- *; intros; apply Z_div_mod_POS; trivial. - -intros; discriminate. - -intros. -generalize (Z_div_mod_POS (Zpos p) H p0). -unfold Zdiv_eucl in |- *. -case (Zdiv_eucl_POS p0 (Zpos p)). -intros z z0. -case z0. - -intros [H1 H2]. -split; trivial. -replace (Zneg p0) with (- Zpos p0); [ rewrite H1; ring | trivial ]. - -intros p1 [H1 H2]. -split; trivial. -replace (Zneg p0) with (- Zpos p0); [ rewrite H1; ring | trivial ]. -generalize (Zorder.Zgt_pos_0 p1); omega. - -intros p1 [H1 H2]. -split; trivial. -replace (Zneg p0) with (- Zpos p0); [ rewrite H1; ring | trivial ]. -generalize (Zorder.Zlt_neg_0 p1); omega. - -intros; discriminate. + intros a b; case a; case b; try (simpl in |- *; intros; omega). + unfold Zdiv_eucl in |- *; intros; apply Z_div_mod_POS; trivial. + + intros; discriminate. + + intros. + generalize (Z_div_mod_POS (Zpos p) H p0). + unfold Zdiv_eucl in |- *. + case (Zdiv_eucl_POS p0 (Zpos p)). + intros z z0. + case z0. + + intros [H1 H2]. + split; trivial. + replace (Zneg p0) with (- Zpos p0); [ rewrite H1; ring | trivial ]. + + intros p1 [H1 H2]. + split; trivial. + replace (Zneg p0) with (- Zpos p0); [ rewrite H1; ring | trivial ]. + generalize (Zorder.Zgt_pos_0 p1); omega. + + intros p1 [H1 H2]. + split; trivial. + replace (Zneg p0) with (- Zpos p0); [ rewrite H1; ring | trivial ]. + generalize (Zorder.Zlt_neg_0 p1); omega. + + intros; discriminate. Qed. (** Existence theorems *) Theorem Zdiv_eucl_exist : - forall b:Z, - b > 0 -> - forall a:Z, {qr : Z * Z | let (q, r) := qr in a = b * q + r /\ 0 <= r < b}. + forall b:Z, + b > 0 -> + forall a:Z, {qr : Z * Z | let (q, r) := qr in a = b * q + r /\ 0 <= r < b}. Proof. -intros b Hb a. -exists (Zdiv_eucl a b). -exact (Z_div_mod a b Hb). + intros b Hb a. + exists (Zdiv_eucl a b). + exact (Z_div_mod a b Hb). Qed. Implicit Arguments Zdiv_eucl_exist. Theorem Zdiv_eucl_extended : - forall b:Z, - b <> 0 -> - forall a:Z, - {qr : Z * Z | let (q, r) := qr in a = b * q + r /\ 0 <= r < Zabs b}. + forall b:Z, + b <> 0 -> + forall a:Z, + {qr : Z * Z | let (q, r) := qr in a = b * q + r /\ 0 <= r < Zabs b}. Proof. -intros b Hb a. -elim (Z_le_gt_dec 0 b); intro Hb'. -cut (b > 0); [ intro Hb'' | omega ]. -rewrite Zabs_eq; [ apply Zdiv_eucl_exist; assumption | assumption ]. -cut (- b > 0); [ intro Hb'' | omega ]. -elim (Zdiv_eucl_exist Hb'' a); intros qr. -elim qr; intros q r Hqr. -exists (- q, r). -elim Hqr; intros. -split. -rewrite <- Zmult_opp_comm; assumption. -rewrite Zabs_non_eq; [ assumption | omega ]. + intros b Hb a. + elim (Z_le_gt_dec 0 b); intro Hb'. + cut (b > 0); [ intro Hb'' | omega ]. + rewrite Zabs_eq; [ apply Zdiv_eucl_exist; assumption | assumption ]. + cut (- b > 0); [ intro Hb'' | omega ]. + elim (Zdiv_eucl_exist Hb'' a); intros qr. + elim qr; intros q r Hqr. + exists (- q, r). + elim Hqr; intros. + split. + rewrite <- Zmult_opp_comm; assumption. + rewrite Zabs_non_eq; [ assumption | omega ]. Qed. Implicit Arguments Zdiv_eucl_extended. -(** Auxiliary lemmas about [Zdiv] and [Zmod] *) +(** * Auxiliary lemmas about [Zdiv] and [Zmod] *) Lemma Z_div_mod_eq : forall a b:Z, b > 0 -> a = b * Zdiv a b + Zmod a b. Proof. -unfold Zdiv, Zmod in |- *. -intros a b Hb. -generalize (Z_div_mod a b Hb). -case Zdiv_eucl; tauto. + unfold Zdiv, Zmod in |- *. + intros a b Hb. + generalize (Z_div_mod a b Hb). + case Zdiv_eucl; tauto. Qed. Lemma Z_mod_lt : forall a b:Z, b > 0 -> 0 <= Zmod a b < b. Proof. -unfold Zmod in |- *. -intros a b Hb. -generalize (Z_div_mod a b Hb). -case (Zdiv_eucl a b); tauto. + unfold Zmod in |- *. + intros a b Hb. + generalize (Z_div_mod a b Hb). + case (Zdiv_eucl a b); tauto. Qed. Lemma Z_div_POS_ge0 : - forall (b:Z) (a:positive), let (q, _) := Zdiv_eucl_POS a b in q >= 0. + forall (b:Z) (a:positive), let (q, _) := Zdiv_eucl_POS a b in q >= 0. Proof. -simple induction a; unfold Zdiv_eucl_POS in |- *; fold Zdiv_eucl_POS in |- *. -intro p; case (Zdiv_eucl_POS p b). -intros; case (Zgt_bool b (2 * z0 + 1)); intros; omega. -intro p; case (Zdiv_eucl_POS p b). -intros; case (Zgt_bool b (2 * z0)); intros; omega. -case (Zge_bool b 2); simpl in |- *; omega. + simple induction a; unfold Zdiv_eucl_POS in |- *; fold Zdiv_eucl_POS in |- *. + intro p; case (Zdiv_eucl_POS p b). + intros; case (Zgt_bool b (2 * z0 + 1)); intros; omega. + intro p; case (Zdiv_eucl_POS p b). + intros; case (Zgt_bool b (2 * z0)); intros; omega. + case (Zge_bool b 2); simpl in |- *; omega. Qed. Lemma Z_div_ge0 : forall a b:Z, b > 0 -> a >= 0 -> Zdiv a b >= 0. Proof. -intros a b Hb; unfold Zdiv, Zdiv_eucl in |- *; case a; simpl in |- *; intros. -case b; simpl in |- *; trivial. -generalize Hb; case b; try trivial. -auto with zarith. -intros p0 Hp0; generalize (Z_div_POS_ge0 (Zpos p0) p). -case (Zdiv_eucl_POS p (Zpos p0)); simpl in |- *; tauto. -intros; discriminate. -elim H; trivial. + intros a b Hb; unfold Zdiv, Zdiv_eucl in |- *; case a; simpl in |- *; intros. + case b; simpl in |- *; trivial. + generalize Hb; case b; try trivial. + auto with zarith. + intros p0 Hp0; generalize (Z_div_POS_ge0 (Zpos p0) p). + case (Zdiv_eucl_POS p (Zpos p0)); simpl in |- *; tauto. + intros; discriminate. + elim H; trivial. Qed. Lemma Z_div_lt : forall a b:Z, b >= 2 -> a > 0 -> Zdiv a b < a. Proof. -intros. cut (b > 0); [ intro Hb | omega ]. -generalize (Z_div_mod a b Hb). -cut (a >= 0); [ intro Ha | omega ]. -generalize (Z_div_ge0 a b Hb Ha). -unfold Zdiv in |- *; case (Zdiv_eucl a b); intros q r H1 [H2 H3]. -cut (a >= 2 * q -> q < a); [ intro h; apply h; clear h | intros; omega ]. -apply Zge_trans with (b * q). -omega. -auto with zarith. + intros. cut (b > 0); [ intro Hb | omega ]. + generalize (Z_div_mod a b Hb). + cut (a >= 0); [ intro Ha | omega ]. + generalize (Z_div_ge0 a b Hb Ha). + unfold Zdiv in |- *; case (Zdiv_eucl a b); intros q r H1 [H2 H3]. + cut (a >= 2 * q -> q < a); [ intro h; apply h; clear h | intros; omega ]. + apply Zge_trans with (b * q). + omega. + auto with zarith. Qed. -(** Syntax *) - - - -Infix "/" := Zdiv : Z_scope. -Infix "mod" := Zmod (at level 40, no associativity) : Z_scope. - -(** Other lemmas (now using the syntax for [Zdiv] and [Zmod]). *) +(** * Other lemmas (now using the syntax for [Zdiv] and [Zmod]). *) Lemma Z_div_ge : forall a b c:Z, c > 0 -> a >= b -> a / c >= b / c. Proof. -intros a b c cPos aGeb. -generalize (Z_div_mod_eq a c cPos). -generalize (Z_mod_lt a c cPos). -generalize (Z_div_mod_eq b c cPos). -generalize (Z_mod_lt b c cPos). -intros. -elim (Z_ge_lt_dec (a / c) (b / c)); trivial. -intro. -absurd (b - a >= 1). -omega. -rewrite H0. -rewrite H2. -assert - (c * (b / c) + b mod c - (c * (a / c) + a mod c) = - c * (b / c - a / c) + b mod c - a mod c). -ring. -rewrite H3. -assert (c * (b / c - a / c) >= c * 1). -apply Zmult_ge_compat_l. -omega. -omega. -assert (c * 1 = c). -ring. -omega. + intros a b c cPos aGeb. + generalize (Z_div_mod_eq a c cPos). + generalize (Z_mod_lt a c cPos). + generalize (Z_div_mod_eq b c cPos). + generalize (Z_mod_lt b c cPos). + intros. + elim (Z_ge_lt_dec (a / c) (b / c)); trivial. + intro. + absurd (b - a >= 1). + omega. + rewrite H0. + rewrite H2. + assert + (c * (b / c) + b mod c - (c * (a / c) + a mod c) = + c * (b / c - a / c) + b mod c - a mod c). + ring. + rewrite H3. + assert (c * (b / c - a / c) >= c * 1). + apply Zmult_ge_compat_l. + omega. + omega. + assert (c * 1 = c). + ring. + omega. Qed. Lemma Z_mod_plus : forall a b c:Z, c > 0 -> (a + b * c) mod c = a mod c. Proof. -intros a b c cPos. -generalize (Z_div_mod_eq a c cPos). -generalize (Z_mod_lt a c cPos). -generalize (Z_div_mod_eq (a + b * c) c cPos). -generalize (Z_mod_lt (a + b * c) c cPos). -intros. - -assert ((a + b * c) mod c - a mod c = c * (b + a / c - (a + b * c) / c)). -replace ((a + b * c) mod c) with (a + b * c - c * ((a + b * c) / c)). -replace (a mod c) with (a - c * (a / c)). -ring. -omega. -omega. -set (q := b + a / c - (a + b * c) / c) in *. -apply (Zcase_sign q); intros. -assert (c * q = 0). -rewrite H4; ring. -rewrite H5 in H3. -omega. - -assert (c * q >= c). -pattern c at 2 in |- *; replace c with (c * 1). -apply Zmult_ge_compat_l; omega. -ring. -omega. - -assert (c * q <= - c). -replace (- c) with (c * -1). -apply Zmult_le_compat_l; omega. -ring. -omega. + intros a b c cPos. + generalize (Z_div_mod_eq a c cPos). + generalize (Z_mod_lt a c cPos). + generalize (Z_div_mod_eq (a + b * c) c cPos). + generalize (Z_mod_lt (a + b * c) c cPos). + intros. + + assert ((a + b * c) mod c - a mod c = c * (b + a / c - (a + b * c) / c)). + replace ((a + b * c) mod c) with (a + b * c - c * ((a + b * c) / c)). + replace (a mod c) with (a - c * (a / c)). + ring. + omega. + omega. + set (q := b + a / c - (a + b * c) / c) in *. + apply (Zcase_sign q); intros. + assert (c * q = 0). + rewrite H4; ring. + rewrite H5 in H3. + omega. + + assert (c * q >= c). + pattern c at 2 in |- *; replace c with (c * 1). + apply Zmult_ge_compat_l; omega. + ring. + omega. + + assert (c * q <= - c). + replace (- c) with (c * -1). + apply Zmult_le_compat_l; omega. + ring. + omega. Qed. Lemma Z_div_plus : forall a b c:Z, c > 0 -> (a + b * c) / c = a / c + b. Proof. -intros a b c cPos. -generalize (Z_div_mod_eq a c cPos). -generalize (Z_mod_lt a c cPos). -generalize (Z_div_mod_eq (a + b * c) c cPos). -generalize (Z_mod_lt (a + b * c) c cPos). -intros. -apply Zmult_reg_l with c. omega. -replace (c * ((a + b * c) / c)) with (a + b * c - (a + b * c) mod c). -rewrite (Z_mod_plus a b c cPos). -pattern a at 1 in |- *; rewrite H2. -ring. -pattern (a + b * c) at 1 in |- *; rewrite H0. -ring. + intros a b c cPos. + generalize (Z_div_mod_eq a c cPos). + generalize (Z_mod_lt a c cPos). + generalize (Z_div_mod_eq (a + b * c) c cPos). + generalize (Z_mod_lt (a + b * c) c cPos). + intros. + apply Zmult_reg_l with c. omega. + replace (c * ((a + b * c) / c)) with (a + b * c - (a + b * c) mod c). + rewrite (Z_mod_plus a b c cPos). + pattern a at 1 in |- *; rewrite H2. + ring. + pattern (a + b * c) at 1 in |- *; rewrite H0. + ring. Qed. Lemma Z_div_mult : forall a b:Z, b > 0 -> a * b / b = a. -intros; replace (a * b) with (0 + a * b); auto. -rewrite Z_div_plus; auto. + intros; replace (a * b) with (0 + a * b); auto. + rewrite Z_div_plus; auto. Qed. Lemma Z_mult_div_ge : forall a b:Z, b > 0 -> b * (a / b) <= a. Proof. -intros a b bPos. -generalize (Z_div_mod_eq a _ bPos); intros. -generalize (Z_mod_lt a _ bPos); intros. -pattern a at 2 in |- *; rewrite H. -omega. + intros a b bPos. + generalize (Z_div_mod_eq a _ bPos); intros. + generalize (Z_mod_lt a _ bPos); intros. + pattern a at 2 in |- *; rewrite H. + omega. Qed. Lemma Z_mod_same : forall a:Z, a > 0 -> a mod a = 0. Proof. -intros a aPos. -generalize (Z_mod_plus 0 1 a aPos). -replace (0 + 1 * a) with a. -intros. -rewrite H. -compute in |- *. -trivial. -ring. + intros a aPos. + generalize (Z_mod_plus 0 1 a aPos). + replace (0 + 1 * a) with a. + intros. + rewrite H. + compute in |- *. + trivial. + ring. Qed. Lemma Z_div_same : forall a:Z, a > 0 -> a / a = 1. Proof. -intros a aPos. -generalize (Z_div_plus 0 1 a aPos). -replace (0 + 1 * a) with a. -intros. -rewrite H. -compute in |- *. -trivial. -ring. + intros a aPos. + generalize (Z_div_plus 0 1 a aPos). + replace (0 + 1 * a) with a. + intros. + rewrite H. + compute in |- *. + trivial. + ring. Qed. Lemma Z_div_exact_1 : forall a b:Z, b > 0 -> a = b * (a / b) -> a mod b = 0. -intros a b Hb; generalize (Z_div_mod a b Hb); unfold Zmod, Zdiv in |- *. -case (Zdiv_eucl a b); intros q r; omega. + intros a b Hb; generalize (Z_div_mod a b Hb); unfold Zmod, Zdiv in |- *. + case (Zdiv_eucl a b); intros q r; omega. Qed. Lemma Z_div_exact_2 : forall a b:Z, b > 0 -> a mod b = 0 -> a = b * (a / b). -intros a b Hb; generalize (Z_div_mod a b Hb); unfold Zmod, Zdiv in |- *. -case (Zdiv_eucl a b); intros q r; omega. + intros a b Hb; generalize (Z_div_mod a b Hb); unfold Zmod, Zdiv in |- *. + case (Zdiv_eucl a b); intros q r; omega. Qed. Lemma Z_mod_zero_opp : forall a b:Z, b > 0 -> a mod b = 0 -> - a mod b = 0. -intros a b Hb. -intros. -rewrite Z_div_exact_2 with a b; auto. -replace (- (b * (a / b))) with (0 + - (a / b) * b). -rewrite Z_mod_plus; auto. -ring. + intros a b Hb. + intros. + rewrite Z_div_exact_2 with a b; auto. + replace (- (b * (a / b))) with (0 + - (a / b) * b). + rewrite Z_mod_plus; auto. + ring. Qed. diff --git a/theories/ZArith/Zeven.v b/theories/ZArith/Zeven.v index 72d2d828..6fab4461 100644 --- a/theories/ZArith/Zeven.v +++ b/theories/ZArith/Zeven.v @@ -6,199 +6,203 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Zeven.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Zeven.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import BinInt. -(**********************************************************************) +(*******************************************************************) (** About parity: even and odd predicates on Z, division by 2 on Z *) -(**********************************************************************) -(** [Zeven], [Zodd], [Zdiv2] and their related properties *) +(***************************************************) +(** * [Zeven], [Zodd] and their related properties *) Definition Zeven (z:Z) := match z with - | Z0 => True - | Zpos (xO _) => True - | Zneg (xO _) => True - | _ => False + | Z0 => True + | Zpos (xO _) => True + | Zneg (xO _) => True + | _ => False end. Definition Zodd (z:Z) := match z with - | Zpos xH => True - | Zneg xH => True - | Zpos (xI _) => True - | Zneg (xI _) => True - | _ => False + | Zpos xH => True + | Zneg xH => True + | Zpos (xI _) => True + | Zneg (xI _) => True + | _ => False end. Definition Zeven_bool (z:Z) := match z with - | Z0 => true - | Zpos (xO _) => true - | Zneg (xO _) => true - | _ => false + | Z0 => true + | Zpos (xO _) => true + | Zneg (xO _) => true + | _ => false end. Definition Zodd_bool (z:Z) := match z with - | Z0 => false - | Zpos (xO _) => false - | Zneg (xO _) => false - | _ => true + | Z0 => false + | Zpos (xO _) => false + | Zneg (xO _) => false + | _ => true end. Definition Zeven_odd_dec : forall z:Z, {Zeven z} + {Zodd z}. Proof. intro z. case z; [ left; compute in |- *; trivial - | intro p; case p; intros; - (right; compute in |- *; exact I) || (left; compute in |- *; exact I) - | intro p; case p; intros; - (right; compute in |- *; exact I) || (left; compute in |- *; exact I) ]. + | intro p; case p; intros; + (right; compute in |- *; exact I) || (left; compute in |- *; exact I) + | intro p; case p; intros; + (right; compute in |- *; exact I) || (left; compute in |- *; exact I) ]. Defined. Definition Zeven_dec : forall z:Z, {Zeven z} + {~ Zeven z}. Proof. intro z. case z; [ left; compute in |- *; trivial - | intro p; case p; intros; - (left; compute in |- *; exact I) || (right; compute in |- *; trivial) - | intro p; case p; intros; - (left; compute in |- *; exact I) || (right; compute in |- *; trivial) ]. + | intro p; case p; intros; + (left; compute in |- *; exact I) || (right; compute in |- *; trivial) + | intro p; case p; intros; + (left; compute in |- *; exact I) || (right; compute in |- *; trivial) ]. Defined. Definition Zodd_dec : forall z:Z, {Zodd z} + {~ Zodd z}. Proof. intro z. case z; [ right; compute in |- *; trivial - | intro p; case p; intros; - (left; compute in |- *; exact I) || (right; compute in |- *; trivial) - | intro p; case p; intros; - (left; compute in |- *; exact I) || (right; compute in |- *; trivial) ]. + | intro p; case p; intros; + (left; compute in |- *; exact I) || (right; compute in |- *; trivial) + | intro p; case p; intros; + (left; compute in |- *; exact I) || (right; compute in |- *; trivial) ]. Defined. Lemma Zeven_not_Zodd : forall n:Z, Zeven n -> ~ Zodd n. Proof. intro z; destruct z; [ idtac | destruct p | destruct p ]; compute in |- *; - trivial. + trivial. Qed. Lemma Zodd_not_Zeven : forall n:Z, Zodd n -> ~ Zeven n. Proof. intro z; destruct z; [ idtac | destruct p | destruct p ]; compute in |- *; - trivial. + trivial. Qed. Lemma Zeven_Sn : forall n:Z, Zodd n -> Zeven (Zsucc n). Proof. - intro z; destruct z; unfold Zsucc in |- *; - [ idtac | destruct p | destruct p ]; simpl in |- *; - trivial. - unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto. + intro z; destruct z; unfold Zsucc in |- *; + [ idtac | destruct p | destruct p ]; simpl in |- *; + trivial. + unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto. Qed. Lemma Zodd_Sn : forall n:Z, Zeven n -> Zodd (Zsucc n). Proof. - intro z; destruct z; unfold Zsucc in |- *; - [ idtac | destruct p | destruct p ]; simpl in |- *; - trivial. - unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto. + intro z; destruct z; unfold Zsucc in |- *; + [ idtac | destruct p | destruct p ]; simpl in |- *; + trivial. + unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto. Qed. Lemma Zeven_pred : forall n:Z, Zodd n -> Zeven (Zpred n). Proof. - intro z; destruct z; unfold Zpred in |- *; - [ idtac | destruct p | destruct p ]; simpl in |- *; - trivial. - unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto. + intro z; destruct z; unfold Zpred in |- *; + [ idtac | destruct p | destruct p ]; simpl in |- *; + trivial. + unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto. Qed. Lemma Zodd_pred : forall n:Z, Zeven n -> Zodd (Zpred n). Proof. - intro z; destruct z; unfold Zpred in |- *; - [ idtac | destruct p | destruct p ]; simpl in |- *; - trivial. - unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto. + intro z; destruct z; unfold Zpred in |- *; + [ idtac | destruct p | destruct p ]; simpl in |- *; + trivial. + unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto. Qed. Hint Unfold Zeven Zodd: zarith. -(**********************************************************************) + +(******************************************************************) +(** * Definition of [Zdiv2] and properties wrt [Zeven] and [Zodd] *) + (** [Zdiv2] is defined on all [Z], but notice that for odd negative - integers it is not the euclidean quotient: in that case we have [n = - 2*(n/2)-1] *) + integers it is not the euclidean quotient: in that case we have + [n = 2*(n/2)-1] *) Definition Zdiv2 (z:Z) := match z with - | Z0 => 0%Z - | Zpos xH => 0%Z - | Zpos p => Zpos (Pdiv2 p) - | Zneg xH => 0%Z - | Zneg p => Zneg (Pdiv2 p) + | Z0 => 0%Z + | Zpos xH => 0%Z + | Zpos p => Zpos (Pdiv2 p) + | Zneg xH => 0%Z + | Zneg p => Zneg (Pdiv2 p) end. Lemma Zeven_div2 : forall n:Z, Zeven n -> n = (2 * Zdiv2 n)%Z. Proof. -intro x; destruct x. -auto with arith. -destruct p; auto with arith. -intros. absurd (Zeven (Zpos (xI p))); red in |- *; auto with arith. -intros. absurd (Zeven 1); red in |- *; auto with arith. -destruct p; auto with arith. -intros. absurd (Zeven (Zneg (xI p))); red in |- *; auto with arith. -intros. absurd (Zeven (-1)); red in |- *; auto with arith. + intro x; destruct x. + auto with arith. + destruct p; auto with arith. + intros. absurd (Zeven (Zpos (xI p))); red in |- *; auto with arith. + intros. absurd (Zeven 1); red in |- *; auto with arith. + destruct p; auto with arith. + intros. absurd (Zeven (Zneg (xI p))); red in |- *; auto with arith. + intros. absurd (Zeven (-1)); red in |- *; auto with arith. Qed. Lemma Zodd_div2 : forall n:Z, (n >= 0)%Z -> Zodd n -> n = (2 * Zdiv2 n + 1)%Z. Proof. -intro x; destruct x. -intros. absurd (Zodd 0); red in |- *; auto with arith. -destruct p; auto with arith. -intros. absurd (Zodd (Zpos (xO p))); red in |- *; auto with arith. -intros. absurd (Zneg p >= 0)%Z; red in |- *; auto with arith. + intro x; destruct x. + intros. absurd (Zodd 0); red in |- *; auto with arith. + destruct p; auto with arith. + intros. absurd (Zodd (Zpos (xO p))); red in |- *; auto with arith. + intros. absurd (Zneg p >= 0)%Z; red in |- *; auto with arith. Qed. Lemma Zodd_div2_neg : - forall n:Z, (n <= 0)%Z -> Zodd n -> n = (2 * Zdiv2 n - 1)%Z. + forall n:Z, (n <= 0)%Z -> Zodd n -> n = (2 * Zdiv2 n - 1)%Z. Proof. -intro x; destruct x. -intros. absurd (Zodd 0); red in |- *; auto with arith. -intros. absurd (Zneg p >= 0)%Z; red in |- *; auto with arith. -destruct p; auto with arith. -intros. absurd (Zodd (Zneg (xO p))); red in |- *; auto with arith. + intro x; destruct x. + intros. absurd (Zodd 0); red in |- *; auto with arith. + intros. absurd (Zneg p >= 0)%Z; red in |- *; auto with arith. + destruct p; auto with arith. + intros. absurd (Zodd (Zneg (xO p))); red in |- *; auto with arith. Qed. Lemma Z_modulo_2 : - forall n:Z, {y : Z | n = (2 * y)%Z} + {y : Z | n = (2 * y + 1)%Z}. + forall n:Z, {y : Z | n = (2 * y)%Z} + {y : Z | n = (2 * y + 1)%Z}. Proof. -intros x. -elim (Zeven_odd_dec x); intro. -left. split with (Zdiv2 x). exact (Zeven_div2 x a). -right. generalize b; clear b; case x. -intro b; inversion b. -intro p; split with (Zdiv2 (Zpos p)). apply (Zodd_div2 (Zpos p)); trivial. -unfold Zge, Zcompare in |- *; simpl in |- *; discriminate. -intro p; split with (Zdiv2 (Zpred (Zneg p))). -pattern (Zneg p) at 1 in |- *; rewrite (Zsucc_pred (Zneg p)). -pattern (Zpred (Zneg p)) at 1 in |- *; rewrite (Zeven_div2 (Zpred (Zneg p))). -reflexivity. -apply Zeven_pred; assumption. + intros x. + elim (Zeven_odd_dec x); intro. + left. split with (Zdiv2 x). exact (Zeven_div2 x a). + right. generalize b; clear b; case x. + intro b; inversion b. + intro p; split with (Zdiv2 (Zpos p)). apply (Zodd_div2 (Zpos p)); trivial. + unfold Zge, Zcompare in |- *; simpl in |- *; discriminate. + intro p; split with (Zdiv2 (Zpred (Zneg p))). + pattern (Zneg p) at 1 in |- *; rewrite (Zsucc_pred (Zneg p)). + pattern (Zpred (Zneg p)) at 1 in |- *; rewrite (Zeven_div2 (Zpred (Zneg p))). + reflexivity. + apply Zeven_pred; assumption. Qed. Lemma Zsplit2 : - forall n:Z, - {p : Z * Z | - let (x1, x2) := p in n = (x1 + x2)%Z /\ (x1 = x2 \/ x2 = (x1 + 1)%Z)}. + forall n:Z, + {p : Z * Z | + let (x1, x2) := p in n = (x1 + x2)%Z /\ (x1 = x2 \/ x2 = (x1 + 1)%Z)}. Proof. -intros x. -elim (Z_modulo_2 x); intros [y Hy]; rewrite Zmult_comm in Hy; - rewrite <- Zplus_diag_eq_mult_2 in Hy. -exists (y, y); split. -assumption. -left; reflexivity. -exists (y, (y + 1)%Z); split. -rewrite Zplus_assoc; assumption. -right; reflexivity. -Qed.
\ No newline at end of file + intros x. + elim (Z_modulo_2 x); intros [y Hy]; rewrite Zmult_comm in Hy; + rewrite <- Zplus_diag_eq_mult_2 in Hy. + exists (y, y); split. + assumption. + left; reflexivity. + exists (y, (y + 1)%Z); split. + rewrite Zplus_assoc; assumption. + right; reflexivity. +Qed. + diff --git a/theories/ZArith/Zhints.v b/theories/ZArith/Zhints.v index d0a2d2a0..b8f8ba30 100644 --- a/theories/ZArith/Zhints.v +++ b/theories/ZArith/Zhints.v @@ -6,26 +6,24 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Zhints.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Zhints.v 9245 2006-10-17 12:53:34Z notin $ i*) (** This file centralizes the lemmas about [Z], classifying them according to the way they can be used in automatic search *) -(*i*) +(** Lemmas which clearly leads to simplification during proof search are *) +(** declared as Hints. A definite status (Hint or not) for the other lemmas *) +(** remains to be given *) -(* Lemmas which clearly leads to simplification during proof search are *) -(* declared as Hints. A definite status (Hint or not) for the other lemmas *) -(* remains to be given *) +(** Structure of the file *) +(** - simplification lemmas (only those are declared as Hints) *) +(** - reversible lemmas relating operators *) +(** - useful Bottom-up lemmas *) +(** - irreversible lemmas with meta-variables *) +(** - unclear or too specific lemmas *) +(** - lemmas to be used as rewrite rules *) -(* Structure of the file *) -(* - simplification lemmas (only those are declared as Hints) *) -(* - reversible lemmas relating operators *) -(* - useful Bottom-up lemmas *) -(* - irreversible lemmas with meta-variables *) -(* - unclear or too specific lemmas *) -(* - lemmas to be used as rewrite rules *) - -(* Lemmas involving positive and compare are not taken into account *) +(** Lemmas involving positive and compare are not taken into account *) Require Import BinInt. Require Import Zorder. @@ -37,32 +35,33 @@ Require Import auxiliary. Require Import Zmisc. Require Import Wf_Z. -(**********************************************************************) -(* Simplification lemmas *) -(* No subgoal or smaller subgoals *) +(************************************************************************) +(** * Simplification lemmas *) + +(** No subgoal or smaller subgoals *) Hint Resolve - (* A) Reversible simplification lemmas (no loss of information) *) - (* Should clearly declared as hints *) + (** ** Reversible simplification lemmas (no loss of information) *) + (** Should clearly be declared as hints *) - (* Lemmas ending by eq *) + (** Lemmas ending by eq *) Zsucc_eq_compat (* :(n,m:Z)`n = m`->`(Zs n) = (Zs m)` *) - (* Lemmas ending by Zgt *) + (** Lemmas ending by Zgt *) Zsucc_gt_compat (* :(n,m:Z)`m > n`->`(Zs m) > (Zs n)` *) Zgt_succ (* :(n:Z)`(Zs n) > n` *) Zorder.Zgt_pos_0 (* :(p:positive)`(POS p) > 0` *) Zplus_gt_compat_l (* :(n,m,p:Z)`n > m`->`p+n > p+m` *) Zplus_gt_compat_r (* :(n,m,p:Z)`n > m`->`n+p > m+p` *) - (* Lemmas ending by Zlt *) + (** Lemmas ending by Zlt *) Zlt_succ (* :(n:Z)`n < (Zs n)` *) Zsucc_lt_compat (* :(n,m:Z)`n < m`->`(Zs n) < (Zs m)` *) Zlt_pred (* :(n:Z)`(Zpred n) < n` *) Zplus_lt_compat_l (* :(n,m,p:Z)`n < m`->`p+n < p+m` *) Zplus_lt_compat_r (* :(n,m,p:Z)`n < m`->`n+p < m+p` *) - (* Lemmas ending by Zle *) + (** Lemmas ending by Zle *) Zle_0_nat (* :(n:nat)`0 <= (inject_nat n)` *) Zorder.Zle_0_pos (* :(p:positive)`0 <= (POS p)` *) Zle_refl (* :(n:Z)`n <= n` *) @@ -75,24 +74,24 @@ Hint Resolve Zplus_le_compat_r (* :(a,b,c:Z)`a <= b`->`a+c <= b+c` *) Zabs_pos (* :(x:Z)`0 <= |x|` *) - (* B) Irreversible simplification lemmas : Probably to be declared as *) - (* hints, when no other simplification is possible *) + (** ** Irreversible simplification lemmas *) + (** Probably to be declared as hints, when no other simplification is possible *) - (* Lemmas ending by eq *) + (** Lemmas ending by eq *) BinInt.Z_eq_mult (* :(x,y:Z)`y = 0`->`y*x = 0` *) Zplus_eq_compat (* :(n,m,p,q:Z)`n = m`->`p = q`->`n+p = m+q` *) - (* Lemmas ending by Zge *) + (** Lemmas ending by Zge *) Zorder.Zmult_ge_compat_r (* :(a,b,c:Z)`a >= b`->`c >= 0`->`a*c >= b*c` *) Zorder.Zmult_ge_compat_l (* :(a,b,c:Z)`a >= b`->`c >= 0`->`c*a >= c*b` *) Zorder.Zmult_ge_compat (* : (a,b,c,d:Z)`a >= c`->`b >= d`->`c >= 0`->`d >= 0`->`a*b >= c*d` *) - (* Lemmas ending by Zlt *) + (** Lemmas ending by Zlt *) Zorder.Zmult_gt_0_compat (* :(a,b:Z)`a > 0`->`b > 0`->`a*b > 0` *) Zlt_lt_succ (* :(n,m:Z)`n < m`->`n < (Zs m)` *) - (* Lemmas ending by Zle *) + (** Lemmas ending by Zle *) Zorder.Zmult_le_0_compat (* :(x,y:Z)`0 <= x`->`0 <= y`->`0 <= x*y` *) Zorder.Zmult_le_compat_r (* :(a,b,c:Z)`a <= b`->`0 <= c`->`a*c <= b*c` *) Zorder.Zmult_le_compat_l (* :(a,b,c:Z)`a <= b`->`0 <= c`->`c*a <= c*b` *) @@ -103,68 +102,118 @@ Hint Resolve : zarith. (**********************************************************************) -(* Reversible lemmas relating operators *) -(* Probably to be declared as hints but need to define precedences *) +(** * Reversible lemmas relating operators *) +(** Probably to be declared as hints but need to define precedences *) -(* A) Conversion between comparisons/predicates and arithmetic operators +(** ** Conversion between comparisons/predicates and arithmetic operators *) -(* Lemmas ending by eq *) +(** Lemmas ending by eq *) +(** +<< Zegal_left: (x,y:Z)`x = y`->`x+(-y) = 0` Zabs_eq: (x:Z)`0 <= x`->`|x| = x` Zeven_div2: (x:Z)(Zeven x)->`x = 2*(Zdiv2 x)` Zodd_div2: (x:Z)`x >= 0`->(Zodd x)->`x = 2*(Zdiv2 x)+1` +>> +*) -(* Lemmas ending by Zgt *) +(** Lemmas ending by Zgt *) +(** +<< Zgt_left_rev: (x,y:Z)`x+(-y) > 0`->`x > y` Zgt_left_gt: (x,y:Z)`x > y`->`x+(-y) > 0` +>> +*) -(* Lemmas ending by Zlt *) +(** Lemmas ending by Zlt *) +(** +<< Zlt_left_rev: (x,y:Z)`0 < y+(-x)`->`x < y` Zlt_left_lt: (x,y:Z)`x < y`->`0 < y+(-x)` Zlt_O_minus_lt: (n,m:Z)`0 < n-m`->`m < n` +>> +*) -(* Lemmas ending by Zle *) +(** Lemmas ending by Zle *) +(** +<< Zle_left: (x,y:Z)`x <= y`->`0 <= y+(-x)` Zle_left_rev: (x,y:Z)`0 <= y+(-x)`->`x <= y` Zlt_left: (x,y:Z)`x < y`->`0 <= y+(-1)+(-x)` Zge_left: (x,y:Z)`x >= y`->`0 <= x+(-y)` Zgt_left: (x,y:Z)`x > y`->`0 <= x+(-1)+(-y)` +>> +*) -(* B) Conversion between nat comparisons and Z comparisons *) +(** ** Conversion between nat comparisons and Z comparisons *) -(* Lemmas ending by eq *) +(** Lemmas ending by eq *) +(** +<< inj_eq: (x,y:nat)x=y->`(inject_nat x) = (inject_nat y)` +>> +*) -(* Lemmas ending by Zge *) +(** Lemmas ending by Zge *) +(** +<< inj_ge: (x,y:nat)(ge x y)->`(inject_nat x) >= (inject_nat y)` +>> +*) -(* Lemmas ending by Zgt *) +(** Lemmas ending by Zgt *) +(** +<< inj_gt: (x,y:nat)(gt x y)->`(inject_nat x) > (inject_nat y)` +>> +*) -(* Lemmas ending by Zlt *) +(** Lemmas ending by Zlt *) +(** +<< inj_lt: (x,y:nat)(lt x y)->`(inject_nat x) < (inject_nat y)` +>> +*) -(* Lemmas ending by Zle *) +(** Lemmas ending by Zle *) +(** +<< inj_le: (x,y:nat)(le x y)->`(inject_nat x) <= (inject_nat y)` +>> +*) -(* C) Conversion between comparisons *) +(** ** Conversion between comparisons *) -(* Lemmas ending by Zge *) +(** Lemmas ending by Zge *) +(** +<< not_Zlt: (x,y:Z)~`x < y`->`x >= y` Zle_ge: (m,n:Z)`m <= n`->`n >= m` +>> +*) -(* Lemmas ending by Zgt *) +(** Lemmas ending by Zgt *) +(** +<< Zle_gt_S: (n,p:Z)`n <= p`->`(Zs p) > n` not_Zle: (x,y:Z)~`x <= y`->`x > y` Zlt_gt: (m,n:Z)`m < n`->`n > m` Zle_S_gt: (n,m:Z)`(Zs n) <= m`->`m > n` +>> +*) -(* Lemmas ending by Zlt *) +(** Lemmas ending by Zlt *) +(** +<< not_Zge: (x,y:Z)~`x >= y`->`x < y` Zgt_lt: (m,n:Z)`m > n`->`n < m` Zle_lt_n_Sm: (n,m:Z)`n <= m`->`n < (Zs m)` +>> +*) -(* Lemmas ending by Zle *) +(** Lemmas ending by Zle *) +(** +<< Zlt_ZERO_pred_le_ZERO: (x:Z)`0 < x`->`0 <= (Zpred x)` not_Zgt: (x,y:Z)~`x > y`->`x <= y` Zgt_le_S: (n,p:Z)`p > n`->`(Zs n) <= p` @@ -174,138 +223,226 @@ Zlt_le_S: (n,p:Z)`n < p`->`(Zs n) <= p` Zlt_n_Sm_le: (n,m:Z)`n < (Zs m)`->`n <= m` Zlt_le_weak: (n,m:Z)`n < m`->`n <= m` Zle_refl: (n,m:Z)`n = m`->`n <= m` +>> +*) -(* D) Irreversible simplification involving several comparaisons, *) -(* useful with clear precedences *) +(** ** Irreversible simplification involving several comparaisons *) +(** useful with clear precedences *) -(* Lemmas ending by Zlt *) +(** Lemmas ending by Zlt *) +(** +<< Zlt_le_reg :(a,b,c,d:Z)`a < b`->`c <= d`->`a+c < b+d` Zle_lt_reg : (a,b,c,d:Z)`a <= b`->`c < d`->`a+c < b+d` +>> +*) -(* D) What is decreasing here ? *) +(** ** What is decreasing here ? *) -(* Lemmas ending by eq *) +(** Lemmas ending by eq *) +(** +<< Zplus_minus: (n,m,p:Z)`n = m+p`->`p = n-m` +>> +*) -(* Lemmas ending by Zgt *) +(** Lemmas ending by Zgt *) +(** +<< Zgt_pred: (n,p:Z)`p > (Zs n)`->`(Zpred p) > n` +>> +*) -(* Lemmas ending by Zlt *) +(** Lemmas ending by Zlt *) +(** +<< Zlt_pred: (n,p:Z)`(Zs n) < p`->`n < (Zpred p)` - +>> *) (**********************************************************************) -(* Useful Bottom-up lemmas *) +(** * Useful Bottom-up lemmas *) -(* A) Bottom-up simplification: should be used +(** ** Bottom-up simplification: should be used *) -(* Lemmas ending by eq *) +(** Lemmas ending by eq *) +(** +<< Zeq_add_S: (n,m:Z)`(Zs n) = (Zs m)`->`n = m` Zsimpl_plus_l: (n,m,p:Z)`n+m = n+p`->`m = p` Zplus_unit_left: (n,m:Z)`n+0 = m`->`n = m` Zplus_unit_right: (n,m:Z)`n = m+0`->`n = m` +>> +*) -(* Lemmas ending by Zgt *) +(** Lemmas ending by Zgt *) +(** +<< Zsimpl_gt_plus_l: (n,m,p:Z)`p+n > p+m`->`n > m` Zsimpl_gt_plus_r: (n,m,p:Z)`n+p > m+p`->`n > m` -Zgt_S_n: (n,p:Z)`(Zs p) > (Zs n)`->`p > n` +Zgt_S_n: (n,p:Z)`(Zs p) > (Zs n)`->`p > n` +>> +*) -(* Lemmas ending by Zlt *) +(** Lemmas ending by Zlt *) +(** +<< Zsimpl_lt_plus_l: (n,m,p:Z)`p+n < p+m`->`n < m` Zsimpl_lt_plus_r: (n,m,p:Z)`n+p < m+p`->`n < m` -Zlt_S_n: (n,m:Z)`(Zs n) < (Zs m)`->`n < m` +Zlt_S_n: (n,m:Z)`(Zs n) < (Zs m)`->`n < m` +>> +*) -(* Lemmas ending by Zle *) -Zsimpl_le_plus_l: (p,n,m:Z)`p+n <= p+m`->`n <= m` +(** Lemmas ending by Zle *) +(** << Zsimpl_le_plus_l: (p,n,m:Z)`p+n <= p+m`->`n <= m` Zsimpl_le_plus_r: (p,n,m:Z)`n+p <= m+p`->`n <= m` -Zle_S_n: (n,m:Z)`(Zs m) <= (Zs n)`->`m <= n` +Zle_S_n: (n,m:Z)`(Zs m) <= (Zs n)`->`m <= n` >> *) -(* B) Bottom-up irreversible (syntactic) simplification *) +(** ** Bottom-up irreversible (syntactic) simplification *) -(* Lemmas ending by Zle *) +(** Lemmas ending by Zle *) +(** +<< Zle_trans_S: (n,m:Z)`(Zs n) <= m`->`n <= m` +>> +*) -(* C) Other unclearly simplifying lemmas *) +(** ** Other unclearly simplifying lemmas *) -(* Lemmas ending by Zeq *) -Zmult_eq: (x,y:Z)`x <> 0`->`y*x = 0`->`y = 0` +(** Lemmas ending by Zeq *) +(** +<< +Zmult_eq: (x,y:Z)`x <> 0`->`y*x = 0`->`y = 0` +>> +*) (* Lemmas ending by Zgt *) +(** +<< Zmult_gt: (x,y:Z)`x > 0`->`x*y > 0`->`y > 0` +>> +*) (* Lemmas ending by Zlt *) +(** +<< pZmult_lt: (x,y:Z)`x > 0`->`0 < y*x`->`0 < y` +>> +*) (* Lemmas ending by Zle *) +(** +<< Zmult_le: (x,y:Z)`x > 0`->`0 <= y*x`->`0 <= y` OMEGA1: (x,y:Z)`x = y`->`0 <= x`->`0 <= y` +>> *) + (**********************************************************************) -(* Irreversible lemmas with meta-variables *) -(* To be used by EAuto +(** * Irreversible lemmas with meta-variables *) +(** To be used by EAuto *) -Hints Immediate -(* Lemmas ending by eq *) +(* Hints Immediate *) +(** Lemmas ending by eq *) +(** +<< Zle_antisym: (n,m:Z)`n <= m`->`m <= n`->`n = m` +>> +*) -(* Lemmas ending by Zge *) +(** Lemmas ending by Zge *) +(** +<< Zge_trans: (n,m,p:Z)`n >= m`->`m >= p`->`n >= p` +>> +*) -(* Lemmas ending by Zgt *) +(** Lemmas ending by Zgt *) +(** +<< Zgt_trans: (n,m,p:Z)`n > m`->`m > p`->`n > p` Zgt_trans_S: (n,m,p:Z)`(Zs n) > m`->`m > p`->`n > p` Zle_gt_trans: (n,m,p:Z)`m <= n`->`m > p`->`n > p` Zgt_le_trans: (n,m,p:Z)`n > m`->`p <= m`->`n > p` +>> +*) -(* Lemmas ending by Zlt *) +(** Lemmas ending by Zlt *) +(** +<< Zlt_trans: (n,m,p:Z)`n < m`->`m < p`->`n < p` Zlt_le_trans: (n,m,p:Z)`n < m`->`m <= p`->`n < p` Zle_lt_trans: (n,m,p:Z)`n <= m`->`m < p`->`n < p` +>> +*) -(* Lemmas ending by Zle *) +(** Lemmas ending by Zle *) +(** +<< Zle_trans: (n,m,p:Z)`n <= m`->`m <= p`->`n <= p` +>> *) + (**********************************************************************) -(* Unclear or too specific lemmas *) -(* Not to be used ?? *) +(** * Unclear or too specific lemmas *) +(** Not to be used ? *) -(* A) Irreversible and too specific (not enough regular) +(** ** Irreversible and too specific (not enough regular) *) -(* Lemmas ending by Zle *) +(** Lemmas ending by Zle *) +(** +<< Zle_mult: (x,y:Z)`x > 0`->`0 <= y`->`0 <= y*x` Zle_mult_approx: (x,y,z:Z)`x > 0`->`z > 0`->`0 <= y`->`0 <= y*x+z` OMEGA6: (x,y,z:Z)`0 <= x`->`y = 0`->`0 <= x+y*z` OMEGA7: (x,y,z,t:Z)`z > 0`->`t > 0`->`0 <= x`->`0 <= y`->`0 <= x*z+y*t` +>> +*) +(** ** Expansion and too specific ? *) -(* B) Expansion and too specific ? *) - -(* Lemmas ending by Zge *) +(** Lemmas ending by Zge *) +(** +<< Zge_mult_simpl: (a,b,c:Z)`c > 0`->`a*c >= b*c`->`a >= b` +>> +*) -(* Lemmas ending by Zgt *) +(** Lemmas ending by Zgt *) +(** +<< Zgt_mult_simpl: (a,b,c:Z)`c > 0`->`a*c > b*c`->`a > b` Zgt_square_simpl: (x,y:Z)`x >= 0`->`y >= 0`->`x*x > y*y`->`x > y` +>> +*) -(* Lemmas ending by Zle *) +(** Lemmas ending by Zle *) +(** +<< Zle_mult_simpl: (a,b,c:Z)`c > 0`->`a*c <= b*c`->`a <= b` Zmult_le_approx: (x,y,z:Z)`x > 0`->`x > z`->`0 <= y*x+z`->`0 <= y` +>> +*) -(* C) Reversible but too specific ? *) +(** ** Reversible but too specific ? *) -(* Lemmas ending by Zlt *) +(** Lemmas ending by Zlt *) +(** +<< Zlt_minus: (n,m:Z)`0 < m`->`n-m < n` +>> *) (**********************************************************************) -(* Lemmas to be used as rewrite rules *) -(* but can also be used as hints +(** * Lemmas to be used as rewrite rules *) +(** but can also be used as hints *) -(* Left-to-right simplification lemmas (a symbol disappears) *) +(** Left-to-right simplification lemmas (a symbol disappears) *) +(** +<< Zcompare_n_S: (n,m:Z)(Zcompare (Zs n) (Zs m))=(Zcompare n m) Zmin_n_n: (n:Z)`(Zmin n n) = n` Zmult_1_n: (n:Z)`1*n = n` @@ -322,9 +459,13 @@ Zmult_one: (x:Z)`1*x = x` Zero_mult_left: (x:Z)`0*x = 0` Zero_mult_right: (x:Z)`x*0 = 0` Zmult_Zopp_Zopp: (x,y:Z)`(-x)*(-y) = x*y` +>> +*) -(* Right-to-left simplification lemmas (a symbol disappears) *) +(** Right-to-left simplification lemmas (a symbol disappears) *) +(** +<< Zpred_Sn: (m:Z)`m = (Zpred (Zs m))` Zs_pred: (n:Z)`n = (Zs (Zpred n))` Zplus_n_O: (n:Z)`n = n+0` @@ -333,9 +474,13 @@ Zminus_n_O: (n:Z)`n = n-0` Zminus_n_n: (n:Z)`0 = n-n` Zred_factor6: (x:Z)`x = x+0` Zred_factor0: (x:Z)`x = x*1` +>> +*) -(* Unclear orientation (no symbol disappears) *) +(** Unclear orientation (no symbol disappears) *) +(** +<< Zplus_n_Sm: (n,m:Z)`(Zs (n+m)) = n+(Zs m)` Zmult_n_Sm: (n,m:Z)`n*m+n = n*(Zs m)` Zmin_SS: (n,m:Z)`(Zs (Zmin n m)) = (Zmin (Zs n) (Zs m))` @@ -370,17 +515,25 @@ Zred_factor3: (x,y:Z)`x*y+x = x*(1+y)` Zred_factor4: (x,y,z:Z)`x*y+x*z = x*(y+z)` Zminus_Zplus_compatible: (x,y,n:Z)`x+n-(y+n) = x-y` Zmin_plus: (x,y,n:Z)`(Zmin (x+n) (y+n)) = (Zmin x y)+n` +>> +*) -(* nat <-> Z *) +(** nat <-> Z *) +(** +<< inj_S: (y:nat)`(inject_nat (S y)) = (Zs (inject_nat y))` inj_plus: (x,y:nat)`(inject_nat (plus x y)) = (inject_nat x)+(inject_nat y)` inj_mult: (x,y:nat)`(inject_nat (mult x y)) = (inject_nat x)*(inject_nat y)` inj_minus1: (x,y:nat)(le y x)->`(inject_nat (minus x y)) = (inject_nat x)-(inject_nat y)` inj_minus2: (x,y:nat)(gt y x)->`(inject_nat (minus x y)) = 0` +>> +*) -(* Too specific ? *) +(** Too specific ? *) +(** +<< Zred_factor5: (x,y:Z)`x*0+y = y` +>> *) -(*i*)
\ No newline at end of file diff --git a/theories/ZArith/Zlogarithm.v b/theories/ZArith/Zlogarithm.v index 653ee951..d8f4f236 100644 --- a/theories/ZArith/Zlogarithm.v +++ b/theories/ZArith/Zlogarithm.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Zlogarithm.v 6295 2004-11-12 16:40:39Z gregoire $ i*) +(*i $Id: Zlogarithm.v 9245 2006-10-17 12:53:34Z notin $ i*) (**********************************************************************) (** The integer logarithms with base 2. @@ -27,235 +27,221 @@ Require Import Zpower. Open Local Scope Z_scope. Section Log_pos. (* Log of positive integers *) - -(** First we build [log_inf] and [log_sup] *) - -Fixpoint log_inf (p:positive) : Z := - match p with - | xH => 0 (* 1 *) - | xO q => Zsucc (log_inf q) (* 2n *) - | xI q => Zsucc (log_inf q) (* 2n+1 *) - end. - -Fixpoint log_sup (p:positive) : Z := - match p with - | xH => 0 (* 1 *) - | xO n => Zsucc (log_sup n) (* 2n *) - | xI n => Zsucc (Zsucc (log_inf n)) (* 2n+1 *) - end. - -Hint Unfold log_inf log_sup. - -(** Then we give the specifications of [log_inf] and [log_sup] + + (** First we build [log_inf] and [log_sup] *) + + Fixpoint log_inf (p:positive) : Z := + match p with + | xH => 0 (* 1 *) + | xO q => Zsucc (log_inf q) (* 2n *) + | xI q => Zsucc (log_inf q) (* 2n+1 *) + end. + + Fixpoint log_sup (p:positive) : Z := + match p with + | xH => 0 (* 1 *) + | xO n => Zsucc (log_sup n) (* 2n *) + | xI n => Zsucc (Zsucc (log_inf n)) (* 2n+1 *) + end. + + Hint Unfold log_inf log_sup. + + (** Then we give the specifications of [log_inf] and [log_sup] and prove their validity *) - -(*i Hints Resolve ZERO_le_S : zarith. i*) -Hint Resolve Zle_trans: zarith. - -Theorem log_inf_correct : - forall x:positive, - 0 <= log_inf x /\ two_p (log_inf x) <= Zpos x < two_p (Zsucc (log_inf x)). -simple induction x; intros; simpl in |- *; - [ elim H; intros Hp HR; clear H; split; - [ auto with zarith - | conditional apply Zle_le_succ; trivial rewrite - two_p_S with (x := Zsucc (log_inf p)); - conditional trivial rewrite two_p_S; - conditional trivial rewrite two_p_S in HR; rewrite (BinInt.Zpos_xI p); - omega ] - | elim H; intros Hp HR; clear H; split; - [ auto with zarith - | conditional apply Zle_le_succ; trivial rewrite - two_p_S with (x := Zsucc (log_inf p)); - conditional trivial rewrite two_p_S; - conditional trivial rewrite two_p_S in HR; rewrite (BinInt.Zpos_xO p); - omega ] - | unfold two_power_pos in |- *; unfold shift_pos in |- *; simpl in |- *; - omega ]. -Qed. - -Definition log_inf_correct1 (p:positive) := proj1 (log_inf_correct p). -Definition log_inf_correct2 (p:positive) := proj2 (log_inf_correct p). - -Opaque log_inf_correct1 log_inf_correct2. - -Hint Resolve log_inf_correct1 log_inf_correct2: zarith. - -Lemma log_sup_correct1 : forall p:positive, 0 <= log_sup p. -simple induction p; intros; simpl in |- *; auto with zarith. -Qed. - -(** For every [p], either [p] is a power of two and [(log_inf p)=(log_sup p)] - either [(log_sup p)=(log_inf p)+1] *) - -Theorem log_sup_log_inf : - forall p:positive, - IF Zpos p = two_p (log_inf p) then Zpos p = two_p (log_sup p) - else log_sup p = Zsucc (log_inf p). - -simple induction p; intros; - [ elim H; right; simpl in |- *; - rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0)); - rewrite BinInt.Zpos_xI; unfold Zsucc in |- *; omega - | elim H; clear H; intro Hif; - [ left; simpl in |- *; - rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0)); - rewrite (two_p_S (log_sup p0) (log_sup_correct1 p0)); - rewrite <- (proj1 Hif); rewrite <- (proj2 Hif); - auto - | right; simpl in |- *; - rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0)); - rewrite BinInt.Zpos_xO; unfold Zsucc in |- *; - omega ] - | left; auto ]. -Qed. - -Theorem log_sup_correct2 : - forall x:positive, two_p (Zpred (log_sup x)) < Zpos x <= two_p (log_sup x). - -intro. -elim (log_sup_log_inf x). -(* x is a power of two and [log_sup = log_inf] *) -intros [E1 E2]; rewrite E2. -split; [ apply two_p_pred; apply log_sup_correct1 | apply Zle_refl ]. -intros [E1 E2]; rewrite E2. -rewrite <- (Zpred_succ (log_inf x)). -generalize (log_inf_correct2 x); omega. -Qed. - -Lemma log_inf_le_log_sup : forall p:positive, log_inf p <= log_sup p. -simple induction p; simpl in |- *; intros; omega. -Qed. - -Lemma log_sup_le_Slog_inf : forall p:positive, log_sup p <= Zsucc (log_inf p). -simple induction p; simpl in |- *; intros; omega. -Qed. - -(** Now it's possible to specify and build the [Log] rounded to the nearest *) - -Fixpoint log_near (x:positive) : Z := - match x with - | xH => 0 - | xO xH => 1 - | xI xH => 2 - | xO y => Zsucc (log_near y) - | xI y => Zsucc (log_near y) - end. - -Theorem log_near_correct1 : forall p:positive, 0 <= log_near p. -simple induction p; simpl in |- *; intros; - [ elim p0; auto with zarith - | elim p0; auto with zarith - | trivial with zarith ]. -intros; apply Zle_le_succ. -generalize H0; elim p1; intros; simpl in |- *; - [ assumption | assumption | apply Zorder.Zle_0_pos ]. -intros; apply Zle_le_succ. -generalize H0; elim p1; intros; simpl in |- *; - [ assumption | assumption | apply Zorder.Zle_0_pos ]. -Qed. - -Theorem log_near_correct2 : - forall p:positive, log_near p = log_inf p \/ log_near p = log_sup p. -simple induction p. -intros p0 [Einf| Esup]. -simpl in |- *. rewrite Einf. -case p0; [ left | left | right ]; reflexivity. -simpl in |- *; rewrite Esup. -elim (log_sup_log_inf p0). -generalize (log_inf_le_log_sup p0). -generalize (log_sup_le_Slog_inf p0). -case p0; auto with zarith. -intros; omega. -case p0; intros; auto with zarith. -intros p0 [Einf| Esup]. -simpl in |- *. -repeat rewrite Einf. -case p0; intros; auto with zarith. -simpl in |- *. -repeat rewrite Esup. -case p0; intros; auto with zarith. -auto. -Qed. - -(*i****************** -Theorem log_near_correct: (p:positive) - `| (two_p (log_near p)) - (POS p) | <= (POS p)-(two_p (log_inf p))` - /\`| (two_p (log_near p)) - (POS p) | <= (two_p (log_sup p))-(POS p)`. -Intro. -Induction p. -Intros p0 [(Einf1,Einf2)|(Esup1,Esup2)]. -Unfold log_near log_inf log_sup. Fold log_near log_inf log_sup. -Rewrite Einf1. -Repeat Rewrite two_p_S. -Case p0; [Left | Left | Right]. - -Split. -Simpl. -Rewrite E1; Case p0; Try Reflexivity. -Compute. -Unfold log_near; Fold log_near. -Unfold log_inf; Fold log_inf. -Repeat Rewrite E1. -Split. -**********************************i*) + + Hint Resolve Zle_trans: zarith. + + Theorem log_inf_correct : + forall x:positive, + 0 <= log_inf x /\ two_p (log_inf x) <= Zpos x < two_p (Zsucc (log_inf x)). + simple induction x; intros; simpl in |- *; + [ elim H; intros Hp HR; clear H; split; + [ auto with zarith + | conditional apply Zle_le_succ; trivial rewrite + two_p_S with (x := Zsucc (log_inf p)); + conditional trivial rewrite two_p_S; + conditional trivial rewrite two_p_S in HR; rewrite (BinInt.Zpos_xI p); + omega ] + | elim H; intros Hp HR; clear H; split; + [ auto with zarith + | conditional apply Zle_le_succ; trivial rewrite + two_p_S with (x := Zsucc (log_inf p)); + conditional trivial rewrite two_p_S; + conditional trivial rewrite two_p_S in HR; rewrite (BinInt.Zpos_xO p); + omega ] + | unfold two_power_pos in |- *; unfold shift_pos in |- *; simpl in |- *; + omega ]. + Qed. + + Definition log_inf_correct1 (p:positive) := proj1 (log_inf_correct p). + Definition log_inf_correct2 (p:positive) := proj2 (log_inf_correct p). + + Opaque log_inf_correct1 log_inf_correct2. + + Hint Resolve log_inf_correct1 log_inf_correct2: zarith. + + Lemma log_sup_correct1 : forall p:positive, 0 <= log_sup p. + Proof. + simple induction p; intros; simpl in |- *; auto with zarith. + Qed. + + (** For every [p], either [p] is a power of two and [(log_inf p)=(log_sup p)] + either [(log_sup p)=(log_inf p)+1] *) + + Theorem log_sup_log_inf : + forall p:positive, + IF Zpos p = two_p (log_inf p) then Zpos p = two_p (log_sup p) + else log_sup p = Zsucc (log_inf p). + Proof. + simple induction p; intros; + [ elim H; right; simpl in |- *; + rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0)); + rewrite BinInt.Zpos_xI; unfold Zsucc in |- *; omega + | elim H; clear H; intro Hif; + [ left; simpl in |- *; + rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0)); + rewrite (two_p_S (log_sup p0) (log_sup_correct1 p0)); + rewrite <- (proj1 Hif); rewrite <- (proj2 Hif); + auto + | right; simpl in |- *; + rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0)); + rewrite BinInt.Zpos_xO; unfold Zsucc in |- *; + omega ] + | left; auto ]. + Qed. + + Theorem log_sup_correct2 : + forall x:positive, two_p (Zpred (log_sup x)) < Zpos x <= two_p (log_sup x). + Proof. + intro. + elim (log_sup_log_inf x). + (* x is a power of two and [log_sup = log_inf] *) + intros [E1 E2]; rewrite E2. + split; [ apply two_p_pred; apply log_sup_correct1 | apply Zle_refl ]. + intros [E1 E2]; rewrite E2. + rewrite <- (Zpred_succ (log_inf x)). + generalize (log_inf_correct2 x); omega. + Qed. + + Lemma log_inf_le_log_sup : forall p:positive, log_inf p <= log_sup p. + Proof. + simple induction p; simpl in |- *; intros; omega. + Qed. + + Lemma log_sup_le_Slog_inf : forall p:positive, log_sup p <= Zsucc (log_inf p). + Proof. + simple induction p; simpl in |- *; intros; omega. + Qed. + + (** Now it's possible to specify and build the [Log] rounded to the nearest *) + + Fixpoint log_near (x:positive) : Z := + match x with + | xH => 0 + | xO xH => 1 + | xI xH => 2 + | xO y => Zsucc (log_near y) + | xI y => Zsucc (log_near y) + end. + + Theorem log_near_correct1 : forall p:positive, 0 <= log_near p. + Proof. + simple induction p; simpl in |- *; intros; + [ elim p0; auto with zarith + | elim p0; auto with zarith + | trivial with zarith ]. + intros; apply Zle_le_succ. + generalize H0; elim p1; intros; simpl in |- *; + [ assumption | assumption | apply Zorder.Zle_0_pos ]. + intros; apply Zle_le_succ. + generalize H0; elim p1; intros; simpl in |- *; + [ assumption | assumption | apply Zorder.Zle_0_pos ]. + Qed. + + Theorem log_near_correct2 : + forall p:positive, log_near p = log_inf p \/ log_near p = log_sup p. + Proof. + simple induction p. + intros p0 [Einf| Esup]. + simpl in |- *. rewrite Einf. + case p0; [ left | left | right ]; reflexivity. + simpl in |- *; rewrite Esup. + elim (log_sup_log_inf p0). + generalize (log_inf_le_log_sup p0). + generalize (log_sup_le_Slog_inf p0). + case p0; auto with zarith. + intros; omega. + case p0; intros; auto with zarith. + intros p0 [Einf| Esup]. + simpl in |- *. + repeat rewrite Einf. + case p0; intros; auto with zarith. + simpl in |- *. + repeat rewrite Esup. + case p0; intros; auto with zarith. + auto. + Qed. End Log_pos. Section divers. -(** Number of significative digits. *) - -Definition N_digits (x:Z) := - match x with - | Zpos p => log_inf p - | Zneg p => log_inf p - | Z0 => 0 - end. - -Lemma ZERO_le_N_digits : forall x:Z, 0 <= N_digits x. -simple induction x; simpl in |- *; - [ apply Zle_refl | exact log_inf_correct1 | exact log_inf_correct1 ]. -Qed. - -Lemma log_inf_shift_nat : forall n:nat, log_inf (shift_nat n 1) = Z_of_nat n. -simple induction n; intros; - [ try trivial | rewrite Znat.inj_S; rewrite <- H; reflexivity ]. -Qed. - -Lemma log_sup_shift_nat : forall n:nat, log_sup (shift_nat n 1) = Z_of_nat n. -simple induction n; intros; - [ try trivial | rewrite Znat.inj_S; rewrite <- H; reflexivity ]. -Qed. - -(** [Is_power p] means that p is a power of two *) -Fixpoint Is_power (p:positive) : Prop := - match p with - | xH => True - | xO q => Is_power q - | xI q => False - end. - -Lemma Is_power_correct : - forall p:positive, Is_power p <-> (exists y : nat, p = shift_nat y 1). - -split; - [ elim p; - [ simpl in |- *; tauto - | simpl in |- *; intros; generalize (H H0); intro H1; elim H1; - intros y0 Hy0; exists (S y0); rewrite Hy0; reflexivity - | intro; exists 0%nat; reflexivity ] - | intros; elim H; intros; rewrite H0; elim x; intros; simpl in |- *; trivial ]. -Qed. - -Lemma Is_power_or : forall p:positive, Is_power p \/ ~ Is_power p. -simple induction p; - [ intros; right; simpl in |- *; tauto - | intros; elim H; - [ intros; left; simpl in |- *; exact H0 - | intros; right; simpl in |- *; exact H0 ] - | left; simpl in |- *; trivial ]. -Qed. + (** Number of significative digits. *) + + Definition N_digits (x:Z) := + match x with + | Zpos p => log_inf p + | Zneg p => log_inf p + | Z0 => 0 + end. + + Lemma ZERO_le_N_digits : forall x:Z, 0 <= N_digits x. + Proof. + simple induction x; simpl in |- *; + [ apply Zle_refl | exact log_inf_correct1 | exact log_inf_correct1 ]. + Qed. + + Lemma log_inf_shift_nat : forall n:nat, log_inf (shift_nat n 1) = Z_of_nat n. + Proof. + simple induction n; intros; + [ try trivial | rewrite Znat.inj_S; rewrite <- H; reflexivity ]. + Qed. + + Lemma log_sup_shift_nat : forall n:nat, log_sup (shift_nat n 1) = Z_of_nat n. + Proof. + simple induction n; intros; + [ try trivial | rewrite Znat.inj_S; rewrite <- H; reflexivity ]. + Qed. + + (** [Is_power p] means that p is a power of two *) + Fixpoint Is_power (p:positive) : Prop := + match p with + | xH => True + | xO q => Is_power q + | xI q => False + end. + + Lemma Is_power_correct : + forall p:positive, Is_power p <-> (exists y : nat, p = shift_nat y 1). + Proof. + split; + [ elim p; + [ simpl in |- *; tauto + | simpl in |- *; intros; generalize (H H0); intro H1; elim H1; + intros y0 Hy0; exists (S y0); rewrite Hy0; reflexivity + | intro; exists 0%nat; reflexivity ] + | intros; elim H; intros; rewrite H0; elim x; intros; simpl in |- *; trivial ]. + Qed. + + Lemma Is_power_or : forall p:positive, Is_power p \/ ~ Is_power p. + Proof. + simple induction p; + [ intros; right; simpl in |- *; tauto + | intros; elim H; + [ intros; left; simpl in |- *; exact H0 + | intros; right; simpl in |- *; exact H0 ] + | left; simpl in |- *; trivial ]. + Qed. End divers. diff --git a/theories/ZArith/Zmax.v b/theories/ZArith/Zmax.v index ae3bbf41..8af9b891 100644 --- a/theories/ZArith/Zmax.v +++ b/theories/ZArith/Zmax.v @@ -5,104 +5,104 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Zmax.v 8032 2006-02-12 21:20:48Z herbelin $ i*) +(*i $Id: Zmax.v 9302 2006-10-27 21:21:17Z barras $ i*) -Require Import Arith. +Require Import Arith_base. Require Import BinInt. Require Import Zcompare. Require Import Zorder. Open Local Scope Z_scope. -(**********************************************************************) -(** *** Maximum of two binary integer numbers *) +(******************************************) +(** Maximum of two binary integer numbers *) Definition Zmax m n := - match m ?= n with + match m ?= n with | Eq | Gt => m | Lt => n - end. + end. -(** Characterization of maximum on binary integer numbers *) +(** * Characterization of maximum on binary integer numbers *) Lemma Zmax_case : forall (n m:Z) (P:Z -> Type), P n -> P m -> P (Zmax n m). Proof. -intros n m P H1 H2; unfold Zmax in |- *; case (n ?= m); auto with arith. + intros n m P H1 H2; unfold Zmax in |- *; case (n ?= m); auto with arith. Qed. Lemma Zmax_case_strong : forall (n m:Z) (P:Z -> Type), (m<=n -> P n) -> (n<=m -> P m) -> P (Zmax n m). Proof. -intros n m P H1 H2; unfold Zmax, Zle, Zge in *. -rewrite <- (Zcompare_antisym n m) in H1. -destruct (n ?= m); (apply H1|| apply H2); discriminate. + intros n m P H1 H2; unfold Zmax, Zle, Zge in *. + rewrite <- (Zcompare_antisym n m) in H1. + destruct (n ?= m); (apply H1|| apply H2); discriminate. Qed. -(** Least upper bound properties of max *) +(** * Least upper bound properties of max *) Lemma Zle_max_l : forall n m:Z, n <= Zmax n m. Proof. -intros; apply Zmax_case_strong; auto with zarith. + intros; apply Zmax_case_strong; auto with zarith. Qed. Notation Zmax1 := Zle_max_l (only parsing). Lemma Zle_max_r : forall n m:Z, m <= Zmax n m. Proof. -intros; apply Zmax_case_strong; auto with zarith. + intros; apply Zmax_case_strong; auto with zarith. Qed. Notation Zmax2 := Zle_max_r (only parsing). Lemma Zmax_lub : forall n m p:Z, n <= p -> m <= p -> Zmax n m <= p. Proof. -intros; apply Zmax_case; assumption. + intros; apply Zmax_case; assumption. Qed. -(** Semi-lattice properties of max *) +(** * Semi-lattice properties of max *) Lemma Zmax_idempotent : forall n:Z, Zmax n n = n. Proof. -intros; apply Zmax_case; auto. + intros; apply Zmax_case; auto. Qed. Lemma Zmax_comm : forall n m:Z, Zmax n m = Zmax m n. Proof. -intros; do 2 apply Zmax_case_strong; intros; - apply Zle_antisym; auto with zarith. + intros; do 2 apply Zmax_case_strong; intros; + apply Zle_antisym; auto with zarith. Qed. Lemma Zmax_assoc : forall n m p:Z, Zmax n (Zmax m p) = Zmax (Zmax n m) p. Proof. -intros n m p; repeat apply Zmax_case_strong; intros; - reflexivity || (try apply Zle_antisym); eauto with zarith. + intros n m p; repeat apply Zmax_case_strong; intros; + reflexivity || (try apply Zle_antisym); eauto with zarith. Qed. -(** Additional properties of max *) +(** * Additional properties of max *) Lemma Zmax_irreducible_inf : forall n m:Z, Zmax n m = n \/ Zmax n m = m. Proof. -intros; apply Zmax_case; auto. + intros; apply Zmax_case; auto. Qed. Lemma Zmax_le_prime_inf : forall n m p:Z, p <= Zmax n m -> p <= n \/ p <= m. Proof. -intros n m p; apply Zmax_case; auto. + intros n m p; apply Zmax_case; auto. Qed. -(** Operations preserving max *) +(** * Operations preserving max *) Lemma Zsucc_max_distr : forall n m:Z, Zsucc (Zmax n m) = Zmax (Zsucc n) (Zsucc m). Proof. -intros n m; unfold Zmax in |- *; rewrite (Zcompare_succ_compat n m); - elim_compare n m; intros E; rewrite E; auto with arith. + intros n m; unfold Zmax in |- *; rewrite (Zcompare_succ_compat n m); + elim_compare n m; intros E; rewrite E; auto with arith. Qed. Lemma Zplus_max_distr_r : forall n m p:Z, Zmax (n + p) (m + p) = Zmax n m + p. Proof. -intros x y n; unfold Zmax in |- *. -rewrite (Zplus_comm x n); rewrite (Zplus_comm y n); - rewrite (Zcompare_plus_compat x y n). -case (x ?= y); apply Zplus_comm. + intros x y n; unfold Zmax in |- *. + rewrite (Zplus_comm x n); rewrite (Zplus_comm y n); + rewrite (Zcompare_plus_compat x y n). + case (x ?= y); apply Zplus_comm. Qed. diff --git a/theories/ZArith/Zmin.v b/theories/ZArith/Zmin.v index d79ebe98..37d78a74 100644 --- a/theories/ZArith/Zmin.v +++ b/theories/ZArith/Zmin.v @@ -5,126 +5,126 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Zmin.v 8032 2006-02-12 21:20:48Z herbelin $ i*) +(*i $Id: Zmin.v 9302 2006-10-27 21:21:17Z barras $ i*) (** Initial version from Pierre Crégut (CNET, Lannion, France), 1996. Further extensions by the Coq development team, with suggestions from Russell O'Connor (Radbout U., Nijmegen, The Netherlands). *) -Require Import Arith. +Require Import Arith_base. Require Import BinInt. Require Import Zcompare. Require Import Zorder. Open Local Scope Z_scope. -(**********************************************************************) -(** *** Minimum on binary integer numbers *) +(**************************************) +(** Minimum on binary integer numbers *) Unboxed Definition Zmin (n m:Z) := match n ?= m with - | Eq | Lt => n - | Gt => m + | Eq | Lt => n + | Gt => m end. -(** Characterization of the minimum on binary integer numbers *) +(** * Characterization of the minimum on binary integer numbers *) Lemma Zmin_case_strong : forall (n m:Z) (P:Z -> Type), (n<=m -> P n) -> (m<=n -> P m) -> P (Zmin n m). Proof. -intros n m P H1 H2; unfold Zmin, Zle, Zge in *. -rewrite <- (Zcompare_antisym n m) in H2. -destruct (n ?= m); (apply H1|| apply H2); discriminate. + intros n m P H1 H2; unfold Zmin, Zle, Zge in *. + rewrite <- (Zcompare_antisym n m) in H2. + destruct (n ?= m); (apply H1|| apply H2); discriminate. Qed. Lemma Zmin_case : forall (n m:Z) (P:Z -> Type), P n -> P m -> P (Zmin n m). Proof. -intros n m P H1 H2; unfold Zmin in |- *; case (n ?= m); auto with arith. + intros n m P H1 H2; unfold Zmin in |- *; case (n ?= m); auto with arith. Qed. -(** Greatest lower bound properties of min *) +(** * Greatest lower bound properties of min *) Lemma Zle_min_l : forall n m:Z, Zmin n m <= n. Proof. -intros n m; unfold Zmin in |- *; elim_compare n m; intros E; rewrite E; - [ apply Zle_refl - | apply Zle_refl - | apply Zlt_le_weak; apply Zgt_lt; exact E ]. + intros n m; unfold Zmin in |- *; elim_compare n m; intros E; rewrite E; + [ apply Zle_refl + | apply Zle_refl + | apply Zlt_le_weak; apply Zgt_lt; exact E ]. Qed. Lemma Zle_min_r : forall n m:Z, Zmin n m <= m. Proof. -intros n m; unfold Zmin in |- *; elim_compare n m; intros E; rewrite E; - [ unfold Zle in |- *; rewrite E; discriminate - | unfold Zle in |- *; rewrite E; discriminate - | apply Zle_refl ]. + intros n m; unfold Zmin in |- *; elim_compare n m; intros E; rewrite E; + [ unfold Zle in |- *; rewrite E; discriminate + | unfold Zle in |- *; rewrite E; discriminate + | apply Zle_refl ]. Qed. Lemma Zmin_glb : forall n m p:Z, p <= n -> p <= m -> p <= Zmin n m. Proof. -intros; apply Zmin_case; assumption. + intros; apply Zmin_case; assumption. Qed. -(** Semi-lattice properties of min *) +(** * Semi-lattice properties of min *) Lemma Zmin_idempotent : forall n:Z, Zmin n n = n. Proof. -unfold Zmin in |- *; intros; elim (n ?= n); auto. + unfold Zmin in |- *; intros; elim (n ?= n); auto. Qed. Notation Zmin_n_n := Zmin_idempotent (only parsing). Lemma Zmin_comm : forall n m:Z, Zmin n m = Zmin m n. Proof. -intros n m; unfold Zmin. -rewrite <- (Zcompare_antisym n m). -assert (H:=Zcompare_Eq_eq n m). -destruct (n ?= m); simpl; auto. + intros n m; unfold Zmin. + rewrite <- (Zcompare_antisym n m). + assert (H:=Zcompare_Eq_eq n m). + destruct (n ?= m); simpl; auto. Qed. Lemma Zmin_assoc : forall n m p:Z, Zmin n (Zmin m p) = Zmin (Zmin n m) p. Proof. -intros n m p; repeat apply Zmin_case_strong; intros; - reflexivity || (try apply Zle_antisym); eauto with zarith. + intros n m p; repeat apply Zmin_case_strong; intros; + reflexivity || (try apply Zle_antisym); eauto with zarith. Qed. -(** Additional properties of min *) +(** * Additional properties of min *) Lemma Zmin_irreducible_inf : forall n m:Z, {Zmin n m = n} + {Zmin n m = m}. Proof. -unfold Zmin in |- *; intros; elim (n ?= m); auto. + unfold Zmin in |- *; intros; elim (n ?= m); auto. Qed. Lemma Zmin_irreducible : forall n m:Z, Zmin n m = n \/ Zmin n m = m. Proof. -intros n m; destruct (Zmin_irreducible_inf n m); [left|right]; trivial. + intros n m; destruct (Zmin_irreducible_inf n m); [left|right]; trivial. Qed. Notation Zmin_or := Zmin_irreducible (only parsing). Lemma Zmin_le_prime_inf : forall n m p:Z, Zmin n m <= p -> {n <= p} + {m <= p}. Proof. -intros n m p; apply Zmin_case; auto. + intros n m p; apply Zmin_case; auto. Qed. -(** Operations preserving min *) +(** * Operations preserving min *) Lemma Zsucc_min_distr : forall n m:Z, Zsucc (Zmin n m) = Zmin (Zsucc n) (Zsucc m). Proof. -intros n m; unfold Zmin in |- *; rewrite (Zcompare_succ_compat n m); - elim_compare n m; intros E; rewrite E; auto with arith. + intros n m; unfold Zmin in |- *; rewrite (Zcompare_succ_compat n m); + elim_compare n m; intros E; rewrite E; auto with arith. Qed. Notation Zmin_SS := Zsucc_min_distr (only parsing). Lemma Zplus_min_distr_r : forall n m p:Z, Zmin (n + p) (m + p) = Zmin n m + p. Proof. -intros x y n; unfold Zmin in |- *. -rewrite (Zplus_comm x n); rewrite (Zplus_comm y n); - rewrite (Zcompare_plus_compat x y n). -case (x ?= y); apply Zplus_comm. + intros x y n; unfold Zmin in |- *. + rewrite (Zplus_comm x n); rewrite (Zplus_comm y n); + rewrite (Zcompare_plus_compat x y n). + case (x ?= y); apply Zplus_comm. Qed. Notation Zmin_plus := Zplus_min_distr_r (only parsing). diff --git a/theories/ZArith/Zminmax.v b/theories/ZArith/Zminmax.v index ebe9318e..95668cf8 100644 --- a/theories/ZArith/Zminmax.v +++ b/theories/ZArith/Zminmax.v @@ -5,27 +5,27 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Zminmax.v 8034 2006-02-12 22:08:04Z herbelin $ i*) +(*i $Id: Zminmax.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import Zmin Zmax. Require Import BinInt Zorder. Open Local Scope Z_scope. -(** *** Lattice properties of min and max on Z *) +(** Lattice properties of min and max on Z *) (** Absorption *) Lemma Zmin_max_absorption_r_r : forall n m, Zmax n (Zmin n m) = n. Proof. -intros; apply Zmin_case_strong; intro; apply Zmax_case_strong; intro; - reflexivity || apply Zle_antisym; trivial. + intros; apply Zmin_case_strong; intro; apply Zmax_case_strong; intro; + reflexivity || apply Zle_antisym; trivial. Qed. Lemma Zmax_min_absorption_r_r : forall n m, Zmin n (Zmax n m) = n. Proof. -intros; apply Zmax_case_strong; intro; apply Zmin_case_strong; intro; - reflexivity || apply Zle_antisym; trivial. + intros; apply Zmax_case_strong; intro; apply Zmin_case_strong; intro; + reflexivity || apply Zle_antisym; trivial. Qed. (** Distributivity *) @@ -33,19 +33,19 @@ Qed. Lemma Zmax_min_distr_r : forall n m p, Zmax n (Zmin m p) = Zmin (Zmax n m) (Zmax n p). Proof. -intros. -repeat apply Zmax_case_strong; repeat apply Zmin_case_strong; intros; - reflexivity || - apply Zle_antisym; (assumption || eapply Zle_trans; eassumption). + intros. + repeat apply Zmax_case_strong; repeat apply Zmin_case_strong; intros; + reflexivity || + apply Zle_antisym; (assumption || eapply Zle_trans; eassumption). Qed. Lemma Zmin_max_distr_r : forall n m p, Zmin n (Zmax m p) = Zmax (Zmin n m) (Zmin n p). Proof. -intros. -repeat apply Zmax_case_strong; repeat apply Zmin_case_strong; intros; - reflexivity || - apply Zle_antisym; (assumption || eapply Zle_trans; eassumption). + intros. + repeat apply Zmax_case_strong; repeat apply Zmin_case_strong; intros; + reflexivity || + apply Zle_antisym; (assumption || eapply Zle_trans; eassumption). Qed. (** Modularity *) @@ -53,30 +53,24 @@ Qed. Lemma Zmax_min_modular_r : forall n m p, Zmax n (Zmin m (Zmax n p)) = Zmin (Zmax n m) (Zmax n p). Proof. -intros; repeat apply Zmax_case_strong; repeat apply Zmin_case_strong; intros; - reflexivity || - apply Zle_antisym; (assumption || eapply Zle_trans; eassumption). + intros; repeat apply Zmax_case_strong; repeat apply Zmin_case_strong; intros; + reflexivity || + apply Zle_antisym; (assumption || eapply Zle_trans; eassumption). Qed. Lemma Zmin_max_modular_r : forall n m p, Zmin n (Zmax m (Zmin n p)) = Zmax (Zmin n m) (Zmin n p). Proof. -intros; repeat apply Zmax_case_strong; repeat apply Zmin_case_strong; intros; - reflexivity || - apply Zle_antisym; (assumption || eapply Zle_trans; eassumption). + intros; repeat apply Zmax_case_strong; repeat apply Zmin_case_strong; intros; + reflexivity || + apply Zle_antisym; (assumption || eapply Zle_trans; eassumption). Qed. (** Disassociativity *) Lemma max_min_disassoc : forall n m p, Zmin n (Zmax m p) <= Zmax (Zmin n m) p. Proof. -intros; repeat apply Zmax_case_strong; repeat apply Zmin_case_strong; intros; - apply Zle_refl || (assumption || eapply Zle_trans; eassumption). + intros; repeat apply Zmax_case_strong; repeat apply Zmin_case_strong; intros; + apply Zle_refl || (assumption || eapply Zle_trans; eassumption). Qed. - - - - - - diff --git a/theories/ZArith/Zmisc.v b/theories/ZArith/Zmisc.v index 8246e324..d01cada6 100644 --- a/theories/ZArith/Zmisc.v +++ b/theories/ZArith/Zmisc.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Zmisc.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Zmisc.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import BinInt. Require Import Zcompare. @@ -20,78 +20,78 @@ Open Local Scope Z_scope. (** [n]th iteration of the function [f] *) Fixpoint iter_nat (n:nat) (A:Set) (f:A -> A) (x:A) {struct n} : A := match n with - | O => x - | S n' => f (iter_nat n' A f x) + | O => x + | S n' => f (iter_nat n' A f x) end. Fixpoint iter_pos (n:positive) (A:Set) (f:A -> A) (x:A) {struct n} : A := match n with - | xH => f x - | xO n' => iter_pos n' A f (iter_pos n' A f x) - | xI n' => f (iter_pos n' A f (iter_pos n' A f x)) + | xH => f x + | xO n' => iter_pos n' A f (iter_pos n' A f x) + | xI n' => f (iter_pos n' A f (iter_pos n' A f x)) end. Definition iter (n:Z) (A:Set) (f:A -> A) (x:A) := match n with - | Z0 => x - | Zpos p => iter_pos p A f x - | Zneg p => x + | Z0 => x + | Zpos p => iter_pos p A f x + | Zneg p => x end. Theorem iter_nat_plus : - forall (n m:nat) (A:Set) (f:A -> A) (x:A), - iter_nat (n + m) A f x = iter_nat n A f (iter_nat m A f x). + forall (n m:nat) (A:Set) (f:A -> A) (x:A), + iter_nat (n + m) A f x = iter_nat n A f (iter_nat m A f x). Proof. -simple induction n; - [ simpl in |- *; auto with arith - | intros; simpl in |- *; apply f_equal with (f := f); apply H ]. + simple induction n; + [ simpl in |- *; auto with arith + | intros; simpl in |- *; apply f_equal with (f := f); apply H ]. Qed. Theorem iter_nat_of_P : - forall (p:positive) (A:Set) (f:A -> A) (x:A), - iter_pos p A f x = iter_nat (nat_of_P p) A f x. + forall (p:positive) (A:Set) (f:A -> A) (x:A), + iter_pos p A f x = iter_nat (nat_of_P p) A f x. Proof. -intro n; induction n as [p H| p H| ]; - [ intros; simpl in |- *; rewrite (H A f x); - rewrite (H A f (iter_nat (nat_of_P p) A f x)); - rewrite (ZL6 p); symmetry in |- *; apply f_equal with (f := f); - apply iter_nat_plus - | intros; unfold nat_of_P in |- *; simpl in |- *; rewrite (H A f x); - rewrite (H A f (iter_nat (nat_of_P p) A f x)); - rewrite (ZL6 p); symmetry in |- *; apply iter_nat_plus - | simpl in |- *; auto with arith ]. + intro n; induction n as [p H| p H| ]; + [ intros; simpl in |- *; rewrite (H A f x); + rewrite (H A f (iter_nat (nat_of_P p) A f x)); + rewrite (ZL6 p); symmetry in |- *; apply f_equal with (f := f); + apply iter_nat_plus + | intros; unfold nat_of_P in |- *; simpl in |- *; rewrite (H A f x); + rewrite (H A f (iter_nat (nat_of_P p) A f x)); + rewrite (ZL6 p); symmetry in |- *; apply iter_nat_plus + | simpl in |- *; auto with arith ]. Qed. Theorem iter_pos_plus : - forall (p q:positive) (A:Set) (f:A -> A) (x:A), - iter_pos (p + q) A f x = iter_pos p A f (iter_pos q A f x). + forall (p q:positive) (A:Set) (f:A -> A) (x:A), + iter_pos (p + q) A f x = iter_pos p A f (iter_pos q A f x). Proof. -intros n m; intros. -rewrite (iter_nat_of_P m A f x). -rewrite (iter_nat_of_P n A f (iter_nat (nat_of_P m) A f x)). -rewrite (iter_nat_of_P (n + m) A f x). -rewrite (nat_of_P_plus_morphism n m). -apply iter_nat_plus. + intros n m; intros. + rewrite (iter_nat_of_P m A f x). + rewrite (iter_nat_of_P n A f (iter_nat (nat_of_P m) A f x)). + rewrite (iter_nat_of_P (n + m) A f x). + rewrite (nat_of_P_plus_morphism n m). + apply iter_nat_plus. Qed. (** Preservation of invariants : if [f : A->A] preserves the invariant [Inv], then the iterates of [f] also preserve it. *) Theorem iter_nat_invariant : - forall (n:nat) (A:Set) (f:A -> A) (Inv:A -> Prop), - (forall x:A, Inv x -> Inv (f x)) -> - forall x:A, Inv x -> Inv (iter_nat n A f x). + forall (n:nat) (A:Set) (f:A -> A) (Inv:A -> Prop), + (forall x:A, Inv x -> Inv (f x)) -> + forall x:A, Inv x -> Inv (iter_nat n A f x). Proof. -simple induction n; intros; - [ trivial with arith - | simpl in |- *; apply H0 with (x := iter_nat n0 A f x); apply H; - trivial with arith ]. + simple induction n; intros; + [ trivial with arith + | simpl in |- *; apply H0 with (x := iter_nat n0 A f x); apply H; + trivial with arith ]. Qed. Theorem iter_pos_invariant : - forall (p:positive) (A:Set) (f:A -> A) (Inv:A -> Prop), - (forall x:A, Inv x -> Inv (f x)) -> - forall x:A, Inv x -> Inv (iter_pos p A f x). + forall (p:positive) (A:Set) (f:A -> A) (Inv:A -> Prop), + (forall x:A, Inv x -> Inv (f x)) -> + forall x:A, Inv x -> Inv (iter_pos p A f x). Proof. -intros; rewrite iter_nat_of_P; apply iter_nat_invariant; trivial with arith. + intros; rewrite iter_nat_of_P; apply iter_nat_invariant; trivial with arith. Qed. diff --git a/theories/ZArith/Znat.v b/theories/ZArith/Znat.v index 3e27878c..f0a3d47b 100644 --- a/theories/ZArith/Znat.v +++ b/theories/ZArith/Znat.v @@ -6,11 +6,11 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Znat.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Znat.v 9302 2006-10-27 21:21:17Z barras $ i*) (** Binary Integers (Pierre Crégut, CNET, Lannion, France) *) -Require Export Arith. +Require Export Arith_base. Require Import BinPos. Require Import BinInt. Require Import Zcompare. @@ -23,116 +23,116 @@ Open Local Scope Z_scope. Definition neq (x y:nat) := x <> y. -(**********************************************************************) +(************************************************) (** Properties of the injection from nat into Z *) Theorem inj_S : forall n:nat, Z_of_nat (S n) = Zsucc (Z_of_nat n). Proof. -intro y; induction y as [| n H]; - [ unfold Zsucc in |- *; simpl in |- *; trivial with arith - | change (Zpos (Psucc (P_of_succ_nat n)) = Zsucc (Z_of_nat (S n))) in |- *; - rewrite Zpos_succ_morphism; trivial with arith ]. + intro y; induction y as [| n H]; + [ unfold Zsucc in |- *; simpl in |- *; trivial with arith + | change (Zpos (Psucc (P_of_succ_nat n)) = Zsucc (Z_of_nat (S n))) in |- *; + rewrite Zpos_succ_morphism; trivial with arith ]. Qed. Theorem inj_plus : forall n m:nat, Z_of_nat (n + m) = Z_of_nat n + Z_of_nat m. Proof. -intro x; induction x as [| n H]; intro y; destruct y as [| m]; - [ simpl in |- *; trivial with arith - | simpl in |- *; trivial with arith - | simpl in |- *; rewrite <- plus_n_O; trivial with arith - | change (Z_of_nat (S (n + S m)) = Z_of_nat (S n) + Z_of_nat (S m)) in |- *; - rewrite inj_S; rewrite H; do 2 rewrite inj_S; rewrite Zplus_succ_l; - trivial with arith ]. + intro x; induction x as [| n H]; intro y; destruct y as [| m]; + [ simpl in |- *; trivial with arith + | simpl in |- *; trivial with arith + | simpl in |- *; rewrite <- plus_n_O; trivial with arith + | change (Z_of_nat (S (n + S m)) = Z_of_nat (S n) + Z_of_nat (S m)) in |- *; + rewrite inj_S; rewrite H; do 2 rewrite inj_S; rewrite Zplus_succ_l; + trivial with arith ]. Qed. - + Theorem inj_mult : forall n m:nat, Z_of_nat (n * m) = Z_of_nat n * Z_of_nat m. Proof. -intro x; induction x as [| n H]; - [ simpl in |- *; trivial with arith - | intro y; rewrite inj_S; rewrite <- Zmult_succ_l_reverse; rewrite <- H; - rewrite <- inj_plus; simpl in |- *; rewrite plus_comm; - trivial with arith ]. + intro x; induction x as [| n H]; + [ simpl in |- *; trivial with arith + | intro y; rewrite inj_S; rewrite <- Zmult_succ_l_reverse; rewrite <- H; + rewrite <- inj_plus; simpl in |- *; rewrite plus_comm; + trivial with arith ]. Qed. Theorem inj_neq : forall n m:nat, neq n m -> Zne (Z_of_nat n) (Z_of_nat m). Proof. -unfold neq, Zne, not in |- *; intros x y H1 H2; apply H1; generalize H2; - case x; case y; intros; - [ auto with arith - | discriminate H0 - | discriminate H0 - | simpl in H0; injection H0; - do 2 rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ; - intros E; rewrite E; auto with arith ]. + unfold neq, Zne, not in |- *; intros x y H1 H2; apply H1; generalize H2; + case x; case y; intros; + [ auto with arith + | discriminate H0 + | discriminate H0 + | simpl in H0; injection H0; + do 2 rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ; + intros E; rewrite E; auto with arith ]. Qed. Theorem inj_le : forall n m:nat, (n <= m)%nat -> Z_of_nat n <= Z_of_nat m. Proof. -intros x y; intros H; elim H; - [ unfold Zle in |- *; elim (Zcompare_Eq_iff_eq (Z_of_nat x) (Z_of_nat x)); - intros H1 H2; rewrite H2; [ discriminate | trivial with arith ] - | intros m H1 H2; apply Zle_trans with (Z_of_nat m); - [ assumption | rewrite inj_S; apply Zle_succ ] ]. + intros x y; intros H; elim H; + [ unfold Zle in |- *; elim (Zcompare_Eq_iff_eq (Z_of_nat x) (Z_of_nat x)); + intros H1 H2; rewrite H2; [ discriminate | trivial with arith ] + | intros m H1 H2; apply Zle_trans with (Z_of_nat m); + [ assumption | rewrite inj_S; apply Zle_succ ] ]. Qed. Theorem inj_lt : forall n m:nat, (n < m)%nat -> Z_of_nat n < Z_of_nat m. Proof. -intros x y H; apply Zgt_lt; apply Zlt_succ_gt; rewrite <- inj_S; apply inj_le; - exact H. + intros x y H; apply Zgt_lt; apply Zlt_succ_gt; rewrite <- inj_S; apply inj_le; + exact H. Qed. Theorem inj_gt : forall n m:nat, (n > m)%nat -> Z_of_nat n > Z_of_nat m. Proof. -intros x y H; apply Zlt_gt; apply inj_lt; exact H. + intros x y H; apply Zlt_gt; apply inj_lt; exact H. Qed. Theorem inj_ge : forall n m:nat, (n >= m)%nat -> Z_of_nat n >= Z_of_nat m. Proof. -intros x y H; apply Zle_ge; apply inj_le; apply H. + intros x y H; apply Zle_ge; apply inj_le; apply H. Qed. Theorem inj_eq : forall n m:nat, n = m -> Z_of_nat n = Z_of_nat m. Proof. -intros x y H; rewrite H; trivial with arith. + intros x y H; rewrite H; trivial with arith. Qed. Theorem intro_Z : - forall n:nat, exists y : Z, Z_of_nat n = y /\ 0 <= y * 1 + 0. + forall n:nat, exists y : Z, Z_of_nat n = y /\ 0 <= y * 1 + 0. Proof. -intros x; exists (Z_of_nat x); split; - [ trivial with arith - | rewrite Zmult_comm; rewrite Zmult_1_l; rewrite Zplus_0_r; - unfold Zle in |- *; elim x; intros; simpl in |- *; - discriminate ]. + intros x; exists (Z_of_nat x); split; + [ trivial with arith + | rewrite Zmult_comm; rewrite Zmult_1_l; rewrite Zplus_0_r; + unfold Zle in |- *; elim x; intros; simpl in |- *; + discriminate ]. Qed. Theorem inj_minus1 : - forall n m:nat, (m <= n)%nat -> Z_of_nat (n - m) = Z_of_nat n - Z_of_nat m. + forall n m:nat, (m <= n)%nat -> Z_of_nat (n - m) = Z_of_nat n - Z_of_nat m. Proof. -intros x y H; apply (Zplus_reg_l (Z_of_nat y)); unfold Zminus in |- *; - rewrite Zplus_permute; rewrite Zplus_opp_r; rewrite <- inj_plus; - rewrite <- (le_plus_minus y x H); rewrite Zplus_0_r; - trivial with arith. + intros x y H; apply (Zplus_reg_l (Z_of_nat y)); unfold Zminus in |- *; + rewrite Zplus_permute; rewrite Zplus_opp_r; rewrite <- inj_plus; + rewrite <- (le_plus_minus y x H); rewrite Zplus_0_r; + trivial with arith. Qed. Theorem inj_minus2 : forall n m:nat, (m > n)%nat -> Z_of_nat (n - m) = 0. Proof. -intros x y H; rewrite not_le_minus_0; - [ trivial with arith | apply gt_not_le; assumption ]. + intros x y H; rewrite not_le_minus_0; + [ trivial with arith | apply gt_not_le; assumption ]. Qed. Theorem Zpos_eq_Z_of_nat_o_nat_of_P : - forall p:positive, Zpos p = Z_of_nat (nat_of_P p). + forall p:positive, Zpos p = Z_of_nat (nat_of_P p). Proof. -intros x; elim x; simpl in |- *; auto. -intros p H; rewrite ZL6. -apply f_equal with (f := Zpos). -apply nat_of_P_inj. -rewrite nat_of_P_o_P_of_succ_nat_eq_succ; unfold nat_of_P in |- *; - simpl in |- *. -rewrite ZL6; auto. -intros p H; unfold nat_of_P in |- *; simpl in |- *. -rewrite ZL6; simpl in |- *. -rewrite inj_plus; repeat rewrite <- H. -rewrite Zpos_xO; simpl in |- *; rewrite Pplus_diag; reflexivity. + intros x; elim x; simpl in |- *; auto. + intros p H; rewrite ZL6. + apply f_equal with (f := Zpos). + apply nat_of_P_inj. + rewrite nat_of_P_o_P_of_succ_nat_eq_succ; unfold nat_of_P in |- *; + simpl in |- *. + rewrite ZL6; auto. + intros p H; unfold nat_of_P in |- *; simpl in |- *. + rewrite ZL6; simpl in |- *. + rewrite inj_plus; repeat rewrite <- H. + rewrite Zpos_xO; simpl in |- *; rewrite Pplus_diag; reflexivity. Qed. diff --git a/theories/ZArith/Znumtheory.v b/theories/ZArith/Znumtheory.v index e722b679..d89ec052 100644 --- a/theories/ZArith/Znumtheory.v +++ b/theories/ZArith/Znumtheory.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Znumtheory.v 8990 2006-06-26 13:57:44Z notin $ i*) +(*i $Id: Znumtheory.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import ZArith_base. Require Import ZArithRing. @@ -38,91 +38,91 @@ Notation "( a | b )" := (Zdivide a b) (at level 0) : Z_scope. Lemma Zdivide_refl : forall a:Z, (a | a). Proof. -intros; apply Zdivide_intro with 1; ring. + intros; apply Zdivide_intro with 1; ring. Qed. Lemma Zone_divide : forall a:Z, (1 | a). Proof. -intros; apply Zdivide_intro with a; ring. + intros; apply Zdivide_intro with a; ring. Qed. Lemma Zdivide_0 : forall a:Z, (a | 0). Proof. -intros; apply Zdivide_intro with 0; ring. + intros; apply Zdivide_intro with 0; ring. Qed. Hint Resolve Zdivide_refl Zone_divide Zdivide_0: zarith. Lemma Zmult_divide_compat_l : forall a b c:Z, (a | b) -> (c * a | c * b). Proof. -simple induction 1; intros; apply Zdivide_intro with q. -rewrite H0; ring. + simple induction 1; intros; apply Zdivide_intro with q. + rewrite H0; ring. Qed. Lemma Zmult_divide_compat_r : forall a b c:Z, (a | b) -> (a * c | b * c). Proof. -intros a b c; rewrite (Zmult_comm a c); rewrite (Zmult_comm b c). -apply Zmult_divide_compat_l; trivial. + intros a b c; rewrite (Zmult_comm a c); rewrite (Zmult_comm b c). + apply Zmult_divide_compat_l; trivial. Qed. Hint Resolve Zmult_divide_compat_l Zmult_divide_compat_r: zarith. Lemma Zdivide_plus_r : forall a b c:Z, (a | b) -> (a | c) -> (a | b + c). Proof. -simple induction 1; intros q Hq; simple induction 1; intros q' Hq'. -apply Zdivide_intro with (q + q'). -rewrite Hq; rewrite Hq'; ring. + simple induction 1; intros q Hq; simple induction 1; intros q' Hq'. + apply Zdivide_intro with (q + q'). + rewrite Hq; rewrite Hq'; ring. Qed. Lemma Zdivide_opp_r : forall a b:Z, (a | b) -> (a | - b). Proof. -simple induction 1; intros; apply Zdivide_intro with (- q). -rewrite H0; ring. + simple induction 1; intros; apply Zdivide_intro with (- q). + rewrite H0; ring. Qed. Lemma Zdivide_opp_r_rev : forall a b:Z, (a | - b) -> (a | b). Proof. -intros; replace b with (- - b). apply Zdivide_opp_r; trivial. ring. + intros; replace b with (- - b). apply Zdivide_opp_r; trivial. ring. Qed. Lemma Zdivide_opp_l : forall a b:Z, (a | b) -> (- a | b). Proof. -simple induction 1; intros; apply Zdivide_intro with (- q). -rewrite H0; ring. + simple induction 1; intros; apply Zdivide_intro with (- q). + rewrite H0; ring. Qed. Lemma Zdivide_opp_l_rev : forall a b:Z, (- a | b) -> (a | b). Proof. -intros; replace a with (- - a). apply Zdivide_opp_l; trivial. ring. + intros; replace a with (- - a). apply Zdivide_opp_l; trivial. ring. Qed. Lemma Zdivide_minus_l : forall a b c:Z, (a | b) -> (a | c) -> (a | b - c). Proof. -simple induction 1; intros q Hq; simple induction 1; intros q' Hq'. -apply Zdivide_intro with (q - q'). -rewrite Hq; rewrite Hq'; ring. + simple induction 1; intros q Hq; simple induction 1; intros q' Hq'. + apply Zdivide_intro with (q - q'). + rewrite Hq; rewrite Hq'; ring. Qed. Lemma Zdivide_mult_l : forall a b c:Z, (a | b) -> (a | b * c). Proof. -simple induction 1; intros q Hq; apply Zdivide_intro with (q * c). -rewrite Hq; ring. + simple induction 1; intros q Hq; apply Zdivide_intro with (q * c). + rewrite Hq; ring. Qed. Lemma Zdivide_mult_r : forall a b c:Z, (a | c) -> (a | b * c). Proof. -simple induction 1; intros q Hq; apply Zdivide_intro with (q * b). -rewrite Hq; ring. + simple induction 1; intros q Hq; apply Zdivide_intro with (q * b). + rewrite Hq; ring. Qed. Lemma Zdivide_factor_r : forall a b:Z, (a | a * b). Proof. -intros; apply Zdivide_intro with b; ring. + intros; apply Zdivide_intro with b; ring. Qed. Lemma Zdivide_factor_l : forall a b:Z, (a | b * a). Proof. -intros; apply Zdivide_intro with b; ring. + intros; apply Zdivide_intro with b; ring. Qed. Hint Resolve Zdivide_plus_r Zdivide_opp_r Zdivide_opp_r_rev Zdivide_opp_l @@ -133,7 +133,7 @@ Hint Resolve Zdivide_plus_r Zdivide_opp_r Zdivide_opp_r_rev Zdivide_opp_l Lemma Zmult_one : forall x y:Z, x >= 0 -> x * y = 1 -> x = 1. Proof. -intros x y H H0; destruct (Zmult_1_inversion_l _ _ H0) as [Hpos| Hneg]. + intros x y H H0; destruct (Zmult_1_inversion_l _ _ H0) as [Hpos| Hneg]. assumption. rewrite Hneg in H; simpl in H. contradiction (Zle_not_lt 0 (-1)). @@ -145,11 +145,11 @@ Qed. Lemma Zdivide_1 : forall x:Z, (x | 1) -> x = 1 \/ x = -1. Proof. -simple induction 1; intros. -elim (Z_lt_ge_dec 0 x); [ left | right ]. -apply Zmult_one with q; auto with zarith; rewrite H0; ring. -assert (- x = 1); auto with zarith. -apply Zmult_one with (- q); auto with zarith; rewrite H0; ring. + simple induction 1; intros. + elim (Z_lt_ge_dec 0 x); [ left | right ]. + apply Zmult_one with q; auto with zarith; rewrite H0; ring. + assert (- x = 1); auto with zarith. + apply Zmult_one with (- q); auto with zarith; rewrite H0; ring. Qed. (** If [a] divides [b] and [b] divides [a] then [a] is [b] or [-b]. *) @@ -164,7 +164,7 @@ left; rewrite H0; rewrite e; ring. assert (Hqq0 : q0 * q = 1). apply Zmult_reg_l with a. assumption. -ring. +ring_simplify. pattern a at 2 in |- *; rewrite H2; ring. assert (q | 1). rewrite <- Hqq0; auto with zarith. @@ -177,21 +177,21 @@ Qed. Lemma Zdivide_bounds : forall a b:Z, (a | b) -> b <> 0 -> Zabs a <= Zabs b. Proof. -simple induction 1; intros. -assert (Zabs b = Zabs q * Zabs a). - subst; apply Zabs_Zmult. -rewrite H2. -assert (H3 := Zabs_pos q). -assert (H4 := Zabs_pos a). -assert (Zabs q * Zabs a >= 1 * Zabs a); auto with zarith. -apply Zmult_ge_compat; auto with zarith. -elim (Z_lt_ge_dec (Zabs q) 1); [ intros | auto with zarith ]. -assert (Zabs q = 0). - omega. -assert (q = 0). - rewrite <- (Zabs_Zsgn q). -rewrite H5; auto with zarith. -subst q; omega. + simple induction 1; intros. + assert (Zabs b = Zabs q * Zabs a). + subst; apply Zabs_Zmult. + rewrite H2. + assert (H3 := Zabs_pos q). + assert (H4 := Zabs_pos a). + assert (Zabs q * Zabs a >= 1 * Zabs a); auto with zarith. + apply Zmult_ge_compat; auto with zarith. + elim (Z_lt_ge_dec (Zabs q) 1); [ intros | auto with zarith ]. + assert (Zabs q = 0). + omega. + assert (q = 0). + rewrite <- (Zabs_Zsgn q). + rewrite H5; auto with zarith. + subst q; omega. Qed. (** * Greatest common divisor (gcd). *) @@ -201,48 +201,48 @@ Qed. (We show later that the [gcd] is actually unique if we discard its sign.) *) Inductive Zis_gcd (a b d:Z) : Prop := - Zis_gcd_intro : - (d | a) -> - (d | b) -> (forall x:Z, (x | a) -> (x | b) -> (x | d)) -> Zis_gcd a b d. + Zis_gcd_intro : + (d | a) -> + (d | b) -> (forall x:Z, (x | a) -> (x | b) -> (x | d)) -> Zis_gcd a b d. (** Trivial properties of [gcd] *) Lemma Zis_gcd_sym : forall a b d:Z, Zis_gcd a b d -> Zis_gcd b a d. Proof. -simple induction 1; constructor; intuition. + simple induction 1; constructor; intuition. Qed. Lemma Zis_gcd_0 : forall a:Z, Zis_gcd a 0 a. Proof. -constructor; auto with zarith. + constructor; auto with zarith. Qed. Lemma Zis_gcd_1 : forall a, Zis_gcd a 1 1. Proof. -constructor; auto with zarith. + constructor; auto with zarith. Qed. Lemma Zis_gcd_refl : forall a, Zis_gcd a a a. Proof. -constructor; auto with zarith. + constructor; auto with zarith. Qed. Lemma Zis_gcd_minus : forall a b d:Z, Zis_gcd a (- b) d -> Zis_gcd b a d. Proof. -simple induction 1; constructor; intuition. + simple induction 1; constructor; intuition. Qed. Lemma Zis_gcd_opp : forall a b d:Z, Zis_gcd a b d -> Zis_gcd b a (- d). Proof. -simple induction 1; constructor; intuition. + simple induction 1; constructor; intuition. Qed. Lemma Zis_gcd_0_abs : forall a:Z, Zis_gcd 0 a (Zabs a). Proof. -intros a. -apply Zabs_ind. -intros; apply Zis_gcd_sym; apply Zis_gcd_0; auto. -intros; apply Zis_gcd_opp; apply Zis_gcd_0; auto. + intros a. + apply Zabs_ind. + intros; apply Zis_gcd_sym; apply Zis_gcd_0; auto. + intros; apply Zis_gcd_opp; apply Zis_gcd_0; auto. Qed. Hint Resolve Zis_gcd_sym Zis_gcd_0 Zis_gcd_minus Zis_gcd_opp: zarith. @@ -253,18 +253,18 @@ Hint Resolve Zis_gcd_sym Zis_gcd_0 Zis_gcd_minus Zis_gcd_opp: zarith. the following property. *) Lemma Zis_gcd_for_euclid : - forall a b d q:Z, Zis_gcd b (a - q * b) d -> Zis_gcd a b d. + forall a b d q:Z, Zis_gcd b (a - q * b) d -> Zis_gcd a b d. Proof. -simple induction 1; constructor; intuition. -replace a with (a - q * b + q * b). auto with zarith. ring. + simple induction 1; constructor; intuition. + replace a with (a - q * b + q * b). auto with zarith. ring. Qed. Lemma Zis_gcd_for_euclid2 : - forall b d q r:Z, Zis_gcd r b d -> Zis_gcd b (b * q + r) d. + forall b d q r:Z, Zis_gcd r b d -> Zis_gcd b (b * q + r) d. Proof. -simple induction 1; constructor; intuition. -apply H2; auto. -replace r with (b * q + r - b * q). auto with zarith. ring. + simple induction 1; constructor; intuition. + apply H2; auto. + replace r with (b * q + r - b * q). auto with zarith. ring. Qed. (** We implement the extended version of Euclid's algorithm, @@ -274,117 +274,117 @@ Qed. Section extended_euclid_algorithm. -Variables a b : Z. + Variables a b : Z. -(** The specification of Euclid's algorithm is the existence of - [u], [v] and [d] such that [ua+vb=d] and [(gcd a b d)]. *) + (** The specification of Euclid's algorithm is the existence of + [u], [v] and [d] such that [ua+vb=d] and [(gcd a b d)]. *) -Inductive Euclid : Set := + Inductive Euclid : Set := Euclid_intro : - forall u v d:Z, u * a + v * b = d -> Zis_gcd a b d -> Euclid. - -(** The recursive part of Euclid's algorithm uses well-founded - recursion of non-negative integers. It maintains 6 integers - [u1,u2,u3,v1,v2,v3] such that the following invariant holds: - [u1*a+u2*b=u3] and [v1*a+v2*b=v3] and [gcd(u2,v3)=gcd(a,b)]. - *) - -Lemma euclid_rec : - forall v3:Z, - 0 <= v3 -> - forall u1 u2 u3 v1 v2:Z, - u1 * a + u2 * b = u3 -> - v1 * a + v2 * b = v3 -> - (forall d:Z, Zis_gcd u3 v3 d -> Zis_gcd a b d) -> Euclid. -Proof. -intros v3 Hv3; generalize Hv3; pattern v3 in |- *. -apply Zlt_0_rec. -clear v3 Hv3; intros. -elim (Z_zerop x); intro. -apply Euclid_intro with (u := u1) (v := u2) (d := u3). -assumption. -apply H3. -rewrite a0; auto with zarith. -set (q := u3 / x) in *. -assert (Hq : 0 <= u3 - q * x < x). -replace (u3 - q * x) with (u3 mod x). -apply Z_mod_lt; omega. -assert (xpos : x > 0). omega. -generalize (Z_div_mod_eq u3 x xpos). -unfold q in |- *. -intro eq; pattern u3 at 2 in |- *; rewrite eq; ring. -apply (H (u3 - q * x) Hq (proj1 Hq) v1 v2 x (u1 - q * v1) (u2 - q * v2)). -tauto. -replace ((u1 - q * v1) * a + (u2 - q * v2) * b) with - (u1 * a + u2 * b - q * (v1 * a + v2 * b)). -rewrite H1; rewrite H2; trivial. -ring. -intros; apply H3. -apply Zis_gcd_for_euclid with q; assumption. -assumption. -Qed. - -(** We get Euclid's algorithm by applying [euclid_rec] on - [1,0,a,0,1,b] when [b>=0] and [1,0,a,0,-1,-b] when [b<0]. *) - -Lemma euclid : Euclid. -Proof. -case (Z_le_gt_dec 0 b); intro. -intros; - apply euclid_rec with - (u1 := 1) (u2 := 0) (u3 := a) (v1 := 0) (v2 := 1) (v3 := b); - auto with zarith; ring. -intros; - apply euclid_rec with - (u1 := 1) (u2 := 0) (u3 := a) (v1 := 0) (v2 := -1) (v3 := - b); - auto with zarith; try ring. -Qed. + forall u v d:Z, u * a + v * b = d -> Zis_gcd a b d -> Euclid. + + (** The recursive part of Euclid's algorithm uses well-founded + recursion of non-negative integers. It maintains 6 integers + [u1,u2,u3,v1,v2,v3] such that the following invariant holds: + [u1*a+u2*b=u3] and [v1*a+v2*b=v3] and [gcd(u2,v3)=gcd(a,b)]. + *) + + Lemma euclid_rec : + forall v3:Z, + 0 <= v3 -> + forall u1 u2 u3 v1 v2:Z, + u1 * a + u2 * b = u3 -> + v1 * a + v2 * b = v3 -> + (forall d:Z, Zis_gcd u3 v3 d -> Zis_gcd a b d) -> Euclid. + Proof. + intros v3 Hv3; generalize Hv3; pattern v3 in |- *. + apply Zlt_0_rec. + clear v3 Hv3; intros. + elim (Z_zerop x); intro. + apply Euclid_intro with (u := u1) (v := u2) (d := u3). + assumption. + apply H3. + rewrite a0; auto with zarith. + set (q := u3 / x) in *. + assert (Hq : 0 <= u3 - q * x < x). + replace (u3 - q * x) with (u3 mod x). + apply Z_mod_lt; omega. + assert (xpos : x > 0). omega. + generalize (Z_div_mod_eq u3 x xpos). + unfold q in |- *. + intro eq; pattern u3 at 2 in |- *; rewrite eq; ring. + apply (H (u3 - q * x) Hq (proj1 Hq) v1 v2 x (u1 - q * v1) (u2 - q * v2)). + tauto. + replace ((u1 - q * v1) * a + (u2 - q * v2) * b) with + (u1 * a + u2 * b - q * (v1 * a + v2 * b)). + rewrite H1; rewrite H2; trivial. + ring. + intros; apply H3. + apply Zis_gcd_for_euclid with q; assumption. + assumption. + Qed. + + (** We get Euclid's algorithm by applying [euclid_rec] on + [1,0,a,0,1,b] when [b>=0] and [1,0,a,0,-1,-b] when [b<0]. *) + + Lemma euclid : Euclid. + Proof. + case (Z_le_gt_dec 0 b); intro. + intros; + apply euclid_rec with + (u1 := 1) (u2 := 0) (u3 := a) (v1 := 0) (v2 := 1) (v3 := b); + auto with zarith; ring. + intros; + apply euclid_rec with + (u1 := 1) (u2 := 0) (u3 := a) (v1 := 0) (v2 := -1) (v3 := - b); + auto with zarith; try ring. + Qed. End extended_euclid_algorithm. Theorem Zis_gcd_uniqueness_apart_sign : - forall a b d d':Z, Zis_gcd a b d -> Zis_gcd a b d' -> d = d' \/ d = - d'. + forall a b d d':Z, Zis_gcd a b d -> Zis_gcd a b d' -> d = d' \/ d = - d'. Proof. -simple induction 1. -intros H1 H2 H3; simple induction 1; intros. -generalize (H3 d' H4 H5); intro Hd'd. -generalize (H6 d H1 H2); intro Hdd'. -exact (Zdivide_antisym d d' Hdd' Hd'd). + simple induction 1. + intros H1 H2 H3; simple induction 1; intros. + generalize (H3 d' H4 H5); intro Hd'd. + generalize (H6 d H1 H2); intro Hdd'. + exact (Zdivide_antisym d d' Hdd' Hd'd). Qed. (** * Bezout's coefficients *) Inductive Bezout (a b d:Z) : Prop := - Bezout_intro : forall u v:Z, u * a + v * b = d -> Bezout a b d. + Bezout_intro : forall u v:Z, u * a + v * b = d -> Bezout a b d. (** Existence of Bezout's coefficients for the [gcd] of [a] and [b] *) Lemma Zis_gcd_bezout : forall a b d:Z, Zis_gcd a b d -> Bezout a b d. Proof. -intros a b d Hgcd. -elim (euclid a b); intros u v d0 e g. -generalize (Zis_gcd_uniqueness_apart_sign a b d d0 Hgcd g). -intro H; elim H; clear H; intros. -apply Bezout_intro with u v. -rewrite H; assumption. -apply Bezout_intro with (- u) (- v). -rewrite H; rewrite <- e; ring. + intros a b d Hgcd. + elim (euclid a b); intros u v d0 e g. + generalize (Zis_gcd_uniqueness_apart_sign a b d d0 Hgcd g). + intro H; elim H; clear H; intros. + apply Bezout_intro with u v. + rewrite H; assumption. + apply Bezout_intro with (- u) (- v). + rewrite H; rewrite <- e; ring. Qed. (** gcd of [ca] and [cb] is [c gcd(a,b)]. *) Lemma Zis_gcd_mult : - forall a b c d:Z, Zis_gcd a b d -> Zis_gcd (c * a) (c * b) (c * d). -Proof. -intros a b c d; simple induction 1; constructor; intuition. -elim (Zis_gcd_bezout a b d H); intros. -elim H3; intros. -elim H4; intros. -apply Zdivide_intro with (u * q + v * q0). -rewrite <- H5. -replace (c * (u * a + v * b)) with (u * (c * a) + v * (c * b)). -rewrite H6; rewrite H7; ring. -ring. + forall a b c d:Z, Zis_gcd a b d -> Zis_gcd (c * a) (c * b) (c * d). +Proof. + intros a b c d; simple induction 1; constructor; intuition. + elim (Zis_gcd_bezout a b d H); intros. + elim H3; intros. + elim H4; intros. + apply Zdivide_intro with (u * q + v * q0). + rewrite <- H5. + replace (c * (u * a + v * b)) with (u * (c * a) + v * (c * b)). + rewrite H6; rewrite H7; ring. + ring. Qed. @@ -397,13 +397,13 @@ Definition rel_prime (a b:Z) : Prop := Zis_gcd a b 1. Lemma rel_prime_bezout : forall a b:Z, rel_prime a b -> Bezout a b 1. Proof. -intros a b; exact (Zis_gcd_bezout a b 1). + intros a b; exact (Zis_gcd_bezout a b 1). Qed. Lemma bezout_rel_prime : forall a b:Z, Bezout a b 1 -> rel_prime a b. Proof. -simple induction 1; constructor; auto with zarith. -intros. rewrite <- H0; auto with zarith. + simple induction 1; constructor; auto with zarith. + intros. rewrite <- H0; auto with zarith. Qed. (** Gauss's theorem: if [a] divides [bc] and if [a] and [b] are @@ -411,134 +411,134 @@ Qed. Theorem Gauss : forall a b c:Z, (a | b * c) -> rel_prime a b -> (a | c). Proof. -intros. elim (rel_prime_bezout a b H0); intros. -replace c with (c * 1); [ idtac | ring ]. -rewrite <- H1. -replace (c * (u * a + v * b)) with (c * u * a + v * (b * c)); - [ eauto with zarith | ring ]. + intros. elim (rel_prime_bezout a b H0); intros. + replace c with (c * 1); [ idtac | ring ]. + rewrite <- H1. + replace (c * (u * a + v * b)) with (c * u * a + v * (b * c)); + [ eauto with zarith | ring ]. Qed. (** If [a] is relatively prime to [b] and [c], then it is to [bc] *) Lemma rel_prime_mult : - forall a b c:Z, rel_prime a b -> rel_prime a c -> rel_prime a (b * c). + forall a b c:Z, rel_prime a b -> rel_prime a c -> rel_prime a (b * c). Proof. -intros a b c Hb Hc. -elim (rel_prime_bezout a b Hb); intros. -elim (rel_prime_bezout a c Hc); intros. -apply bezout_rel_prime. -apply Bezout_intro with - (u := u * u0 * a + v0 * c * u + u0 * v * b) (v := v * v0). -rewrite <- H. -replace (u * a + v * b) with ((u * a + v * b) * 1); [ idtac | ring ]. -rewrite <- H0. -ring. + intros a b c Hb Hc. + elim (rel_prime_bezout a b Hb); intros. + elim (rel_prime_bezout a c Hc); intros. + apply bezout_rel_prime. + apply Bezout_intro with + (u := u * u0 * a + v0 * c * u + u0 * v * b) (v := v * v0). + rewrite <- H. + replace (u * a + v * b) with ((u * a + v * b) * 1); [ idtac | ring ]. + rewrite <- H0. + ring. Qed. Lemma rel_prime_cross_prod : - forall a b c d:Z, - rel_prime a b -> - rel_prime c d -> b > 0 -> d > 0 -> a * d = b * c -> a = c /\ b = d. -Proof. -intros a b c d; intros. -elim (Zdivide_antisym b d). -split; auto with zarith. -rewrite H4 in H3. -rewrite Zmult_comm in H3. -apply Zmult_reg_l with d; auto with zarith. -intros; omega. -apply Gauss with a. -rewrite H3. -auto with zarith. -red in |- *; auto with zarith. -apply Gauss with c. -rewrite Zmult_comm. -rewrite <- H3. -auto with zarith. -red in |- *; auto with zarith. + forall a b c d:Z, + rel_prime a b -> + rel_prime c d -> b > 0 -> d > 0 -> a * d = b * c -> a = c /\ b = d. +Proof. + intros a b c d; intros. + elim (Zdivide_antisym b d). + split; auto with zarith. + rewrite H4 in H3. + rewrite Zmult_comm in H3. + apply Zmult_reg_l with d; auto with zarith. + intros; omega. + apply Gauss with a. + rewrite H3. + auto with zarith. + red in |- *; auto with zarith. + apply Gauss with c. + rewrite Zmult_comm. + rewrite <- H3. + auto with zarith. + red in |- *; auto with zarith. Qed. (** After factorization by a gcd, the original numbers are relatively prime. *) Lemma Zis_gcd_rel_prime : - forall a b g:Z, - b > 0 -> g >= 0 -> Zis_gcd a b g -> rel_prime (a / g) (b / g). -intros a b g; intros. -assert (g <> 0). - intro. - elim H1; intros. - elim H4; intros. - rewrite H2 in H6; subst b; omega. -unfold rel_prime in |- *. -destruct H1. -destruct H1 as (a',H1). -destruct H3 as (b',H3). -replace (a/g) with a'; - [|rewrite H1; rewrite Z_div_mult; auto with zarith]. -replace (b/g) with b'; - [|rewrite H3; rewrite Z_div_mult; auto with zarith]. -constructor. -exists a'; auto with zarith. -exists b'; auto with zarith. -intros x (xa,H5) (xb,H6). -destruct (H4 (x*g)). -exists xa; rewrite Zmult_assoc; rewrite <- H5; auto. -exists xb; rewrite Zmult_assoc; rewrite <- H6; auto. -replace g with (1*g) in H7; auto with zarith. -do 2 rewrite Zmult_assoc in H7. -generalize (Zmult_reg_r _ _ _ H2 H7); clear H7; intros. -rewrite Zmult_1_r in H7. -exists q; auto with zarith. + forall a b g:Z, + b > 0 -> g >= 0 -> Zis_gcd a b g -> rel_prime (a / g) (b / g). + intros a b g; intros. + assert (g <> 0). + intro. + elim H1; intros. + elim H4; intros. + rewrite H2 in H6; subst b; omega. + unfold rel_prime in |- *. + destruct H1. + destruct H1 as (a',H1). + destruct H3 as (b',H3). + replace (a/g) with a'; + [|rewrite H1; rewrite Z_div_mult; auto with zarith]. + replace (b/g) with b'; + [|rewrite H3; rewrite Z_div_mult; auto with zarith]. + constructor. + exists a'; auto with zarith. + exists b'; auto with zarith. + intros x (xa,H5) (xb,H6). + destruct (H4 (x*g)). + exists xa; rewrite Zmult_assoc; rewrite <- H5; auto. + exists xb; rewrite Zmult_assoc; rewrite <- H6; auto. + replace g with (1*g) in H7; auto with zarith. + do 2 rewrite Zmult_assoc in H7. + generalize (Zmult_reg_r _ _ _ H2 H7); clear H7; intros. + rewrite Zmult_1_r in H7. + exists q; auto with zarith. Qed. (** * Primality *) Inductive prime (p:Z) : Prop := - prime_intro : - 1 < p -> (forall n:Z, 1 <= n < p -> rel_prime n p) -> prime p. + prime_intro : + 1 < p -> (forall n:Z, 1 <= n < p -> rel_prime n p) -> prime p. (** The sole divisors of a prime number [p] are [-1], [1], [p] and [-p]. *) Lemma prime_divisors : - forall p:Z, - prime p -> forall a:Z, (a | p) -> a = -1 \/ a = 1 \/ a = p \/ a = - p. -Proof. -simple induction 1; intros. -assert - (a = - p \/ - p < a < -1 \/ a = -1 \/ a = 0 \/ a = 1 \/ 1 < a < p \/ a = p). -assert (Zabs a <= Zabs p). apply Zdivide_bounds; [ assumption | omega ]. -generalize H3. -pattern (Zabs a) in |- *; apply Zabs_ind; pattern (Zabs p) in |- *; - apply Zabs_ind; intros; omega. -intuition idtac. -(* -p < a < -1 *) -absurd (rel_prime (- a) p); intuition. -inversion H3. -assert (- a | - a); auto with zarith. -assert (- a | p); auto with zarith. -generalize (H8 (- a) H9 H10); intuition idtac. -generalize (Zdivide_1 (- a) H11); intuition. -(* a = 0 *) -inversion H2. subst a; omega. -(* 1 < a < p *) -absurd (rel_prime a p); intuition. -inversion H3. -assert (a | a); auto with zarith. -assert (a | p); auto with zarith. -generalize (H8 a H9 H10); intuition idtac. -generalize (Zdivide_1 a H11); intuition. + forall p:Z, + prime p -> forall a:Z, (a | p) -> a = -1 \/ a = 1 \/ a = p \/ a = - p. +Proof. + simple induction 1; intros. + assert + (a = - p \/ - p < a < -1 \/ a = -1 \/ a = 0 \/ a = 1 \/ 1 < a < p \/ a = p). + assert (Zabs a <= Zabs p). apply Zdivide_bounds; [ assumption | omega ]. + generalize H3. + pattern (Zabs a) in |- *; apply Zabs_ind; pattern (Zabs p) in |- *; + apply Zabs_ind; intros; omega. + intuition idtac. + (* -p < a < -1 *) + absurd (rel_prime (- a) p); intuition. + inversion H3. + assert (- a | - a); auto with zarith. + assert (- a | p); auto with zarith. + generalize (H8 (- a) H9 H10); intuition idtac. + generalize (Zdivide_1 (- a) H11); intuition. + (* a = 0 *) + inversion H2. subst a; omega. + (* 1 < a < p *) + absurd (rel_prime a p); intuition. + inversion H3. + assert (a | a); auto with zarith. + assert (a | p); auto with zarith. + generalize (H8 a H9 H10); intuition idtac. + generalize (Zdivide_1 a H11); intuition. Qed. (** A prime number is relatively prime with any number it does not divide *) Lemma prime_rel_prime : - forall p:Z, prime p -> forall a:Z, ~ (p | a) -> rel_prime p a. + forall p:Z, prime p -> forall a:Z, ~ (p | a) -> rel_prime p a. Proof. -simple induction 1; intros. -constructor; intuition. -elim (prime_divisors p H x H3); intuition; subst; auto with zarith. -absurd (p | a); auto with zarith. -absurd (p | a); intuition. + simple induction 1; intros. + constructor; intuition. + elim (prime_divisors p H x H3); intuition; subst; auto with zarith. + absurd (p | a); auto with zarith. + absurd (p | a); intuition. Qed. Hint Resolve prime_rel_prime: zarith. @@ -546,46 +546,48 @@ Hint Resolve prime_rel_prime: zarith. (** [Zdivide] can be expressed using [Zmod]. *) Lemma Zmod_divide : forall a b:Z, b > 0 -> a mod b = 0 -> (b | a). -intros a b H H0. -apply Zdivide_intro with (a / b). -pattern a at 1 in |- *; rewrite (Z_div_mod_eq a b H). -rewrite H0; ring. +Proof. + intros a b H H0. + apply Zdivide_intro with (a / b). + pattern a at 1 in |- *; rewrite (Z_div_mod_eq a b H). + rewrite H0; ring. Qed. Lemma Zdivide_mod : forall a b:Z, b > 0 -> (b | a) -> a mod b = 0. -intros a b; simple destruct 2; intros; subst. -change (q * b) with (0 + q * b) in |- *. -rewrite Z_mod_plus; auto. +Proof. + intros a b; simple destruct 2; intros; subst. + change (q * b) with (0 + q * b) in |- *. + rewrite Z_mod_plus; auto. Qed. (** [Zdivide] is hence decidable *) Lemma Zdivide_dec : forall a b:Z, {(a | b)} + {~ (a | b)}. Proof. -intros a b; elim (Ztrichotomy_inf a 0). -(* a<0 *) -intros H; elim H; intros. -case (Z_eq_dec (b mod - a) 0). -left; apply Zdivide_opp_l_rev; apply Zmod_divide; auto with zarith. -intro H1; right; intro; elim H1; apply Zdivide_mod; auto with zarith. -(* a=0 *) -case (Z_eq_dec b 0); intro. -left; subst; auto with zarith. -right; subst; intro H0; inversion H0; omega. -(* a>0 *) -intro H; case (Z_eq_dec (b mod a) 0). -left; apply Zmod_divide; auto with zarith. -intro H1; right; intro; elim H1; apply Zdivide_mod; auto with zarith. + intros a b; elim (Ztrichotomy_inf a 0). + (* a<0 *) + intros H; elim H; intros. + case (Z_eq_dec (b mod - a) 0). + left; apply Zdivide_opp_l_rev; apply Zmod_divide; auto with zarith. + intro H1; right; intro; elim H1; apply Zdivide_mod; auto with zarith. + (* a=0 *) + case (Z_eq_dec b 0); intro. + left; subst; auto with zarith. + right; subst; intro H0; inversion H0; omega. + (* a>0 *) + intro H; case (Z_eq_dec (b mod a) 0). + left; apply Zmod_divide; auto with zarith. + intro H1; right; intro; elim H1; apply Zdivide_mod; auto with zarith. Qed. (** If a prime [p] divides [ab] then it divides either [a] or [b] *) Lemma prime_mult : - forall p:Z, prime p -> forall a b:Z, (p | a * b) -> (p | a) \/ (p | b). + forall p:Z, prime p -> forall a b:Z, (p | a * b) -> (p | a) \/ (p | b). Proof. -intro p; simple induction 1; intros. -case (Zdivide_dec p a); intuition. -right; apply Gauss with a; auto with zarith. + intro p; simple induction 1; intros. + case (Zdivide_dec p a); intuition. + right; apply Gauss with a; auto with zarith. Qed. @@ -606,53 +608,53 @@ Qed. Open Scope positive_scope. Fixpoint Pgcdn (n: nat) (a b : positive) { struct n } : positive := - match n with - | O => 1 - | S n => - match a,b with - | xH, _ => 1 - | _, xH => 1 - | xO a, xO b => xO (Pgcdn n a b) - | a, xO b => Pgcdn n a b - | xO a, b => Pgcdn n a b - | xI a', xI b' => match Pcompare a' b' Eq with - | Eq => a - | Lt => Pgcdn n (b'-a') a - | Gt => Pgcdn n (a'-b') b - end - end + match n with + | O => 1 + | S n => + match a,b with + | xH, _ => 1 + | _, xH => 1 + | xO a, xO b => xO (Pgcdn n a b) + | a, xO b => Pgcdn n a b + | xO a, b => Pgcdn n a b + | xI a', xI b' => match Pcompare a' b' Eq with + | Eq => a + | Lt => Pgcdn n (b'-a') a + | Gt => Pgcdn n (a'-b') b + end + end end. Fixpoint Pggcdn (n: nat) (a b : positive) { struct n } : (positive*(positive*positive)) := - match n with - | O => (1,(a,b)) - | S n => - match a,b with - | xH, b => (1,(1,b)) - | a, xH => (1,(a,1)) - | xO a, xO b => - let (g,p) := Pggcdn n a b in - (xO g,p) - | a, xO b => - let (g,p) := Pggcdn n a b in - let (aa,bb) := p in - (g,(aa, xO bb)) - | xO a, b => - let (g,p) := Pggcdn n a b in - let (aa,bb) := p in - (g,(xO aa, bb)) - | xI a', xI b' => match Pcompare a' b' Eq with - | Eq => (a,(1,1)) - | Lt => - let (g,p) := Pggcdn n (b'-a') a in - let (ba,aa) := p in - (g,(aa, aa + xO ba)) - | Gt => - let (g,p) := Pggcdn n (a'-b') b in - let (ab,bb) := p in - (g,(bb+xO ab, bb)) - end - end + match n with + | O => (1,(a,b)) + | S n => + match a,b with + | xH, b => (1,(1,b)) + | a, xH => (1,(a,1)) + | xO a, xO b => + let (g,p) := Pggcdn n a b in + (xO g,p) + | a, xO b => + let (g,p) := Pggcdn n a b in + let (aa,bb) := p in + (g,(aa, xO bb)) + | xO a, b => + let (g,p) := Pggcdn n a b in + let (aa,bb) := p in + (g,(xO aa, bb)) + | xI a', xI b' => match Pcompare a' b' Eq with + | Eq => (a,(1,1)) + | Lt => + let (g,p) := Pggcdn n (b'-a') a in + let (ba,aa) := p in + (g,(aa, aa + xO ba)) + | Gt => + let (g,p) := Pggcdn n (a'-b') b in + let (ab,bb) := p in + (g,(bb+xO ab, bb)) + end + end end. Definition Pgcd (a b: positive) := Pgcdn (Psize a + Psize b)%nat a b. @@ -661,269 +663,269 @@ Definition Pggcd (a b: positive) := Pggcdn (Psize a + Psize b)%nat a b. Open Scope Z_scope. Definition Zgcd (a b : Z) : Z := match a,b with - | Z0, _ => Zabs b - | _, Z0 => Zabs a - | Zpos a, Zpos b => Zpos (Pgcd a b) - | Zpos a, Zneg b => Zpos (Pgcd a b) - | Zneg a, Zpos b => Zpos (Pgcd a b) - | Zneg a, Zneg b => Zpos (Pgcd a b) -end. + | Z0, _ => Zabs b + | _, Z0 => Zabs a + | Zpos a, Zpos b => Zpos (Pgcd a b) + | Zpos a, Zneg b => Zpos (Pgcd a b) + | Zneg a, Zpos b => Zpos (Pgcd a b) + | Zneg a, Zneg b => Zpos (Pgcd a b) + end. Definition Zggcd (a b : Z) : Z*(Z*Z) := match a,b with - | Z0, _ => (Zabs b,(0, Zsgn b)) - | _, Z0 => (Zabs a,(Zsgn a, 0)) - | Zpos a, Zpos b => - let (g,p) := Pggcd a b in - let (aa,bb) := p in - (Zpos g, (Zpos aa, Zpos bb)) - | Zpos a, Zneg b => - let (g,p) := Pggcd a b in - let (aa,bb) := p in - (Zpos g, (Zpos aa, Zneg bb)) - | Zneg a, Zpos b => - let (g,p) := Pggcd a b in - let (aa,bb) := p in - (Zpos g, (Zneg aa, Zpos bb)) - | Zneg a, Zneg b => - let (g,p) := Pggcd a b in - let (aa,bb) := p in - (Zpos g, (Zneg aa, Zneg bb)) -end. + | Z0, _ => (Zabs b,(0, Zsgn b)) + | _, Z0 => (Zabs a,(Zsgn a, 0)) + | Zpos a, Zpos b => + let (g,p) := Pggcd a b in + let (aa,bb) := p in + (Zpos g, (Zpos aa, Zpos bb)) + | Zpos a, Zneg b => + let (g,p) := Pggcd a b in + let (aa,bb) := p in + (Zpos g, (Zpos aa, Zneg bb)) + | Zneg a, Zpos b => + let (g,p) := Pggcd a b in + let (aa,bb) := p in + (Zpos g, (Zneg aa, Zpos bb)) + | Zneg a, Zneg b => + let (g,p) := Pggcd a b in + let (aa,bb) := p in + (Zpos g, (Zneg aa, Zneg bb)) + end. Lemma Zgcd_is_pos : forall a b, 0 <= Zgcd a b. Proof. -unfold Zgcd; destruct a; destruct b; auto with zarith. + unfold Zgcd; destruct a; destruct b; auto with zarith. Qed. Lemma Psize_monotone : forall p q, Pcompare p q Eq = Lt -> (Psize p <= Psize q)%nat. Proof. -induction p; destruct q; simpl; auto with arith; intros; try discriminate. -intros; generalize (Pcompare_Gt_Lt _ _ H); auto with arith. -intros; destruct (Pcompare_Lt_Lt _ _ H); auto with arith; subst; auto. + induction p; destruct q; simpl; auto with arith; intros; try discriminate. + intros; generalize (Pcompare_Gt_Lt _ _ H); auto with arith. + intros; destruct (Pcompare_Lt_Lt _ _ H); auto with arith; subst; auto. Qed. Lemma Pminus_Zminus : forall a b, Pcompare a b Eq = Lt -> - Zpos (b-a) = Zpos b - Zpos a. + Zpos (b-a) = Zpos b - Zpos a. Proof. -intros. -repeat rewrite Zpos_eq_Z_of_nat_o_nat_of_P. -rewrite nat_of_P_minus_morphism. -apply inj_minus1. -apply lt_le_weak. -apply nat_of_P_lt_Lt_compare_morphism; auto. -rewrite ZC4; rewrite H; auto. + intros. + repeat rewrite Zpos_eq_Z_of_nat_o_nat_of_P. + rewrite nat_of_P_minus_morphism. + apply inj_minus1. + apply lt_le_weak. + apply nat_of_P_lt_Lt_compare_morphism; auto. + rewrite ZC4; rewrite H; auto. Qed. Lemma Zis_gcd_even_odd : forall a b g, Zis_gcd (Zpos a) (Zpos (xI b)) g -> - Zis_gcd (Zpos (xO a)) (Zpos (xI b)) g. -Proof. -intros. -destruct H. -constructor; auto. -destruct H as (e,H2); exists (2*e); auto with zarith. -rewrite Zpos_xO; rewrite H2; ring. -intros. -apply H1; auto. -rewrite Zpos_xO in H2. -rewrite Zpos_xI in H3. -apply Gauss with 2; auto. -apply bezout_rel_prime. -destruct H3 as (bb, H3). -apply Bezout_intro with bb (-Zpos b). -omega. + Zis_gcd (Zpos (xO a)) (Zpos (xI b)) g. +Proof. + intros. + destruct H. + constructor; auto. + destruct H as (e,H2); exists (2*e); auto with zarith. + rewrite Zpos_xO; rewrite H2; ring. + intros. + apply H1; auto. + rewrite Zpos_xO in H2. + rewrite Zpos_xI in H3. + apply Gauss with 2; auto. + apply bezout_rel_prime. + destruct H3 as (bb, H3). + apply Bezout_intro with bb (-Zpos b). + omega. Qed. Lemma Pgcdn_correct : forall n a b, (Psize a + Psize b<=n)%nat -> - Zis_gcd (Zpos a) (Zpos b) (Zpos (Pgcdn n a b)). -Proof. -intro n; pattern n; apply lt_wf_ind; clear n; intros. -destruct n. -simpl. -destruct a; simpl in *; try inversion H0. -destruct a. -destruct b; simpl. -case_eq (Pcompare a b Eq); intros. -(* a = xI, b = xI, compare = Eq *) -rewrite (Pcompare_Eq_eq _ _ H1); apply Zis_gcd_refl. -(* a = xI, b = xI, compare = Lt *) -apply Zis_gcd_sym. -apply Zis_gcd_for_euclid with 1. -apply Zis_gcd_sym. -replace (Zpos (xI b) - 1 * Zpos (xI a)) with (Zpos(xO (b - a))). -apply Zis_gcd_even_odd. -apply H; auto. -simpl in *. -assert (Psize (b-a) <= Psize b)%nat. - apply Psize_monotone. - change (Zpos (b-a) < Zpos b). - rewrite (Pminus_Zminus _ _ H1). - assert (0 < Zpos a) by (compute; auto). - omega. -omega. -rewrite Zpos_xO; do 2 rewrite Zpos_xI. -rewrite Pminus_Zminus; auto. -omega. -(* a = xI, b = xI, compare = Gt *) -apply Zis_gcd_for_euclid with 1. -replace (Zpos (xI a) - 1 * Zpos (xI b)) with (Zpos(xO (a - b))). -apply Zis_gcd_sym. -apply Zis_gcd_even_odd. -apply H; auto. -simpl in *. -assert (Psize (a-b) <= Psize a)%nat. - apply Psize_monotone. - change (Zpos (a-b) < Zpos a). - rewrite (Pminus_Zminus b a). - assert (0 < Zpos b) by (compute; auto). - omega. - rewrite ZC4; rewrite H1; auto. -omega. -rewrite Zpos_xO; do 2 rewrite Zpos_xI. -rewrite Pminus_Zminus; auto. -omega. -rewrite ZC4; rewrite H1; auto. -(* a = xI, b = xO *) -apply Zis_gcd_sym. -apply Zis_gcd_even_odd. -apply Zis_gcd_sym. -apply H; auto. -simpl in *; omega. -(* a = xI, b = xH *) -apply Zis_gcd_1. -destruct b; simpl. -(* a = xO, b = xI *) -apply Zis_gcd_even_odd. -apply H; auto. -simpl in *; omega. -(* a = xO, b = xO *) -rewrite (Zpos_xO a); rewrite (Zpos_xO b); rewrite (Zpos_xO (Pgcdn n a b)). -apply Zis_gcd_mult. -apply H; auto. -simpl in *; omega. -(* a = xO, b = xH *) -apply Zis_gcd_1. -(* a = xH *) -simpl; apply Zis_gcd_sym; apply Zis_gcd_1. + Zis_gcd (Zpos a) (Zpos b) (Zpos (Pgcdn n a b)). +Proof. + intro n; pattern n; apply lt_wf_ind; clear n; intros. + destruct n. + simpl. + destruct a; simpl in *; try inversion H0. + destruct a. + destruct b; simpl. + case_eq (Pcompare a b Eq); intros. + (* a = xI, b = xI, compare = Eq *) + rewrite (Pcompare_Eq_eq _ _ H1); apply Zis_gcd_refl. + (* a = xI, b = xI, compare = Lt *) + apply Zis_gcd_sym. + apply Zis_gcd_for_euclid with 1. + apply Zis_gcd_sym. + replace (Zpos (xI b) - 1 * Zpos (xI a)) with (Zpos(xO (b - a))). + apply Zis_gcd_even_odd. + apply H; auto. + simpl in *. + assert (Psize (b-a) <= Psize b)%nat. + apply Psize_monotone. + change (Zpos (b-a) < Zpos b). + rewrite (Pminus_Zminus _ _ H1). + assert (0 < Zpos a) by (compute; auto). + omega. + omega. + rewrite Zpos_xO; do 2 rewrite Zpos_xI. + rewrite Pminus_Zminus; auto. + omega. + (* a = xI, b = xI, compare = Gt *) + apply Zis_gcd_for_euclid with 1. + replace (Zpos (xI a) - 1 * Zpos (xI b)) with (Zpos(xO (a - b))). + apply Zis_gcd_sym. + apply Zis_gcd_even_odd. + apply H; auto. + simpl in *. + assert (Psize (a-b) <= Psize a)%nat. + apply Psize_monotone. + change (Zpos (a-b) < Zpos a). + rewrite (Pminus_Zminus b a). + assert (0 < Zpos b) by (compute; auto). + omega. + rewrite ZC4; rewrite H1; auto. + omega. + rewrite Zpos_xO; do 2 rewrite Zpos_xI. + rewrite Pminus_Zminus; auto. + omega. + rewrite ZC4; rewrite H1; auto. + (* a = xI, b = xO *) + apply Zis_gcd_sym. + apply Zis_gcd_even_odd. + apply Zis_gcd_sym. + apply H; auto. + simpl in *; omega. + (* a = xI, b = xH *) + apply Zis_gcd_1. + destruct b; simpl. + (* a = xO, b = xI *) + apply Zis_gcd_even_odd. + apply H; auto. + simpl in *; omega. + (* a = xO, b = xO *) + rewrite (Zpos_xO a); rewrite (Zpos_xO b); rewrite (Zpos_xO (Pgcdn n a b)). + apply Zis_gcd_mult. + apply H; auto. + simpl in *; omega. + (* a = xO, b = xH *) + apply Zis_gcd_1. + (* a = xH *) + simpl; apply Zis_gcd_sym; apply Zis_gcd_1. Qed. Lemma Pgcd_correct : forall a b, Zis_gcd (Zpos a) (Zpos b) (Zpos (Pgcd a b)). Proof. -unfold Pgcd; intros. -apply Pgcdn_correct; auto. + unfold Pgcd; intros. + apply Pgcdn_correct; auto. Qed. Lemma Zgcd_is_gcd : forall a b, Zis_gcd a b (Zgcd a b). Proof. -destruct a. -intros. -simpl. -apply Zis_gcd_0_abs. -destruct b; simpl. -apply Zis_gcd_0. -apply Pgcd_correct. -apply Zis_gcd_sym. -apply Zis_gcd_minus; simpl. -apply Pgcd_correct. -destruct b; simpl. -apply Zis_gcd_minus; simpl. -apply Zis_gcd_sym. -apply Zis_gcd_0. -apply Zis_gcd_minus; simpl. -apply Zis_gcd_sym. -apply Pgcd_correct. -apply Zis_gcd_sym. -apply Zis_gcd_minus; simpl. -apply Zis_gcd_minus; simpl. -apply Zis_gcd_sym. -apply Pgcd_correct. + destruct a. + intros. + simpl. + apply Zis_gcd_0_abs. + destruct b; simpl. + apply Zis_gcd_0. + apply Pgcd_correct. + apply Zis_gcd_sym. + apply Zis_gcd_minus; simpl. + apply Pgcd_correct. + destruct b; simpl. + apply Zis_gcd_minus; simpl. + apply Zis_gcd_sym. + apply Zis_gcd_0. + apply Zis_gcd_minus; simpl. + apply Zis_gcd_sym. + apply Pgcd_correct. + apply Zis_gcd_sym. + apply Zis_gcd_minus; simpl. + apply Zis_gcd_minus; simpl. + apply Zis_gcd_sym. + apply Pgcd_correct. Qed. Lemma Pggcdn_gcdn : forall n a b, - fst (Pggcdn n a b) = Pgcdn n a b. + fst (Pggcdn n a b) = Pgcdn n a b. Proof. -induction n. -simpl; auto. -destruct a; destruct b; simpl; auto. -destruct (Pcompare a b Eq); simpl; auto. -rewrite <- IHn; destruct (Pggcdn n (b-a) (xI a)) as (g,(aa,bb)); simpl; auto. -rewrite <- IHn; destruct (Pggcdn n (a-b) (xI b)) as (g,(aa,bb)); simpl; auto. -rewrite <- IHn; destruct (Pggcdn n (xI a) b) as (g,(aa,bb)); simpl; auto. -rewrite <- IHn; destruct (Pggcdn n a (xI b)) as (g,(aa,bb)); simpl; auto. -rewrite <- IHn; destruct (Pggcdn n a b) as (g,(aa,bb)); simpl; auto. + induction n. + simpl; auto. + destruct a; destruct b; simpl; auto. + destruct (Pcompare a b Eq); simpl; auto. + rewrite <- IHn; destruct (Pggcdn n (b-a) (xI a)) as (g,(aa,bb)); simpl; auto. + rewrite <- IHn; destruct (Pggcdn n (a-b) (xI b)) as (g,(aa,bb)); simpl; auto. + rewrite <- IHn; destruct (Pggcdn n (xI a) b) as (g,(aa,bb)); simpl; auto. + rewrite <- IHn; destruct (Pggcdn n a (xI b)) as (g,(aa,bb)); simpl; auto. + rewrite <- IHn; destruct (Pggcdn n a b) as (g,(aa,bb)); simpl; auto. Qed. Lemma Pggcd_gcd : forall a b, fst (Pggcd a b) = Pgcd a b. Proof. -intros; exact (Pggcdn_gcdn (Psize a+Psize b)%nat a b). + intros; exact (Pggcdn_gcdn (Psize a+Psize b)%nat a b). Qed. Lemma Zggcd_gcd : forall a b, fst (Zggcd a b) = Zgcd a b. Proof. -destruct a; destruct b; simpl; auto; rewrite <- Pggcd_gcd; -destruct (Pggcd p p0) as (g,(aa,bb)); simpl; auto. + destruct a; destruct b; simpl; auto; rewrite <- Pggcd_gcd; + destruct (Pggcd p p0) as (g,(aa,bb)); simpl; auto. Qed. Open Scope positive_scope. Lemma Pggcdn_correct_divisors : forall n a b, let (g,p) := Pggcdn n a b in - let (aa,bb):=p in - (a=g*aa) /\ (b=g*bb). -Proof. -induction n. -simpl; auto. -destruct a; destruct b; simpl; auto. -case_eq (Pcompare a b Eq); intros. -(* Eq *) -rewrite Pmult_comm; simpl; auto. -rewrite (Pcompare_Eq_eq _ _ H); auto. -(* Lt *) -generalize (IHn (b-a) (xI a)); destruct (Pggcdn n (b-a) (xI a)) as (g,(ba,aa)); simpl. -intros (H0,H1); split; auto. -rewrite Pmult_plus_distr_l. -rewrite Pmult_xO_permute_r. -rewrite <- H1; rewrite <- H0. -simpl; f_equal; symmetry. -apply Pplus_minus; auto. -rewrite ZC4; rewrite H; auto. -(* Gt *) -generalize (IHn (a-b) (xI b)); destruct (Pggcdn n (a-b) (xI b)) as (g,(ab,bb)); simpl. -intros (H0,H1); split; auto. -rewrite Pmult_plus_distr_l. -rewrite Pmult_xO_permute_r. -rewrite <- H1; rewrite <- H0. -simpl; f_equal; symmetry. -apply Pplus_minus; auto. -(* Then... *) -generalize (IHn (xI a) b); destruct (Pggcdn n (xI a) b) as (g,(ab,bb)); simpl. -intros (H0,H1); split; auto. -rewrite Pmult_xO_permute_r; rewrite H1; auto. -generalize (IHn a (xI b)); destruct (Pggcdn n a (xI b)) as (g,(ab,bb)); simpl. -intros (H0,H1); split; auto. -rewrite Pmult_xO_permute_r; rewrite H0; auto. -generalize (IHn a b); destruct (Pggcdn n a b) as (g,(ab,bb)); simpl. -intros (H0,H1); split; subst; auto. + let (aa,bb):=p in + (a=g*aa) /\ (b=g*bb). +Proof. + induction n. + simpl; auto. + destruct a; destruct b; simpl; auto. + case_eq (Pcompare a b Eq); intros. + (* Eq *) + rewrite Pmult_comm; simpl; auto. + rewrite (Pcompare_Eq_eq _ _ H); auto. + (* Lt *) + generalize (IHn (b-a) (xI a)); destruct (Pggcdn n (b-a) (xI a)) as (g,(ba,aa)); simpl. + intros (H0,H1); split; auto. + rewrite Pmult_plus_distr_l. + rewrite Pmult_xO_permute_r. + rewrite <- H1; rewrite <- H0. + simpl; f_equal; symmetry. + apply Pplus_minus; auto. + rewrite ZC4; rewrite H; auto. + (* Gt *) + generalize (IHn (a-b) (xI b)); destruct (Pggcdn n (a-b) (xI b)) as (g,(ab,bb)); simpl. + intros (H0,H1); split; auto. + rewrite Pmult_plus_distr_l. + rewrite Pmult_xO_permute_r. + rewrite <- H1; rewrite <- H0. + simpl; f_equal; symmetry. + apply Pplus_minus; auto. + (* Then... *) + generalize (IHn (xI a) b); destruct (Pggcdn n (xI a) b) as (g,(ab,bb)); simpl. + intros (H0,H1); split; auto. + rewrite Pmult_xO_permute_r; rewrite H1; auto. + generalize (IHn a (xI b)); destruct (Pggcdn n a (xI b)) as (g,(ab,bb)); simpl. + intros (H0,H1); split; auto. + rewrite Pmult_xO_permute_r; rewrite H0; auto. + generalize (IHn a b); destruct (Pggcdn n a b) as (g,(ab,bb)); simpl. + intros (H0,H1); split; subst; auto. Qed. Lemma Pggcd_correct_divisors : forall a b, let (g,p) := Pggcd a b in - let (aa,bb):=p in - (a=g*aa) /\ (b=g*bb). + let (aa,bb):=p in + (a=g*aa) /\ (b=g*bb). Proof. -intros a b; exact (Pggcdn_correct_divisors (Psize a + Psize b)%nat a b). + intros a b; exact (Pggcdn_correct_divisors (Psize a + Psize b)%nat a b). Qed. Open Scope Z_scope. Lemma Zggcd_correct_divisors : forall a b, let (g,p) := Zggcd a b in - let (aa,bb):=p in - (a=g*aa) /\ (b=g*bb). + let (aa,bb):=p in + (a=g*aa) /\ (b=g*bb). Proof. -destruct a; destruct b; simpl; auto; try solve [rewrite Pmult_comm; simpl; auto]; -generalize (Pggcd_correct_divisors p p0); destruct (Pggcd p p0) as (g,(aa,bb)); -destruct 1; subst; auto. + destruct a; destruct b; simpl; auto; try solve [rewrite Pmult_comm; simpl; auto]; + generalize (Pggcd_correct_divisors p p0); destruct (Pggcd p p0) as (g,(aa,bb)); + destruct 1; subst; auto. Qed. Theorem Zgcd_spec : forall x y : Z, {z : Z | Zis_gcd x y z /\ 0 <= z}. diff --git a/theories/ZArith/Zorder.v b/theories/ZArith/Zorder.v index b81cc580..47490be6 100644 --- a/theories/ZArith/Zorder.v +++ b/theories/ZArith/Zorder.v @@ -5,13 +5,13 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Zorder.v 6983 2005-05-02 10:47:51Z herbelin $ i*) +(*i $Id: Zorder.v 9302 2006-10-27 21:21:17Z barras $ i*) (** Binary Integers (Pierre Crégut (CNET, Lannion, France) *) Require Import BinPos. Require Import BinInt. -Require Import Arith. +Require Import Arith_base. Require Import Decidable. Require Import Zcompare. @@ -19,178 +19,180 @@ Open Local Scope Z_scope. Implicit Types x y z : Z. -(**********************************************************************) +(*********************************************************) (** Properties of the order relations on binary integers *) -(** Trichotomy *) +(** * Trichotomy *) Theorem Ztrichotomy_inf : forall n m:Z, {n < m} + {n = m} + {n > m}. Proof. -unfold Zgt, Zlt in |- *; intros m n; assert (H := refl_equal (m ?= n)). + unfold Zgt, Zlt in |- *; intros m n; assert (H := refl_equal (m ?= n)). set (x := m ?= n) in H at 2 |- *. destruct x; - [ left; right; rewrite Zcompare_Eq_eq with (1 := H) | left; left | right ]; - reflexivity. + [ left; right; rewrite Zcompare_Eq_eq with (1 := H) | left; left | right ]; + reflexivity. Qed. Theorem Ztrichotomy : forall n m:Z, n < m \/ n = m \/ n > m. Proof. intros m n; destruct (Ztrichotomy_inf m n) as [[Hlt| Heq]| Hgt]; - [ left | right; left | right; right ]; assumption. + [ left | right; left | right; right ]; assumption. Qed. (**********************************************************************) -(** Decidability of equality and order on Z *) +(** * Decidability of equality and order on Z *) Theorem dec_eq : forall n m:Z, decidable (n = m). Proof. -intros x y; unfold decidable in |- *; elim (Zcompare_Eq_iff_eq x y); - intros H1 H2; elim (Dcompare (x ?= y)); - [ tauto - | intros H3; right; unfold not in |- *; intros H4; elim H3; rewrite (H2 H4); - intros H5; discriminate H5 ]. + intros x y; unfold decidable in |- *; elim (Zcompare_Eq_iff_eq x y); + intros H1 H2; elim (Dcompare (x ?= y)); + [ tauto + | intros H3; right; unfold not in |- *; intros H4; elim H3; rewrite (H2 H4); + intros H5; discriminate H5 ]. Qed. Theorem dec_Zne : forall n m:Z, decidable (Zne n m). Proof. -intros x y; unfold decidable, Zne in |- *; elim (Zcompare_Eq_iff_eq x y). -intros H1 H2; elim (Dcompare (x ?= y)); - [ right; rewrite H1; auto - | left; unfold not in |- *; intro; absurd ((x ?= y) = Eq); - [ elim H; intros HR; rewrite HR; discriminate | auto ] ]. + intros x y; unfold decidable, Zne in |- *; elim (Zcompare_Eq_iff_eq x y). + intros H1 H2; elim (Dcompare (x ?= y)); + [ right; rewrite H1; auto + | left; unfold not in |- *; intro; absurd ((x ?= y) = Eq); + [ elim H; intros HR; rewrite HR; discriminate | auto ] ]. Qed. Theorem dec_Zle : forall n m:Z, decidable (n <= m). Proof. -intros x y; unfold decidable, Zle in |- *; elim (x ?= y); - [ left; discriminate - | left; discriminate - | right; unfold not in |- *; intros H; apply H; trivial with arith ]. + intros x y; unfold decidable, Zle in |- *; elim (x ?= y); + [ left; discriminate + | left; discriminate + | right; unfold not in |- *; intros H; apply H; trivial with arith ]. Qed. Theorem dec_Zgt : forall n m:Z, decidable (n > m). Proof. -intros x y; unfold decidable, Zgt in |- *; elim (x ?= y); - [ right; discriminate | right; discriminate | auto with arith ]. + intros x y; unfold decidable, Zgt in |- *; elim (x ?= y); + [ right; discriminate | right; discriminate | auto with arith ]. Qed. Theorem dec_Zge : forall n m:Z, decidable (n >= m). Proof. -intros x y; unfold decidable, Zge in |- *; elim (x ?= y); - [ left; discriminate - | right; unfold not in |- *; intros H; apply H; trivial with arith - | left; discriminate ]. + intros x y; unfold decidable, Zge in |- *; elim (x ?= y); + [ left; discriminate + | right; unfold not in |- *; intros H; apply H; trivial with arith + | left; discriminate ]. Qed. Theorem dec_Zlt : forall n m:Z, decidable (n < m). Proof. -intros x y; unfold decidable, Zlt in |- *; elim (x ?= y); - [ right; discriminate | auto with arith | right; discriminate ]. + intros x y; unfold decidable, Zlt in |- *; elim (x ?= y); + [ right; discriminate | auto with arith | right; discriminate ]. Qed. Theorem not_Zeq : forall n m:Z, n <> m -> n < m \/ m < n. Proof. -intros x y; elim (Dcompare (x ?= y)); - [ intros H1 H2; absurd (x = y); - [ assumption | elim (Zcompare_Eq_iff_eq x y); auto with arith ] - | unfold Zlt in |- *; intros H; elim H; intros H1; - [ auto with arith - | right; elim (Zcompare_Gt_Lt_antisym x y); auto with arith ] ]. + intros x y; elim (Dcompare (x ?= y)); + [ intros H1 H2; absurd (x = y); + [ assumption | elim (Zcompare_Eq_iff_eq x y); auto with arith ] + | unfold Zlt in |- *; intros H; elim H; intros H1; + [ auto with arith + | right; elim (Zcompare_Gt_Lt_antisym x y); auto with arith ] ]. Qed. -(** Relating strict and large orders *) +(** * Relating strict and large orders *) Lemma Zgt_lt : forall n m:Z, n > m -> m < n. Proof. -unfold Zgt, Zlt in |- *; intros m n H; elim (Zcompare_Gt_Lt_antisym m n); - auto with arith. + unfold Zgt, Zlt in |- *; intros m n H; elim (Zcompare_Gt_Lt_antisym m n); + auto with arith. Qed. Lemma Zlt_gt : forall n m:Z, n < m -> m > n. Proof. -unfold Zgt, Zlt in |- *; intros m n H; elim (Zcompare_Gt_Lt_antisym n m); - auto with arith. + unfold Zgt, Zlt in |- *; intros m n H; elim (Zcompare_Gt_Lt_antisym n m); + auto with arith. Qed. Lemma Zge_le : forall n m:Z, n >= m -> m <= n. Proof. -intros m n; change (~ m < n -> ~ n > m) in |- *; unfold not in |- *; - intros H1 H2; apply H1; apply Zgt_lt; assumption. + intros m n; change (~ m < n -> ~ n > m) in |- *; unfold not in |- *; + intros H1 H2; apply H1; apply Zgt_lt; assumption. Qed. Lemma Zle_ge : forall n m:Z, n <= m -> m >= n. Proof. -intros m n; change (~ m > n -> ~ n < m) in |- *; unfold not in |- *; - intros H1 H2; apply H1; apply Zlt_gt; assumption. + intros m n; change (~ m > n -> ~ n < m) in |- *; unfold not in |- *; + intros H1 H2; apply H1; apply Zlt_gt; assumption. Qed. Lemma Zle_not_gt : forall n m:Z, n <= m -> ~ n > m. Proof. -trivial. + trivial. Qed. Lemma Zgt_not_le : forall n m:Z, n > m -> ~ n <= m. Proof. -intros n m H1 H2; apply H2; assumption. + intros n m H1 H2; apply H2; assumption. Qed. Lemma Zle_not_lt : forall n m:Z, n <= m -> ~ m < n. Proof. -intros n m H1 H2. -assert (H3 := Zlt_gt _ _ H2). -apply Zle_not_gt with n m; assumption. + intros n m H1 H2. + assert (H3 := Zlt_gt _ _ H2). + apply Zle_not_gt with n m; assumption. Qed. Lemma Zlt_not_le : forall n m:Z, n < m -> ~ m <= n. Proof. -intros n m H1 H2. -apply Zle_not_lt with m n; assumption. + intros n m H1 H2. + apply Zle_not_lt with m n; assumption. Qed. Lemma Znot_ge_lt : forall n m:Z, ~ n >= m -> n < m. Proof. -unfold Zge, Zlt in |- *; intros x y H; apply dec_not_not; - [ exact (dec_Zlt x y) | assumption ]. + unfold Zge, Zlt in |- *; intros x y H; apply dec_not_not; + [ exact (dec_Zlt x y) | assumption ]. Qed. - + Lemma Znot_lt_ge : forall n m:Z, ~ n < m -> n >= m. Proof. -unfold Zlt, Zge in |- *; auto with arith. + unfold Zlt, Zge in |- *; auto with arith. Qed. Lemma Znot_gt_le : forall n m:Z, ~ n > m -> n <= m. Proof. -trivial. + trivial. Qed. Lemma Znot_le_gt : forall n m:Z, ~ n <= m -> n > m. Proof. -unfold Zle, Zgt in |- *; intros x y H; apply dec_not_not; - [ exact (dec_Zgt x y) | assumption ]. + unfold Zle, Zgt in |- *; intros x y H; apply dec_not_not; + [ exact (dec_Zgt x y) | assumption ]. Qed. Lemma Zge_iff_le : forall n m:Z, n >= m <-> m <= n. Proof. - intros x y; intros. split. intro. apply Zge_le. assumption. - intro. apply Zle_ge. assumption. + intros x y; intros. split. intro. apply Zge_le. assumption. + intro. apply Zle_ge. assumption. Qed. Lemma Zgt_iff_lt : forall n m:Z, n > m <-> m < n. Proof. - intros x y. split. intro. apply Zgt_lt. assumption. - intro. apply Zlt_gt. assumption. + intros x y. split. intro. apply Zgt_lt. assumption. + intro. apply Zlt_gt. assumption. Qed. +(** * Equivalence and order properties *) + (** Reflexivity *) Lemma Zle_refl : forall n:Z, n <= n. Proof. -intros n; unfold Zle in |- *; rewrite (Zcompare_refl n); discriminate. + intros n; unfold Zle in |- *; rewrite (Zcompare_refl n); discriminate. Qed. Lemma Zeq_le : forall n m:Z, n = m -> n <= m. Proof. -intros; rewrite H; apply Zle_refl. + intros; rewrite H; apply Zle_refl. Qed. Hint Resolve Zle_refl: zarith. @@ -199,7 +201,7 @@ Hint Resolve Zle_refl: zarith. Lemma Zle_antisym : forall n m:Z, n <= m -> m <= n -> n = m. Proof. -intros n m H1 H2; destruct (Ztrichotomy n m) as [Hlt| [Heq| Hgt]]. + intros n m H1 H2; destruct (Ztrichotomy n m) as [Hlt| [Heq| Hgt]]. absurd (m > n); [ apply Zle_not_gt | apply Zlt_gt ]; assumption. assumption. absurd (n > m); [ apply Zle_not_gt | idtac ]; assumption. @@ -209,138 +211,143 @@ Qed. Lemma Zgt_asym : forall n m:Z, n > m -> ~ m > n. Proof. -unfold Zgt in |- *; intros n m H; elim (Zcompare_Gt_Lt_antisym n m); - intros H1 H2; rewrite H1; [ discriminate | assumption ]. + unfold Zgt in |- *; intros n m H; elim (Zcompare_Gt_Lt_antisym n m); + intros H1 H2; rewrite H1; [ discriminate | assumption ]. Qed. Lemma Zlt_asym : forall n m:Z, n < m -> ~ m < n. Proof. -intros n m H H1; assert (H2 : m > n). apply Zlt_gt; assumption. -assert (H3 : n > m). apply Zlt_gt; assumption. -apply Zgt_asym with m n; assumption. + intros n m H H1; assert (H2 : m > n). apply Zlt_gt; assumption. + assert (H3 : n > m). apply Zlt_gt; assumption. + apply Zgt_asym with m n; assumption. Qed. (** Irreflexivity *) Lemma Zgt_irrefl : forall n:Z, ~ n > n. Proof. -intros n H; apply (Zgt_asym n n H H). + intros n H; apply (Zgt_asym n n H H). Qed. Lemma Zlt_irrefl : forall n:Z, ~ n < n. Proof. -intros n H; apply (Zlt_asym n n H H). + intros n H; apply (Zlt_asym n n H H). Qed. Lemma Zlt_not_eq : forall n m:Z, n < m -> n <> m. Proof. -unfold not in |- *; intros x y H H0. -rewrite H0 in H. -apply (Zlt_irrefl _ H). + unfold not in |- *; intros x y H H0. + rewrite H0 in H. + apply (Zlt_irrefl _ H). Qed. (** Large = strict or equal *) Lemma Zlt_le_weak : forall n m:Z, n < m -> n <= m. Proof. -intros n m Hlt; apply Znot_gt_le; apply Zgt_asym; apply Zlt_gt; assumption. + intros n m Hlt; apply Znot_gt_le; apply Zgt_asym; apply Zlt_gt; assumption. Qed. Lemma Zle_lt_or_eq : forall n m:Z, n <= m -> n < m \/ n = m. Proof. -intros n m H; destruct (Ztrichotomy n m) as [Hlt| [Heq| Hgt]]; - [ left; assumption - | right; assumption - | absurd (n > m); [ apply Zle_not_gt | idtac ]; assumption ]. + intros n m H; destruct (Ztrichotomy n m) as [Hlt| [Heq| Hgt]]; + [ left; assumption + | right; assumption + | absurd (n > m); [ apply Zle_not_gt | idtac ]; assumption ]. Qed. (** Dichotomy *) Lemma Zle_or_lt : forall n m:Z, n <= m \/ m < n. Proof. -intros n m; destruct (Ztrichotomy n m) as [Hlt| [Heq| Hgt]]; - [ left; apply Znot_gt_le; intro Hgt; assert (Hgt' := Zlt_gt _ _ Hlt); - apply Zgt_asym with m n; assumption - | left; rewrite Heq; apply Zle_refl - | right; apply Zgt_lt; assumption ]. + intros n m; destruct (Ztrichotomy n m) as [Hlt| [Heq| Hgt]]; + [ left; apply Znot_gt_le; intro Hgt; assert (Hgt' := Zlt_gt _ _ Hlt); + apply Zgt_asym with m n; assumption + | left; rewrite Heq; apply Zle_refl + | right; apply Zgt_lt; assumption ]. Qed. (** Transitivity of strict orders *) Lemma Zgt_trans : forall n m p:Z, n > m -> m > p -> n > p. Proof. -exact Zcompare_Gt_trans. + exact Zcompare_Gt_trans. Qed. Lemma Zlt_trans : forall n m p:Z, n < m -> m < p -> n < p. Proof. -intros n m p H1 H2; apply Zgt_lt; apply Zgt_trans with (m := m); apply Zlt_gt; - assumption. + intros n m p H1 H2; apply Zgt_lt; apply Zgt_trans with (m := m); apply Zlt_gt; + assumption. Qed. (** Mixed transitivity *) Lemma Zle_gt_trans : forall n m p:Z, m <= n -> m > p -> n > p. Proof. -intros n m p H1 H2; destruct (Zle_lt_or_eq m n H1) as [Hlt| Heq]; - [ apply Zgt_trans with m; [ apply Zlt_gt; assumption | assumption ] - | rewrite <- Heq; assumption ]. + intros n m p H1 H2; destruct (Zle_lt_or_eq m n H1) as [Hlt| Heq]; + [ apply Zgt_trans with m; [ apply Zlt_gt; assumption | assumption ] + | rewrite <- Heq; assumption ]. Qed. Lemma Zgt_le_trans : forall n m p:Z, n > m -> p <= m -> n > p. Proof. -intros n m p H1 H2; destruct (Zle_lt_or_eq p m H2) as [Hlt| Heq]; - [ apply Zgt_trans with m; [ assumption | apply Zlt_gt; assumption ] - | rewrite Heq; assumption ]. + intros n m p H1 H2; destruct (Zle_lt_or_eq p m H2) as [Hlt| Heq]; + [ apply Zgt_trans with m; [ assumption | apply Zlt_gt; assumption ] + | rewrite Heq; assumption ]. Qed. Lemma Zlt_le_trans : forall n m p:Z, n < m -> m <= p -> n < p. -intros n m p H1 H2; apply Zgt_lt; apply Zle_gt_trans with (m := m); - [ assumption | apply Zlt_gt; assumption ]. + intros n m p H1 H2; apply Zgt_lt; apply Zle_gt_trans with (m := m); + [ assumption | apply Zlt_gt; assumption ]. Qed. Lemma Zle_lt_trans : forall n m p:Z, n <= m -> m < p -> n < p. Proof. -intros n m p H1 H2; apply Zgt_lt; apply Zgt_le_trans with (m := m); - [ apply Zlt_gt; assumption | assumption ]. + intros n m p H1 H2; apply Zgt_lt; apply Zgt_le_trans with (m := m); + [ apply Zlt_gt; assumption | assumption ]. Qed. (** Transitivity of large orders *) Lemma Zle_trans : forall n m p:Z, n <= m -> m <= p -> n <= p. Proof. -intros n m p H1 H2; apply Znot_gt_le. -intro Hgt; apply Zle_not_gt with n m. assumption. -exact (Zgt_le_trans n p m Hgt H2). + intros n m p H1 H2; apply Znot_gt_le. + intro Hgt; apply Zle_not_gt with n m. assumption. + exact (Zgt_le_trans n p m Hgt H2). Qed. Lemma Zge_trans : forall n m p:Z, n >= m -> m >= p -> n >= p. Proof. -intros n m p H1 H2. -apply Zle_ge. -apply Zle_trans with m; apply Zge_le; trivial. + intros n m p H1 H2. + apply Zle_ge. + apply Zle_trans with m; apply Zge_le; trivial. Qed. Hint Resolve Zle_trans: zarith. + +(** * Compatibility of order and operations on Z *) + +(** ** Successor *) + (** Compatibility of successor wrt to order *) Lemma Zsucc_le_compat : forall n m:Z, m <= n -> Zsucc m <= Zsucc n. Proof. -unfold Zle, not in |- *; intros m n H1 H2; apply H1; - rewrite <- (Zcompare_plus_compat n m 1); do 2 rewrite (Zplus_comm 1); - exact H2. + unfold Zle, not in |- *; intros m n H1 H2; apply H1; + rewrite <- (Zcompare_plus_compat n m 1); do 2 rewrite (Zplus_comm 1); + exact H2. Qed. Lemma Zsucc_gt_compat : forall n m:Z, m > n -> Zsucc m > Zsucc n. Proof. -unfold Zgt in |- *; intros n m H; rewrite Zcompare_succ_compat; - auto with arith. + unfold Zgt in |- *; intros n m H; rewrite Zcompare_succ_compat; + auto with arith. Qed. Lemma Zsucc_lt_compat : forall n m:Z, n < m -> Zsucc n < Zsucc m. Proof. -intros n m H; apply Zgt_lt; apply Zsucc_gt_compat; apply Zlt_gt; assumption. + intros n m H; apply Zgt_lt; apply Zsucc_gt_compat; apply Zlt_gt; assumption. Qed. Hint Resolve Zsucc_le_compat: zarith. @@ -349,231 +356,119 @@ Hint Resolve Zsucc_le_compat: zarith. Lemma Zsucc_gt_reg : forall n m:Z, Zsucc m > Zsucc n -> m > n. Proof. -unfold Zsucc, Zgt in |- *; intros n p; - do 2 rewrite (fun m:Z => Zplus_comm m 1); - rewrite (Zcompare_plus_compat p n 1); trivial with arith. + unfold Zsucc, Zgt in |- *; intros n p; + do 2 rewrite (fun m:Z => Zplus_comm m 1); + rewrite (Zcompare_plus_compat p n 1); trivial with arith. Qed. Lemma Zsucc_le_reg : forall n m:Z, Zsucc m <= Zsucc n -> m <= n. Proof. -unfold Zle, not in |- *; intros m n H1 H2; apply H1; unfold Zsucc in |- *; - do 2 rewrite <- (Zplus_comm 1); rewrite (Zcompare_plus_compat n m 1); - assumption. + unfold Zle, not in |- *; intros m n H1 H2; apply H1; unfold Zsucc in |- *; + do 2 rewrite <- (Zplus_comm 1); rewrite (Zcompare_plus_compat n m 1); + assumption. Qed. Lemma Zsucc_lt_reg : forall n m:Z, Zsucc n < Zsucc m -> n < m. Proof. -intros n m H; apply Zgt_lt; apply Zsucc_gt_reg; apply Zlt_gt; assumption. -Qed. - -(** Compatibility of addition wrt to order *) - -Lemma Zplus_gt_compat_l : forall n m p:Z, n > m -> p + n > p + m. -Proof. -unfold Zgt in |- *; intros n m p H; rewrite (Zcompare_plus_compat n m p); - assumption. -Qed. - -Lemma Zplus_gt_compat_r : forall n m p:Z, n > m -> n + p > m + p. -Proof. -intros n m p H; rewrite (Zplus_comm n p); rewrite (Zplus_comm m p); - apply Zplus_gt_compat_l; trivial. -Qed. - -Lemma Zplus_le_compat_l : forall n m p:Z, n <= m -> p + n <= p + m. -Proof. -intros n m p; unfold Zle, not in |- *; intros H1 H2; apply H1; - rewrite <- (Zcompare_plus_compat n m p); assumption. -Qed. - -Lemma Zplus_le_compat_r : forall n m p:Z, n <= m -> n + p <= m + p. -Proof. -intros a b c; do 2 rewrite (fun n:Z => Zplus_comm n c); - exact (Zplus_le_compat_l a b c). -Qed. - -Lemma Zplus_lt_compat_l : forall n m p:Z, n < m -> p + n < p + m. -Proof. -unfold Zlt in |- *; intros n m p; rewrite Zcompare_plus_compat; - trivial with arith. -Qed. - -Lemma Zplus_lt_compat_r : forall n m p:Z, n < m -> n + p < m + p. -Proof. -intros n m p H; rewrite (Zplus_comm n p); rewrite (Zplus_comm m p); - apply Zplus_lt_compat_l; trivial. -Qed. - -Lemma Zplus_lt_le_compat : forall n m p q:Z, n < m -> p <= q -> n + p < m + q. -Proof. -intros a b c d H0 H1. -apply Zlt_le_trans with (b + c). -apply Zplus_lt_compat_r; trivial. -apply Zplus_le_compat_l; trivial. -Qed. - -Lemma Zplus_le_lt_compat : forall n m p q:Z, n <= m -> p < q -> n + p < m + q. -Proof. -intros a b c d H0 H1. -apply Zle_lt_trans with (b + c). -apply Zplus_le_compat_r; trivial. -apply Zplus_lt_compat_l; trivial. -Qed. - -Lemma Zplus_le_compat : forall n m p q:Z, n <= m -> p <= q -> n + p <= m + q. -Proof. -intros n m p q; intros H1 H2; apply Zle_trans with (m := n + q); - [ apply Zplus_le_compat_l; assumption - | apply Zplus_le_compat_r; assumption ]. + intros n m H; apply Zgt_lt; apply Zsucc_gt_reg; apply Zlt_gt; assumption. Qed. - -Lemma Zplus_lt_compat : forall n m p q:Z, n < m -> p < q -> n + p < m + q. -intros; apply Zplus_le_lt_compat. apply Zlt_le_weak; assumption. assumption. -Qed. - - -(** Compatibility of addition wrt to being positive *) - -Lemma Zplus_le_0_compat : forall n m:Z, 0 <= n -> 0 <= m -> 0 <= n + m. -Proof. -intros x y H1 H2; rewrite <- (Zplus_0_l 0); apply Zplus_le_compat; assumption. -Qed. - -(** Simplification of addition wrt to order *) - -Lemma Zplus_gt_reg_l : forall n m p:Z, p + n > p + m -> n > m. -Proof. -unfold Zgt in |- *; intros n m p H; rewrite <- (Zcompare_plus_compat n m p); - assumption. -Qed. - -Lemma Zplus_gt_reg_r : forall n m p:Z, n + p > m + p -> n > m. -Proof. -intros n m p H; apply Zplus_gt_reg_l with p. -rewrite (Zplus_comm p n); rewrite (Zplus_comm p m); trivial. -Qed. - -Lemma Zplus_le_reg_l : forall n m p:Z, p + n <= p + m -> n <= m. -Proof. -intros n m p; unfold Zle, not in |- *; intros H1 H2; apply H1; - rewrite (Zcompare_plus_compat n m p); assumption. -Qed. - -Lemma Zplus_le_reg_r : forall n m p:Z, n + p <= m + p -> n <= m. -Proof. -intros n m p H; apply Zplus_le_reg_l with p. -rewrite (Zplus_comm p n); rewrite (Zplus_comm p m); trivial. -Qed. - -Lemma Zplus_lt_reg_l : forall n m p:Z, p + n < p + m -> n < m. -Proof. -unfold Zlt in |- *; intros n m p; rewrite Zcompare_plus_compat; - trivial with arith. -Qed. - -Lemma Zplus_lt_reg_r : forall n m p:Z, n + p < m + p -> n < m. -Proof. -intros n m p H; apply Zplus_lt_reg_l with p. -rewrite (Zplus_comm p n); rewrite (Zplus_comm p m); trivial. -Qed. - (** Special base instances of order *) Lemma Zgt_succ : forall n:Z, Zsucc n > n. Proof. -exact Zcompare_succ_Gt. + exact Zcompare_succ_Gt. Qed. Lemma Znot_le_succ : forall n:Z, ~ Zsucc n <= n. Proof. -intros n; apply Zgt_not_le; apply Zgt_succ. + intros n; apply Zgt_not_le; apply Zgt_succ. Qed. Lemma Zlt_succ : forall n:Z, n < Zsucc n. Proof. -intro n; apply Zgt_lt; apply Zgt_succ. + intro n; apply Zgt_lt; apply Zgt_succ. Qed. Lemma Zlt_pred : forall n:Z, Zpred n < n. Proof. -intros n; apply Zsucc_lt_reg; rewrite <- Zsucc_pred; apply Zlt_succ. + intros n; apply Zsucc_lt_reg; rewrite <- Zsucc_pred; apply Zlt_succ. Qed. (** Relating strict and large order using successor or predecessor *) Lemma Zgt_le_succ : forall n m:Z, m > n -> Zsucc n <= m. Proof. -unfold Zgt, Zle in |- *; intros n p H; elim (Zcompare_Gt_not_Lt p n); - intros H1 H2; unfold not in |- *; intros H3; unfold not in H1; - apply H1; - [ assumption - | elim (Zcompare_Gt_Lt_antisym (n + 1) p); intros H4 H5; apply H4; exact H3 ]. + unfold Zgt, Zle in |- *; intros n p H; elim (Zcompare_Gt_not_Lt p n); + intros H1 H2; unfold not in |- *; intros H3; unfold not in H1; + apply H1; + [ assumption + | elim (Zcompare_Gt_Lt_antisym (n + 1) p); intros H4 H5; apply H4; exact H3 ]. Qed. Lemma Zlt_gt_succ : forall n m:Z, n <= m -> Zsucc m > n. Proof. -intros n p H; apply Zgt_le_trans with p. + intros n p H; apply Zgt_le_trans with p. apply Zgt_succ. assumption. Qed. Lemma Zle_lt_succ : forall n m:Z, n <= m -> n < Zsucc m. Proof. -intros n m H; apply Zgt_lt; apply Zlt_gt_succ; assumption. + intros n m H; apply Zgt_lt; apply Zlt_gt_succ; assumption. Qed. Lemma Zlt_le_succ : forall n m:Z, n < m -> Zsucc n <= m. Proof. -intros n p H; apply Zgt_le_succ; apply Zlt_gt; assumption. + intros n p H; apply Zgt_le_succ; apply Zlt_gt; assumption. Qed. Lemma Zgt_succ_le : forall n m:Z, Zsucc m > n -> n <= m. Proof. -intros n p H; apply Zsucc_le_reg; apply Zgt_le_succ; assumption. + intros n p H; apply Zsucc_le_reg; apply Zgt_le_succ; assumption. Qed. Lemma Zlt_succ_le : forall n m:Z, n < Zsucc m -> n <= m. Proof. -intros n m H; apply Zgt_succ_le; apply Zlt_gt; assumption. + intros n m H; apply Zgt_succ_le; apply Zlt_gt; assumption. Qed. Lemma Zlt_succ_gt : forall n m:Z, Zsucc n <= m -> m > n. Proof. -intros n m H; apply Zle_gt_trans with (m := Zsucc n); - [ assumption | apply Zgt_succ ]. + intros n m H; apply Zle_gt_trans with (m := Zsucc n); + [ assumption | apply Zgt_succ ]. Qed. (** Weakening order *) Lemma Zle_succ : forall n:Z, n <= Zsucc n. Proof. -intros n; apply Zgt_succ_le; apply Zgt_trans with (m := Zsucc n); - apply Zgt_succ. + intros n; apply Zgt_succ_le; apply Zgt_trans with (m := Zsucc n); + apply Zgt_succ. Qed. Hint Resolve Zle_succ: zarith. Lemma Zle_pred : forall n:Z, Zpred n <= n. Proof. -intros n; pattern n at 2 in |- *; rewrite Zsucc_pred; apply Zle_succ. + intros n; pattern n at 2 in |- *; rewrite Zsucc_pred; apply Zle_succ. Qed. Lemma Zlt_lt_succ : forall n m:Z, n < m -> n < Zsucc m. -intros n m H; apply Zgt_lt; apply Zgt_trans with (m := m); - [ apply Zgt_succ | apply Zlt_gt; assumption ]. + intros n m H; apply Zgt_lt; apply Zgt_trans with (m := m); + [ apply Zgt_succ | apply Zlt_gt; assumption ]. Qed. Lemma Zle_le_succ : forall n m:Z, n <= m -> n <= Zsucc m. Proof. -intros x y H. -apply Zle_trans with y; trivial with zarith. + intros x y H. + apply Zle_trans with y; trivial with zarith. Qed. Lemma Zle_succ_le : forall n m:Z, Zsucc n <= m -> n <= m. Proof. -intros n m H; apply Zle_trans with (m := Zsucc n); - [ apply Zle_succ | assumption ]. + intros n m H; apply Zle_trans with (m := Zsucc n); + [ apply Zle_succ | assumption ]. Qed. Hint Resolve Zle_le_succ: zarith. @@ -582,31 +477,32 @@ Hint Resolve Zle_le_succ: zarith. Lemma Zgt_succ_pred : forall n m:Z, m > Zsucc n -> Zpred m > n. Proof. -unfold Zgt, Zsucc, Zpred in |- *; intros n p H; - rewrite <- (fun x y => Zcompare_plus_compat x y 1); - rewrite (Zplus_comm p); rewrite Zplus_assoc; - rewrite (fun x => Zplus_comm x n); simpl in |- *; - assumption. + unfold Zgt, Zsucc, Zpred in |- *; intros n p H; + rewrite <- (fun x y => Zcompare_plus_compat x y 1); + rewrite (Zplus_comm p); rewrite Zplus_assoc; + rewrite (fun x => Zplus_comm x n); simpl in |- *; + assumption. Qed. Lemma Zlt_succ_pred : forall n m:Z, Zsucc n < m -> n < Zpred m. Proof. -intros n p H; apply Zsucc_lt_reg; rewrite <- Zsucc_pred; assumption. + intros n p H; apply Zsucc_lt_reg; rewrite <- Zsucc_pred; assumption. Qed. (** Relating strict order and large order on positive *) Lemma Zlt_0_le_0_pred : forall n:Z, 0 < n -> 0 <= Zpred n. -intros x H. -rewrite (Zsucc_pred x) in H. -apply Zgt_succ_le. -apply Zlt_gt. -assumption. +Proof. + intros x H. + rewrite (Zsucc_pred x) in H. + apply Zgt_succ_le. + apply Zlt_gt. + assumption. Qed. - Lemma Zgt_0_le_0_pred : forall n:Z, n > 0 -> 0 <= Zpred n. -intros; apply Zlt_0_le_0_pred; apply Zgt_lt. assumption. +Proof. + intros; apply Zlt_0_le_0_pred; apply Zgt_lt. assumption. Qed. @@ -614,35 +510,39 @@ Qed. Lemma Zlt_0_1 : 0 < 1. Proof. -change (0 < Zsucc 0) in |- *. apply Zlt_succ. + change (0 < Zsucc 0) in |- *. apply Zlt_succ. Qed. Lemma Zle_0_1 : 0 <= 1. Proof. -change (0 <= Zsucc 0) in |- *. apply Zle_succ. + change (0 <= Zsucc 0) in |- *. apply Zle_succ. Qed. Lemma Zle_neg_pos : forall p q:positive, Zneg p <= Zpos q. Proof. -intros p; red in |- *; simpl in |- *; red in |- *; intros H; discriminate. + intros p; red in |- *; simpl in |- *; red in |- *; intros H; discriminate. Qed. Lemma Zgt_pos_0 : forall p:positive, Zpos p > 0. -unfold Zgt in |- *; trivial. +Proof. + unfold Zgt in |- *; trivial. Qed. - (* weaker but useful (in [Zpower] for instance) *) +(* weaker but useful (in [Zpower] for instance) *) Lemma Zle_0_pos : forall p:positive, 0 <= Zpos p. -intro; unfold Zle in |- *; discriminate. +Proof. + intro; unfold Zle in |- *; discriminate. Qed. Lemma Zlt_neg_0 : forall p:positive, Zneg p < 0. -unfold Zlt in |- *; trivial. +Proof. + unfold Zlt in |- *; trivial. Qed. Lemma Zle_0_nat : forall n:nat, 0 <= Z_of_nat n. -simple induction n; simpl in |- *; intros; - [ apply Zle_refl | unfold Zle in |- *; simpl in |- *; discriminate ]. +Proof. + simple induction n; simpl in |- *; intros; + [ apply Zle_refl | unfold Zle in |- *; simpl in |- *; discriminate ]. Qed. Hint Immediate Zeq_le: zarith. @@ -651,178 +551,294 @@ Hint Immediate Zeq_le: zarith. Lemma Zge_trans_succ : forall n m p:Z, Zsucc n > m -> m > p -> n > p. Proof. -intros n m p H1 H2; apply Zle_gt_trans with (m := m); - [ apply Zgt_succ_le; assumption | assumption ]. + intros n m p H1 H2; apply Zle_gt_trans with (m := m); + [ apply Zgt_succ_le; assumption | assumption ]. Qed. (** Derived lemma *) Lemma Zgt_succ_gt_or_eq : forall n m:Z, Zsucc n > m -> n > m \/ m = n. Proof. -intros n m H. -assert (Hle : m <= n). + intros n m H. + assert (Hle : m <= n). apply Zgt_succ_le; assumption. -destruct (Zle_lt_or_eq _ _ Hle) as [Hlt| Heq]. + destruct (Zle_lt_or_eq _ _ Hle) as [Hlt| Heq]. left; apply Zlt_gt; assumption. right; assumption. Qed. -(** Compatibility of multiplication by a positive wrt to order *) +(** ** Addition *) +(** Compatibility of addition wrt to order *) + +Lemma Zplus_gt_compat_l : forall n m p:Z, n > m -> p + n > p + m. +Proof. + unfold Zgt in |- *; intros n m p H; rewrite (Zcompare_plus_compat n m p); + assumption. +Qed. + +Lemma Zplus_gt_compat_r : forall n m p:Z, n > m -> n + p > m + p. +Proof. + intros n m p H; rewrite (Zplus_comm n p); rewrite (Zplus_comm m p); + apply Zplus_gt_compat_l; trivial. +Qed. + +Lemma Zplus_le_compat_l : forall n m p:Z, n <= m -> p + n <= p + m. +Proof. + intros n m p; unfold Zle, not in |- *; intros H1 H2; apply H1; + rewrite <- (Zcompare_plus_compat n m p); assumption. +Qed. + +Lemma Zplus_le_compat_r : forall n m p:Z, n <= m -> n + p <= m + p. +Proof. + intros a b c; do 2 rewrite (fun n:Z => Zplus_comm n c); + exact (Zplus_le_compat_l a b c). +Qed. + +Lemma Zplus_lt_compat_l : forall n m p:Z, n < m -> p + n < p + m. +Proof. + unfold Zlt in |- *; intros n m p; rewrite Zcompare_plus_compat; + trivial with arith. +Qed. +Lemma Zplus_lt_compat_r : forall n m p:Z, n < m -> n + p < m + p. +Proof. + intros n m p H; rewrite (Zplus_comm n p); rewrite (Zplus_comm m p); + apply Zplus_lt_compat_l; trivial. +Qed. + +Lemma Zplus_lt_le_compat : forall n m p q:Z, n < m -> p <= q -> n + p < m + q. +Proof. + intros a b c d H0 H1. + apply Zlt_le_trans with (b + c). + apply Zplus_lt_compat_r; trivial. + apply Zplus_le_compat_l; trivial. +Qed. + +Lemma Zplus_le_lt_compat : forall n m p q:Z, n <= m -> p < q -> n + p < m + q. +Proof. + intros a b c d H0 H1. + apply Zle_lt_trans with (b + c). + apply Zplus_le_compat_r; trivial. + apply Zplus_lt_compat_l; trivial. +Qed. + +Lemma Zplus_le_compat : forall n m p q:Z, n <= m -> p <= q -> n + p <= m + q. +Proof. + intros n m p q; intros H1 H2; apply Zle_trans with (m := n + q); + [ apply Zplus_le_compat_l; assumption + | apply Zplus_le_compat_r; assumption ]. +Qed. + + +Lemma Zplus_lt_compat : forall n m p q:Z, n < m -> p < q -> n + p < m + q. + intros; apply Zplus_le_lt_compat. apply Zlt_le_weak; assumption. assumption. +Qed. + + +(** Compatibility of addition wrt to being positive *) + +Lemma Zplus_le_0_compat : forall n m:Z, 0 <= n -> 0 <= m -> 0 <= n + m. +Proof. + intros x y H1 H2; rewrite <- (Zplus_0_l 0); apply Zplus_le_compat; assumption. +Qed. + +(** Simplification of addition wrt to order *) + +Lemma Zplus_gt_reg_l : forall n m p:Z, p + n > p + m -> n > m. +Proof. + unfold Zgt in |- *; intros n m p H; rewrite <- (Zcompare_plus_compat n m p); + assumption. +Qed. + +Lemma Zplus_gt_reg_r : forall n m p:Z, n + p > m + p -> n > m. +Proof. + intros n m p H; apply Zplus_gt_reg_l with p. + rewrite (Zplus_comm p n); rewrite (Zplus_comm p m); trivial. +Qed. + +Lemma Zplus_le_reg_l : forall n m p:Z, p + n <= p + m -> n <= m. +Proof. + intros n m p; unfold Zle, not in |- *; intros H1 H2; apply H1; + rewrite (Zcompare_plus_compat n m p); assumption. +Qed. + +Lemma Zplus_le_reg_r : forall n m p:Z, n + p <= m + p -> n <= m. +Proof. + intros n m p H; apply Zplus_le_reg_l with p. + rewrite (Zplus_comm p n); rewrite (Zplus_comm p m); trivial. +Qed. + +Lemma Zplus_lt_reg_l : forall n m p:Z, p + n < p + m -> n < m. +Proof. + unfold Zlt in |- *; intros n m p; rewrite Zcompare_plus_compat; + trivial with arith. +Qed. + +Lemma Zplus_lt_reg_r : forall n m p:Z, n + p < m + p -> n < m. +Proof. + intros n m p H; apply Zplus_lt_reg_l with p. + rewrite (Zplus_comm p n); rewrite (Zplus_comm p m); trivial. +Qed. + +(** ** Multiplication *) +(** Compatibility of multiplication by a positive wrt to order *) Lemma Zmult_le_compat_r : forall n m p:Z, n <= m -> 0 <= p -> n * p <= m * p. Proof. -intros a b c H H0; destruct c. + intros a b c H H0; destruct c. do 2 rewrite Zmult_0_r; assumption. rewrite (Zmult_comm a); rewrite (Zmult_comm b). - unfold Zle in |- *; rewrite Zcompare_mult_compat; assumption. + unfold Zle in |- *; rewrite Zcompare_mult_compat; assumption. unfold Zle in H0; contradiction H0; reflexivity. Qed. Lemma Zmult_le_compat_l : forall n m p:Z, n <= m -> 0 <= p -> p * n <= p * m. Proof. -intros a b c H1 H2; rewrite (Zmult_comm c a); rewrite (Zmult_comm c b). -apply Zmult_le_compat_r; trivial. + intros a b c H1 H2; rewrite (Zmult_comm c a); rewrite (Zmult_comm c b). + apply Zmult_le_compat_r; trivial. Qed. Lemma Zmult_lt_compat_r : forall n m p:Z, 0 < p -> n < m -> n * p < m * p. Proof. -intros x y z H H0; destruct z. + intros x y z H H0; destruct z. contradiction (Zlt_irrefl 0). rewrite (Zmult_comm x); rewrite (Zmult_comm y). - unfold Zlt in |- *; rewrite Zcompare_mult_compat; assumption. + unfold Zlt in |- *; rewrite Zcompare_mult_compat; assumption. discriminate H. Qed. Lemma Zmult_gt_compat_r : forall n m p:Z, p > 0 -> n > m -> n * p > m * p. Proof. -intros x y z; intros; apply Zlt_gt; apply Zmult_lt_compat_r; apply Zgt_lt; - assumption. + intros x y z; intros; apply Zlt_gt; apply Zmult_lt_compat_r; apply Zgt_lt; + assumption. Qed. Lemma Zmult_gt_0_lt_compat_r : - forall n m p:Z, p > 0 -> n < m -> n * p < m * p. + forall n m p:Z, p > 0 -> n < m -> n * p < m * p. Proof. -intros x y z; intros; apply Zmult_lt_compat_r; - [ apply Zgt_lt; assumption | assumption ]. + intros x y z; intros; apply Zmult_lt_compat_r; + [ apply Zgt_lt; assumption | assumption ]. Qed. Lemma Zmult_gt_0_le_compat_r : - forall n m p:Z, p > 0 -> n <= m -> n * p <= m * p. + forall n m p:Z, p > 0 -> n <= m -> n * p <= m * p. Proof. -intros x y z Hz Hxy. -elim (Zle_lt_or_eq x y Hxy). -intros; apply Zlt_le_weak. -apply Zmult_gt_0_lt_compat_r; trivial. -intros; apply Zeq_le. -rewrite H; trivial. + intros x y z Hz Hxy. + elim (Zle_lt_or_eq x y Hxy). + intros; apply Zlt_le_weak. + apply Zmult_gt_0_lt_compat_r; trivial. + intros; apply Zeq_le. + rewrite H; trivial. Qed. Lemma Zmult_lt_0_le_compat_r : - forall n m p:Z, 0 < p -> n <= m -> n * p <= m * p. + forall n m p:Z, 0 < p -> n <= m -> n * p <= m * p. Proof. -intros x y z; intros; apply Zmult_gt_0_le_compat_r; try apply Zlt_gt; - assumption. + intros x y z; intros; apply Zmult_gt_0_le_compat_r; try apply Zlt_gt; + assumption. Qed. Lemma Zmult_gt_0_lt_compat_l : - forall n m p:Z, p > 0 -> n < m -> p * n < p * m. + forall n m p:Z, p > 0 -> n < m -> p * n < p * m. Proof. -intros x y z; intros. -rewrite (Zmult_comm z x); rewrite (Zmult_comm z y); - apply Zmult_gt_0_lt_compat_r; assumption. + intros x y z; intros. + rewrite (Zmult_comm z x); rewrite (Zmult_comm z y); + apply Zmult_gt_0_lt_compat_r; assumption. Qed. Lemma Zmult_lt_compat_l : forall n m p:Z, 0 < p -> n < m -> p * n < p * m. Proof. -intros x y z; intros. -rewrite (Zmult_comm z x); rewrite (Zmult_comm z y); - apply Zmult_gt_0_lt_compat_r; try apply Zlt_gt; assumption. + intros x y z; intros. + rewrite (Zmult_comm z x); rewrite (Zmult_comm z y); + apply Zmult_gt_0_lt_compat_r; try apply Zlt_gt; assumption. Qed. Lemma Zmult_gt_compat_l : forall n m p:Z, p > 0 -> n > m -> p * n > p * m. Proof. -intros x y z; intros; rewrite (Zmult_comm z x); rewrite (Zmult_comm z y); - apply Zmult_gt_compat_r; assumption. + intros x y z; intros; rewrite (Zmult_comm z x); rewrite (Zmult_comm z y); + apply Zmult_gt_compat_r; assumption. Qed. Lemma Zmult_ge_compat_r : forall n m p:Z, n >= m -> p >= 0 -> n * p >= m * p. Proof. -intros a b c H1 H2; apply Zle_ge. -apply Zmult_le_compat_r; apply Zge_le; trivial. + intros a b c H1 H2; apply Zle_ge. + apply Zmult_le_compat_r; apply Zge_le; trivial. Qed. Lemma Zmult_ge_compat_l : forall n m p:Z, n >= m -> p >= 0 -> p * n >= p * m. Proof. -intros a b c H1 H2; apply Zle_ge. -apply Zmult_le_compat_l; apply Zge_le; trivial. + intros a b c H1 H2; apply Zle_ge. + apply Zmult_le_compat_l; apply Zge_le; trivial. Qed. Lemma Zmult_ge_compat : - forall n m p q:Z, n >= p -> m >= q -> p >= 0 -> q >= 0 -> n * m >= p * q. + forall n m p q:Z, n >= p -> m >= q -> p >= 0 -> q >= 0 -> n * m >= p * q. Proof. -intros a b c d H0 H1 H2 H3. -apply Zge_trans with (a * d). -apply Zmult_ge_compat_l; trivial. -apply Zge_trans with c; trivial. -apply Zmult_ge_compat_r; trivial. + intros a b c d H0 H1 H2 H3. + apply Zge_trans with (a * d). + apply Zmult_ge_compat_l; trivial. + apply Zge_trans with c; trivial. + apply Zmult_ge_compat_r; trivial. Qed. Lemma Zmult_le_compat : - forall n m p q:Z, n <= p -> m <= q -> 0 <= n -> 0 <= m -> n * m <= p * q. + forall n m p q:Z, n <= p -> m <= q -> 0 <= n -> 0 <= m -> n * m <= p * q. Proof. -intros a b c d H0 H1 H2 H3. -apply Zle_trans with (c * b). -apply Zmult_le_compat_r; assumption. -apply Zmult_le_compat_l. -assumption. -apply Zle_trans with a; assumption. + intros a b c d H0 H1 H2 H3. + apply Zle_trans with (c * b). + apply Zmult_le_compat_r; assumption. + apply Zmult_le_compat_l. + assumption. + apply Zle_trans with a; assumption. Qed. (** Simplification of multiplication by a positive wrt to being positive *) Lemma Zmult_gt_0_lt_reg_r : forall n m p:Z, p > 0 -> n * p < m * p -> n < m. Proof. -intros x y z; intros; destruct z. + intros x y z; intros; destruct z. contradiction (Zgt_irrefl 0). rewrite (Zmult_comm x) in H0; rewrite (Zmult_comm y) in H0. - unfold Zlt in H0; rewrite Zcompare_mult_compat in H0; assumption. + unfold Zlt in H0; rewrite Zcompare_mult_compat in H0; assumption. discriminate H. Qed. Lemma Zmult_lt_reg_r : forall n m p:Z, 0 < p -> n * p < m * p -> n < m. Proof. -intros a b c H0 H1. -apply Zmult_gt_0_lt_reg_r with c; try apply Zlt_gt; assumption. + intros a b c H0 H1. + apply Zmult_gt_0_lt_reg_r with c; try apply Zlt_gt; assumption. Qed. Lemma Zmult_le_reg_r : forall n m p:Z, p > 0 -> n * p <= m * p -> n <= m. Proof. -intros x y z Hz Hxy. -elim (Zle_lt_or_eq (x * z) (y * z) Hxy). -intros; apply Zlt_le_weak. -apply Zmult_gt_0_lt_reg_r with z; trivial. -intros; apply Zeq_le. -apply Zmult_reg_r with z. + intros x y z Hz Hxy. + elim (Zle_lt_or_eq (x * z) (y * z) Hxy). + intros; apply Zlt_le_weak. + apply Zmult_gt_0_lt_reg_r with z; trivial. + intros; apply Zeq_le. + apply Zmult_reg_r with z. intro. rewrite H0 in Hz. contradiction (Zgt_irrefl 0). -assumption. + assumption. Qed. Lemma Zmult_lt_0_le_reg_r : forall n m p:Z, 0 < p -> n * p <= m * p -> n <= m. -intros x y z; intros; apply Zmult_le_reg_r with z. -try apply Zlt_gt; assumption. -assumption. +Proof. + intros x y z; intros; apply Zmult_le_reg_r with z. + try apply Zlt_gt; assumption. + assumption. Qed. Lemma Zmult_ge_reg_r : forall n m p:Z, p > 0 -> n * p >= m * p -> n >= m. -intros a b c H1 H2; apply Zle_ge; apply Zmult_le_reg_r with c; trivial. -apply Zge_le; trivial. +Proof. + intros a b c H1 H2; apply Zle_ge; apply Zmult_le_reg_r with c; trivial. + apply Zge_le; trivial. Qed. Lemma Zmult_gt_reg_r : forall n m p:Z, p > 0 -> n * p > m * p -> n > m. -intros a b c H1 H2; apply Zlt_gt; apply Zmult_gt_0_lt_reg_r with c; trivial. -apply Zgt_lt; trivial. +Proof. + intros a b c H1 H2; apply Zlt_gt; apply Zmult_gt_0_lt_reg_r with c; trivial. + apply Zgt_lt; trivial. Qed. @@ -830,154 +846,156 @@ Qed. Lemma Zmult_le_0_compat : forall n m:Z, 0 <= n -> 0 <= m -> 0 <= n * m. Proof. -intros x y; case x. -intros; rewrite Zmult_0_l; trivial. -intros p H1; unfold Zle in |- *. + intros x y; case x. + intros; rewrite Zmult_0_l; trivial. + intros p H1; unfold Zle in |- *. pattern 0 at 2 in |- *; rewrite <- (Zmult_0_r (Zpos p)). rewrite Zcompare_mult_compat; trivial. -intros p H1 H2; absurd (0 > Zneg p); trivial. -unfold Zgt in |- *; simpl in |- *; auto with zarith. + intros p H1 H2; absurd (0 > Zneg p); trivial. + unfold Zgt in |- *; simpl in |- *; auto with zarith. Qed. Lemma Zmult_gt_0_compat : forall n m:Z, n > 0 -> m > 0 -> n * m > 0. Proof. -intros x y; case x. -intros H; discriminate H. -intros p H1; unfold Zgt in |- *; pattern 0 at 2 in |- *; - rewrite <- (Zmult_0_r (Zpos p)). + intros x y; case x. + intros H; discriminate H. + intros p H1; unfold Zgt in |- *; pattern 0 at 2 in |- *; + rewrite <- (Zmult_0_r (Zpos p)). rewrite Zcompare_mult_compat; trivial. -intros p H; discriminate H. + intros p H; discriminate H. Qed. Lemma Zmult_lt_0_compat : forall n m:Z, 0 < n -> 0 < m -> 0 < n * m. -intros a b apos bpos. -apply Zgt_lt. -apply Zmult_gt_0_compat; try apply Zlt_gt; assumption. +Proof. + intros a b apos bpos. + apply Zgt_lt. + apply Zmult_gt_0_compat; try apply Zlt_gt; assumption. Qed. -(* For compatibility *) +(** For compatibility *) Notation Zmult_lt_O_compat := Zmult_lt_0_compat (only parsing). Lemma Zmult_gt_0_le_0_compat : forall n m:Z, n > 0 -> 0 <= m -> 0 <= m * n. Proof. -intros x y H1 H2; apply Zmult_le_0_compat; trivial. -apply Zlt_le_weak; apply Zgt_lt; trivial. + intros x y H1 H2; apply Zmult_le_0_compat; trivial. + apply Zlt_le_weak; apply Zgt_lt; trivial. Qed. (** Simplification of multiplication by a positive wrt to being positive *) Lemma Zmult_le_0_reg_r : forall n m:Z, n > 0 -> 0 <= m * n -> 0 <= m. Proof. -intros x y; case x; - [ simpl in |- *; unfold Zgt in |- *; simpl in |- *; intros H; discriminate H - | intros p H1; unfold Zle in |- *; rewrite Zmult_comm; - pattern 0 at 1 in |- *; rewrite <- (Zmult_0_r (Zpos p)); - rewrite Zcompare_mult_compat; auto with arith - | intros p; unfold Zgt in |- *; simpl in |- *; intros H; discriminate H ]. + intros x y; case x; + [ simpl in |- *; unfold Zgt in |- *; simpl in |- *; intros H; discriminate H + | intros p H1; unfold Zle in |- *; rewrite Zmult_comm; + pattern 0 at 1 in |- *; rewrite <- (Zmult_0_r (Zpos p)); + rewrite Zcompare_mult_compat; auto with arith + | intros p; unfold Zgt in |- *; simpl in |- *; intros H; discriminate H ]. Qed. Lemma Zmult_gt_0_lt_0_reg_r : forall n m:Z, n > 0 -> 0 < m * n -> 0 < m. Proof. -intros x y; case x; - [ simpl in |- *; unfold Zgt in |- *; simpl in |- *; intros H; discriminate H - | intros p H1; unfold Zlt in |- *; rewrite Zmult_comm; - pattern 0 at 1 in |- *; rewrite <- (Zmult_0_r (Zpos p)); - rewrite Zcompare_mult_compat; auto with arith - | intros p; unfold Zgt in |- *; simpl in |- *; intros H; discriminate H ]. + intros x y; case x; + [ simpl in |- *; unfold Zgt in |- *; simpl in |- *; intros H; discriminate H + | intros p H1; unfold Zlt in |- *; rewrite Zmult_comm; + pattern 0 at 1 in |- *; rewrite <- (Zmult_0_r (Zpos p)); + rewrite Zcompare_mult_compat; auto with arith + | intros p; unfold Zgt in |- *; simpl in |- *; intros H; discriminate H ]. Qed. Lemma Zmult_lt_0_reg_r : forall n m:Z, 0 < n -> 0 < m * n -> 0 < m. Proof. -intros x y; intros; eapply Zmult_gt_0_lt_0_reg_r with x; try apply Zlt_gt; - assumption. + intros x y; intros; eapply Zmult_gt_0_lt_0_reg_r with x; try apply Zlt_gt; + assumption. Qed. Lemma Zmult_gt_0_reg_l : forall n m:Z, n > 0 -> n * m > 0 -> m > 0. Proof. -intros x y; case x. - intros H; discriminate H. - intros p H1; unfold Zgt in |- *. - pattern 0 at 1 in |- *; rewrite <- (Zmult_0_r (Zpos p)). - rewrite Zcompare_mult_compat; trivial. -intros p H; discriminate H. + intros x y; case x. + intros H; discriminate H. + intros p H1; unfold Zgt in |- *. + pattern 0 at 1 in |- *; rewrite <- (Zmult_0_r (Zpos p)). + rewrite Zcompare_mult_compat; trivial. + intros p H; discriminate H. Qed. +(** ** Square *) (** Simplification of square wrt order *) Lemma Zgt_square_simpl : - forall n m:Z, n >= 0 -> n * n > m * m -> n > m. + forall n m:Z, n >= 0 -> n * n > m * m -> n > m. Proof. -intros n m H0 H1. -case (dec_Zlt m n). -intro; apply Zlt_gt; trivial. -intros H2; cut (m >= n). -intros H. -elim Zgt_not_le with (1 := H1). -apply Zge_le. -apply Zmult_ge_compat; auto. -apply Znot_lt_ge; trivial. + intros n m H0 H1. + case (dec_Zlt m n). + intro; apply Zlt_gt; trivial. + intros H2; cut (m >= n). + intros H. + elim Zgt_not_le with (1 := H1). + apply Zge_le. + apply Zmult_ge_compat; auto. + apply Znot_lt_ge; trivial. Qed. Lemma Zlt_square_simpl : - forall n m:Z, 0 <= n -> m * m < n * n -> m < n. + forall n m:Z, 0 <= n -> m * m < n * n -> m < n. Proof. -intros x y H0 H1. -apply Zgt_lt. -apply Zgt_square_simpl; try apply Zle_ge; try apply Zlt_gt; assumption. + intros x y H0 H1. + apply Zgt_lt. + apply Zgt_square_simpl; try apply Zle_ge; try apply Zlt_gt; assumption. Qed. -(** Equivalence between inequalities *) +(** * Equivalence between inequalities *) Lemma Zle_plus_swap : forall n m p:Z, n + p <= m <-> n <= m - p. Proof. - intros x y z; intros. split. intro. rewrite <- (Zplus_0_r x). rewrite <- (Zplus_opp_r z). - rewrite Zplus_assoc. exact (Zplus_le_compat_r _ _ _ H). - intro. rewrite <- (Zplus_0_r y). rewrite <- (Zplus_opp_l z). rewrite Zplus_assoc. - apply Zplus_le_compat_r. assumption. + intros x y z; intros. split. intro. rewrite <- (Zplus_0_r x). rewrite <- (Zplus_opp_r z). + rewrite Zplus_assoc. exact (Zplus_le_compat_r _ _ _ H). + intro. rewrite <- (Zplus_0_r y). rewrite <- (Zplus_opp_l z). rewrite Zplus_assoc. + apply Zplus_le_compat_r. assumption. Qed. Lemma Zlt_plus_swap : forall n m p:Z, n + p < m <-> n < m - p. Proof. - intros x y z; intros. split. intro. unfold Zminus in |- *. rewrite Zplus_comm. rewrite <- (Zplus_0_l x). - rewrite <- (Zplus_opp_l z). rewrite Zplus_assoc_reverse. apply Zplus_lt_compat_l. rewrite Zplus_comm. - assumption. - intro. rewrite Zplus_comm. rewrite <- (Zplus_0_l y). rewrite <- (Zplus_opp_r z). - rewrite Zplus_assoc_reverse. apply Zplus_lt_compat_l. rewrite Zplus_comm. assumption. + intros x y z; intros. split. intro. unfold Zminus in |- *. rewrite Zplus_comm. rewrite <- (Zplus_0_l x). + rewrite <- (Zplus_opp_l z). rewrite Zplus_assoc_reverse. apply Zplus_lt_compat_l. rewrite Zplus_comm. + assumption. + intro. rewrite Zplus_comm. rewrite <- (Zplus_0_l y). rewrite <- (Zplus_opp_r z). + rewrite Zplus_assoc_reverse. apply Zplus_lt_compat_l. rewrite Zplus_comm. assumption. Qed. Lemma Zeq_plus_swap : forall n m p:Z, n + p = m <-> n = m - p. Proof. -intros x y z; intros. split. intro. apply Zplus_minus_eq. symmetry in |- *. rewrite Zplus_comm. + intros x y z; intros. split. intro. apply Zplus_minus_eq. symmetry in |- *. rewrite Zplus_comm. assumption. -intro. rewrite H. unfold Zminus in |- *. rewrite Zplus_assoc_reverse. + intro. rewrite H. unfold Zminus in |- *. rewrite Zplus_assoc_reverse. rewrite Zplus_opp_l. apply Zplus_0_r. Qed. Lemma Zlt_minus_simpl_swap : forall n m:Z, 0 < m -> n - m < n. Proof. -intros n m H; apply Zplus_lt_reg_l with (p := m); rewrite Zplus_minus; - pattern n at 1 in |- *; rewrite <- (Zplus_0_r n); - rewrite (Zplus_comm m n); apply Zplus_lt_compat_l; - assumption. + intros n m H; apply Zplus_lt_reg_l with (p := m); rewrite Zplus_minus; + pattern n at 1 in |- *; rewrite <- (Zplus_0_r n); + rewrite (Zplus_comm m n); apply Zplus_lt_compat_l; + assumption. Qed. Lemma Zlt_0_minus_lt : forall n m:Z, 0 < n - m -> m < n. Proof. -intros n m H; apply Zplus_lt_reg_l with (p := - m); rewrite Zplus_opp_l; - rewrite Zplus_comm; exact H. + intros n m H; apply Zplus_lt_reg_l with (p := - m); rewrite Zplus_opp_l; + rewrite Zplus_comm; exact H. Qed. Lemma Zle_0_minus_le : forall n m:Z, 0 <= n - m -> m <= n. Proof. -intros n m H; apply Zplus_le_reg_l with (p := - m); rewrite Zplus_opp_l; - rewrite Zplus_comm; exact H. + intros n m H; apply Zplus_le_reg_l with (p := - m); rewrite Zplus_opp_l; + rewrite Zplus_comm; exact H. Qed. Lemma Zle_minus_le_0 : forall n m:Z, m <= n -> 0 <= n - m. Proof. -intros n m H; unfold Zminus; apply Zplus_le_reg_r with (p := m); -rewrite <- Zplus_assoc; rewrite Zplus_opp_l; rewrite Zplus_0_r; exact H. + intros n m H; unfold Zminus; apply Zplus_le_reg_r with (p := m); + rewrite <- Zplus_assoc; rewrite Zplus_opp_l; rewrite Zplus_0_r; exact H. Qed. -(* For compatibility *) +(** For compatibility *) Notation Zlt_O_minus_lt := Zlt_0_minus_lt (only parsing). diff --git a/theories/ZArith/Zpower.v b/theories/ZArith/Zpower.v index 70a2bd45..446f663c 100644 --- a/theories/ZArith/Zpower.v +++ b/theories/ZArith/Zpower.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: Zpower.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: Zpower.v 9245 2006-10-17 12:53:34Z notin $ i*) Require Import ZArith_base. Require Import Omega. @@ -15,81 +15,84 @@ Open Local Scope Z_scope. Section section1. +(** * Definition of powers over [Z]*) + (** [Zpower_nat z n] is the n-th power of [z] when [n] is an unary integer (type [nat]) and [z] a signed integer (type [Z]) *) -Definition Zpower_nat (z:Z) (n:nat) := iter_nat n Z (fun x:Z => z * x) 1. - -(** [Zpower_nat_is_exp] says [Zpower_nat] is a morphism for - [plus : nat->nat] and [Zmult : Z->Z] *) - -Lemma Zpower_nat_is_exp : - forall (n m:nat) (z:Z), - Zpower_nat z (n + m) = Zpower_nat z n * Zpower_nat z m. - -intros; elim n; - [ simpl in |- *; elim (Zpower_nat z m); auto with zarith - | unfold Zpower_nat in |- *; intros; simpl in |- *; rewrite H; - apply Zmult_assoc ]. -Qed. - -(** [Zpower_pos z n] is the n-th power of [z] when [n] is an binary - integer (type [positive]) and [z] a signed integer (type [Z]) *) - -Definition Zpower_pos (z:Z) (n:positive) := iter_pos n Z (fun x:Z => z * x) 1. - -(** This theorem shows that powers of unary and binary integers - are the same thing, modulo the function convert : [positive -> nat] *) - -Theorem Zpower_pos_nat : - forall (z:Z) (p:positive), Zpower_pos z p = Zpower_nat z (nat_of_P p). - -intros; unfold Zpower_pos in |- *; unfold Zpower_nat in |- *; - apply iter_nat_of_P. -Qed. - -(** Using the theorem [Zpower_pos_nat] and the lemma [Zpower_nat_is_exp] we - deduce that the function [[n:positive](Zpower_pos z n)] is a morphism - for [add : positive->positive] and [Zmult : Z->Z] *) - -Theorem Zpower_pos_is_exp : - forall (n m:positive) (z:Z), - Zpower_pos z (n + m) = Zpower_pos z n * Zpower_pos z m. - -intros. -rewrite (Zpower_pos_nat z n). -rewrite (Zpower_pos_nat z m). -rewrite (Zpower_pos_nat z (n + m)). -rewrite (nat_of_P_plus_morphism n m). -apply Zpower_nat_is_exp. -Qed. - -Definition Zpower (x y:Z) := - match y with - | Zpos p => Zpower_pos x p - | Z0 => 1 - | Zneg p => 0 - end. - -Infix "^" := Zpower : Z_scope. - -Hint Immediate Zpower_nat_is_exp: zarith. -Hint Immediate Zpower_pos_is_exp: zarith. -Hint Unfold Zpower_pos: zarith. -Hint Unfold Zpower_nat: zarith. - -Lemma Zpower_exp : - forall x n m:Z, n >= 0 -> m >= 0 -> x ^ (n + m) = x ^ n * x ^ m. -destruct n; destruct m; auto with zarith. -simpl in |- *; intros; apply Zred_factor0. -simpl in |- *; auto with zarith. -intros; compute in H0; absurd (Datatypes.Lt = Datatypes.Lt); auto with zarith. -intros; compute in H0; absurd (Datatypes.Lt = Datatypes.Lt); auto with zarith. -Qed. + Definition Zpower_nat (z:Z) (n:nat) := iter_nat n Z (fun x:Z => z * x) 1. + + (** [Zpower_nat_is_exp] says [Zpower_nat] is a morphism for + [plus : nat->nat] and [Zmult : Z->Z] *) + + Lemma Zpower_nat_is_exp : + forall (n m:nat) (z:Z), + Zpower_nat z (n + m) = Zpower_nat z n * Zpower_nat z m. + Proof. + intros; elim n; + [ simpl in |- *; elim (Zpower_nat z m); auto with zarith + | unfold Zpower_nat in |- *; intros; simpl in |- *; rewrite H; + apply Zmult_assoc ]. + Qed. + + (** [Zpower_pos z n] is the n-th power of [z] when [n] is an binary + integer (type [positive]) and [z] a signed integer (type [Z]) *) + + Definition Zpower_pos (z:Z) (n:positive) := iter_pos n Z (fun x:Z => z * x) 1. + + (** This theorem shows that powers of unary and binary integers + are the same thing, modulo the function convert : [positive -> nat] *) + + Theorem Zpower_pos_nat : + forall (z:Z) (p:positive), Zpower_pos z p = Zpower_nat z (nat_of_P p). + Proof. + intros; unfold Zpower_pos in |- *; unfold Zpower_nat in |- *; + apply iter_nat_of_P. + Qed. + + (** Using the theorem [Zpower_pos_nat] and the lemma [Zpower_nat_is_exp] we + deduce that the function [[n:positive](Zpower_pos z n)] is a morphism + for [add : positive->positive] and [Zmult : Z->Z] *) + + Theorem Zpower_pos_is_exp : + forall (n m:positive) (z:Z), + Zpower_pos z (n + m) = Zpower_pos z n * Zpower_pos z m. + Proof. + intros. + rewrite (Zpower_pos_nat z n). + rewrite (Zpower_pos_nat z m). + rewrite (Zpower_pos_nat z (n + m)). + rewrite (nat_of_P_plus_morphism n m). + apply Zpower_nat_is_exp. + Qed. + + Definition Zpower (x y:Z) := + match y with + | Zpos p => Zpower_pos x p + | Z0 => 1 + | Zneg p => 0 + end. + + Infix "^" := Zpower : Z_scope. + + Hint Immediate Zpower_nat_is_exp: zarith. + Hint Immediate Zpower_pos_is_exp: zarith. + Hint Unfold Zpower_pos: zarith. + Hint Unfold Zpower_nat: zarith. + + Lemma Zpower_exp : + forall x n m:Z, n >= 0 -> m >= 0 -> x ^ (n + m) = x ^ n * x ^ m. + Proof. + destruct n; destruct m; auto with zarith. + simpl in |- *; intros; apply Zred_factor0. + simpl in |- *; auto with zarith. + intros; compute in H0; absurd (Datatypes.Lt = Datatypes.Lt); auto with zarith. + intros; compute in H0; absurd (Datatypes.Lt = Datatypes.Lt); auto with zarith. + Qed. End section1. -(* Exporting notation "^" *) +(** Exporting notation "^" *) Infix "^" := Zpower : Z_scope. @@ -100,273 +103,283 @@ Hint Unfold Zpower_nat: zarith. Section Powers_of_2. -(** For the powers of two, that will be widely used, a more direct - calculus is possible. We will also prove some properties such - as [(x:positive) x < 2^x] that are true for all integers bigger - than 2 but more difficult to prove and useless. *) - -(** [shift n m] computes [2^n * m], or [m] shifted by [n] positions *) - -Definition shift_nat (n:nat) (z:positive) := iter_nat n positive xO z. -Definition shift_pos (n z:positive) := iter_pos n positive xO z. -Definition shift (n:Z) (z:positive) := - match n with - | Z0 => z - | Zpos p => iter_pos p positive xO z - | Zneg p => z - end. - -Definition two_power_nat (n:nat) := Zpos (shift_nat n 1). -Definition two_power_pos (x:positive) := Zpos (shift_pos x 1). - -Lemma two_power_nat_S : - forall n:nat, two_power_nat (S n) = 2 * two_power_nat n. -intro; simpl in |- *; apply refl_equal. -Qed. - -Lemma shift_nat_plus : - forall (n m:nat) (x:positive), - shift_nat (n + m) x = shift_nat n (shift_nat m x). - -intros; unfold shift_nat in |- *; apply iter_nat_plus. -Qed. - -Theorem shift_nat_correct : - forall (n:nat) (x:positive), Zpos (shift_nat n x) = Zpower_nat 2 n * Zpos x. - -unfold shift_nat in |- *; simple induction n; - [ simpl in |- *; trivial with zarith - | intros; replace (Zpower_nat 2 (S n0)) with (2 * Zpower_nat 2 n0); - [ rewrite <- Zmult_assoc; rewrite <- (H x); simpl in |- *; reflexivity - | auto with zarith ] ]. -Qed. - -Theorem two_power_nat_correct : - forall n:nat, two_power_nat n = Zpower_nat 2 n. - -intro n. -unfold two_power_nat in |- *. -rewrite (shift_nat_correct n). -omega. -Qed. + (** * Powers of 2 *) + + (** For the powers of two, that will be widely used, a more direct + calculus is possible. We will also prove some properties such + as [(x:positive) x < 2^x] that are true for all integers bigger + than 2 but more difficult to prove and useless. *) + + (** [shift n m] computes [2^n * m], or [m] shifted by [n] positions *) + + Definition shift_nat (n:nat) (z:positive) := iter_nat n positive xO z. + Definition shift_pos (n z:positive) := iter_pos n positive xO z. + Definition shift (n:Z) (z:positive) := + match n with + | Z0 => z + | Zpos p => iter_pos p positive xO z + | Zneg p => z + end. + + Definition two_power_nat (n:nat) := Zpos (shift_nat n 1). + Definition two_power_pos (x:positive) := Zpos (shift_pos x 1). + + Lemma two_power_nat_S : + forall n:nat, two_power_nat (S n) = 2 * two_power_nat n. + Proof. + intro; simpl in |- *; apply refl_equal. + Qed. + + Lemma shift_nat_plus : + forall (n m:nat) (x:positive), + shift_nat (n + m) x = shift_nat n (shift_nat m x). + Proof. + intros; unfold shift_nat in |- *; apply iter_nat_plus. + Qed. + + Theorem shift_nat_correct : + forall (n:nat) (x:positive), Zpos (shift_nat n x) = Zpower_nat 2 n * Zpos x. + Proof. + unfold shift_nat in |- *; simple induction n; + [ simpl in |- *; trivial with zarith + | intros; replace (Zpower_nat 2 (S n0)) with (2 * Zpower_nat 2 n0); + [ rewrite <- Zmult_assoc; rewrite <- (H x); simpl in |- *; reflexivity + | auto with zarith ] ]. + Qed. + + Theorem two_power_nat_correct : + forall n:nat, two_power_nat n = Zpower_nat 2 n. + Proof. + intro n. + unfold two_power_nat in |- *. + rewrite (shift_nat_correct n). + omega. + Qed. + + (** Second we show that [two_power_pos] and [two_power_nat] are the same *) + Lemma shift_pos_nat : + forall p x:positive, shift_pos p x = shift_nat (nat_of_P p) x. + Proof. + unfold shift_pos in |- *. + unfold shift_nat in |- *. + intros; apply iter_nat_of_P. + Qed. + + Lemma two_power_pos_nat : + forall p:positive, two_power_pos p = two_power_nat (nat_of_P p). + Proof. + intro; unfold two_power_pos in |- *; unfold two_power_nat in |- *. + apply f_equal with (f := Zpos). + apply shift_pos_nat. + Qed. + + (** Then we deduce that [two_power_pos] is also correct *) + + Theorem shift_pos_correct : + forall p x:positive, Zpos (shift_pos p x) = Zpower_pos 2 p * Zpos x. + Proof. + intros. + rewrite (shift_pos_nat p x). + rewrite (Zpower_pos_nat 2 p). + apply shift_nat_correct. + Qed. + + Theorem two_power_pos_correct : + forall x:positive, two_power_pos x = Zpower_pos 2 x. + Proof. + intro. + rewrite two_power_pos_nat. + rewrite Zpower_pos_nat. + apply two_power_nat_correct. + Qed. + + (** Some consequences *) + + Theorem two_power_pos_is_exp : + forall x y:positive, + two_power_pos (x + y) = two_power_pos x * two_power_pos y. + Proof. + intros. + rewrite (two_power_pos_correct (x + y)). + rewrite (two_power_pos_correct x). + rewrite (two_power_pos_correct y). + apply Zpower_pos_is_exp. + Qed. + + (** The exponentiation [z -> 2^z] for [z] a signed integer. + For convenience, we assume that [2^z = 0] for all [z < 0] + We could also define a inductive type [Log_result] with + 3 contructors [ Zero | Pos positive -> | minus_infty] + but it's more complexe and not so useful. *) -(** Second we show that [two_power_pos] and [two_power_nat] are the same *) -Lemma shift_pos_nat : - forall p x:positive, shift_pos p x = shift_nat (nat_of_P p) x. - -unfold shift_pos in |- *. -unfold shift_nat in |- *. -intros; apply iter_nat_of_P. -Qed. - -Lemma two_power_pos_nat : - forall p:positive, two_power_pos p = two_power_nat (nat_of_P p). - -intro; unfold two_power_pos in |- *; unfold two_power_nat in |- *. -apply f_equal with (f := Zpos). -apply shift_pos_nat. -Qed. - -(** Then we deduce that [two_power_pos] is also correct *) - -Theorem shift_pos_correct : - forall p x:positive, Zpos (shift_pos p x) = Zpower_pos 2 p * Zpos x. - -intros. -rewrite (shift_pos_nat p x). -rewrite (Zpower_pos_nat 2 p). -apply shift_nat_correct. -Qed. - -Theorem two_power_pos_correct : - forall x:positive, two_power_pos x = Zpower_pos 2 x. - -intro. -rewrite two_power_pos_nat. -rewrite Zpower_pos_nat. -apply two_power_nat_correct. -Qed. - -(** Some consequences *) - -Theorem two_power_pos_is_exp : - forall x y:positive, - two_power_pos (x + y) = two_power_pos x * two_power_pos y. -intros. -rewrite (two_power_pos_correct (x + y)). -rewrite (two_power_pos_correct x). -rewrite (two_power_pos_correct y). -apply Zpower_pos_is_exp. -Qed. - -(** The exponentiation [z -> 2^z] for [z] a signed integer. - For convenience, we assume that [2^z = 0] for all [z < 0] - We could also define a inductive type [Log_result] with - 3 contructors [ Zero | Pos positive -> | minus_infty] - but it's more complexe and not so useful. *) - -Definition two_p (x:Z) := - match x with - | Z0 => 1 - | Zpos y => two_power_pos y - | Zneg y => 0 - end. - -Theorem two_p_is_exp : - forall x y:Z, 0 <= x -> 0 <= y -> two_p (x + y) = two_p x * two_p y. -simple induction x; - [ simple induction y; simpl in |- *; auto with zarith - | simple induction y; - [ unfold two_p in |- *; rewrite (Zmult_comm (two_power_pos p) 1); - rewrite (Zmult_1_l (two_power_pos p)); auto with zarith - | unfold Zplus in |- *; unfold two_p in |- *; intros; - apply two_power_pos_is_exp - | intros; unfold Zle in H0; unfold Zcompare in H0; - absurd (Datatypes.Gt = Datatypes.Gt); trivial with zarith ] - | simple induction y; - [ simpl in |- *; auto with zarith - | intros; unfold Zle in H; unfold Zcompare in H; - absurd (Datatypes.Gt = Datatypes.Gt); trivial with zarith - | intros; unfold Zle in H; unfold Zcompare in H; - absurd (Datatypes.Gt = Datatypes.Gt); trivial with zarith ] ]. -Qed. - -Lemma two_p_gt_ZERO : forall x:Z, 0 <= x -> two_p x > 0. -simple induction x; intros; - [ simpl in |- *; omega - | simpl in |- *; unfold two_power_pos in |- *; apply Zorder.Zgt_pos_0 - | absurd (0 <= Zneg p); - [ simpl in |- *; unfold Zle in |- *; unfold Zcompare in |- *; - do 2 unfold not in |- *; auto with zarith - | assumption ] ]. -Qed. - -Lemma two_p_S : forall x:Z, 0 <= x -> two_p (Zsucc x) = 2 * two_p x. -intros; unfold Zsucc in |- *. -rewrite (two_p_is_exp x 1 H (Zorder.Zle_0_pos 1)). -apply Zmult_comm. -Qed. - -Lemma two_p_pred : forall x:Z, 0 <= x -> two_p (Zpred x) < two_p x. -intros; apply natlike_ind with (P := fun x:Z => two_p (Zpred x) < two_p x); - [ simpl in |- *; unfold Zlt in |- *; auto with zarith - | intros; elim (Zle_lt_or_eq 0 x0 H0); - [ intros; - replace (two_p (Zpred (Zsucc x0))) with (two_p (Zsucc (Zpred x0))); - [ rewrite (two_p_S (Zpred x0)); - [ rewrite (two_p_S x0); [ omega | assumption ] - | apply Zorder.Zlt_0_le_0_pred; assumption ] - | rewrite <- (Zsucc_pred x0); rewrite <- (Zpred_succ x0); - trivial with zarith ] - | intro Hx0; rewrite <- Hx0; simpl in |- *; unfold Zlt in |- *; - auto with zarith ] - | assumption ]. -Qed. - -Lemma Zlt_lt_double : forall x y:Z, 0 <= x < y -> x < 2 * y. -intros; omega. Qed. - -End Powers_of_2. + Definition two_p (x:Z) := + match x with + | Z0 => 1 + | Zpos y => two_power_pos y + | Zneg y => 0 + end. + + Theorem two_p_is_exp : + forall x y:Z, 0 <= x -> 0 <= y -> two_p (x + y) = two_p x * two_p y. + Proof. + simple induction x; + [ simple induction y; simpl in |- *; auto with zarith + | simple induction y; + [ unfold two_p in |- *; rewrite (Zmult_comm (two_power_pos p) 1); + rewrite (Zmult_1_l (two_power_pos p)); auto with zarith + | unfold Zplus in |- *; unfold two_p in |- *; intros; + apply two_power_pos_is_exp + | intros; unfold Zle in H0; unfold Zcompare in H0; + absurd (Datatypes.Gt = Datatypes.Gt); trivial with zarith ] + | simple induction y; + [ simpl in |- *; auto with zarith + | intros; unfold Zle in H; unfold Zcompare in H; + absurd (Datatypes.Gt = Datatypes.Gt); trivial with zarith + | intros; unfold Zle in H; unfold Zcompare in H; + absurd (Datatypes.Gt = Datatypes.Gt); trivial with zarith ] ]. + Qed. + + Lemma two_p_gt_ZERO : forall x:Z, 0 <= x -> two_p x > 0. + Proof. + simple induction x; intros; + [ simpl in |- *; omega + | simpl in |- *; unfold two_power_pos in |- *; apply Zorder.Zgt_pos_0 + | absurd (0 <= Zneg p); + [ simpl in |- *; unfold Zle in |- *; unfold Zcompare in |- *; + do 2 unfold not in |- *; auto with zarith + | assumption ] ]. + Qed. + + Lemma two_p_S : forall x:Z, 0 <= x -> two_p (Zsucc x) = 2 * two_p x. + Proof. + intros; unfold Zsucc in |- *. + rewrite (two_p_is_exp x 1 H (Zorder.Zle_0_pos 1)). + apply Zmult_comm. + Qed. + + Lemma two_p_pred : forall x:Z, 0 <= x -> two_p (Zpred x) < two_p x. + Proof. + intros; apply natlike_ind with (P := fun x:Z => two_p (Zpred x) < two_p x); + [ simpl in |- *; unfold Zlt in |- *; auto with zarith + | intros; elim (Zle_lt_or_eq 0 x0 H0); + [ intros; + replace (two_p (Zpred (Zsucc x0))) with (two_p (Zsucc (Zpred x0))); + [ rewrite (two_p_S (Zpred x0)); + [ rewrite (two_p_S x0); [ omega | assumption ] + | apply Zorder.Zlt_0_le_0_pred; assumption ] + | rewrite <- (Zsucc_pred x0); rewrite <- (Zpred_succ x0); + trivial with zarith ] + | intro Hx0; rewrite <- Hx0; simpl in |- *; unfold Zlt in |- *; + auto with zarith ] + | assumption ]. + Qed. + + Lemma Zlt_lt_double : forall x y:Z, 0 <= x < y -> x < 2 * y. + intros; omega. Qed. + + End Powers_of_2. Hint Resolve two_p_gt_ZERO: zarith. Hint Immediate two_p_pred two_p_S: zarith. Section power_div_with_rest. -(** Division by a power of two. - To [n:Z] and [p:positive], [q],[r] are associated such that - [n = 2^p.q + r] and [0 <= r < 2^p] *) - -(** Invariant: [d*q + r = d'*q + r /\ d' = 2*d /\ 0<= r < d /\ 0 <= r' < d'] *) -Definition Zdiv_rest_aux (qrd:Z * Z * Z) := - let (qr, d) := qrd in - let (q, r) := qr in - (match q with - | Z0 => (0, r) - | Zpos xH => (0, d + r) - | Zpos (xI n) => (Zpos n, d + r) - | Zpos (xO n) => (Zpos n, r) - | Zneg xH => (-1, d + r) - | Zneg (xI n) => (Zneg n - 1, d + r) - | Zneg (xO n) => (Zneg n, r) - end, 2 * d). - -Definition Zdiv_rest (x:Z) (p:positive) := - let (qr, d) := iter_pos p _ Zdiv_rest_aux (x, 0, 1) in qr. - -Lemma Zdiv_rest_correct1 : - forall (x:Z) (p:positive), - let (qr, d) := iter_pos p _ Zdiv_rest_aux (x, 0, 1) in d = two_power_pos p. - -intros x p; rewrite (iter_nat_of_P p _ Zdiv_rest_aux (x, 0, 1)); - rewrite (two_power_pos_nat p); elim (nat_of_P p); - simpl in |- *; - [ trivial with zarith - | intro n; rewrite (two_power_nat_S n); unfold Zdiv_rest_aux at 2 in |- *; - elim (iter_nat n (Z * Z * Z) Zdiv_rest_aux (x, 0, 1)); - destruct a; intros; apply f_equal with (f := fun z:Z => 2 * z); - assumption ]. -Qed. - -Lemma Zdiv_rest_correct2 : - forall (x:Z) (p:positive), - let (qr, d) := iter_pos p _ Zdiv_rest_aux (x, 0, 1) in - let (q, r) := qr in x = q * d + r /\ 0 <= r < d. - -intros; - apply iter_pos_invariant with - (f := Zdiv_rest_aux) - (Inv := fun qrd:Z * Z * Z => - let (qr, d) := qrd in + (** * Division by a power of two. *) + + (** To [n:Z] and [p:positive], [q],[r] are associated such that + [n = 2^p.q + r] and [0 <= r < 2^p] *) + + (** Invariant: [d*q + r = d'*q + r /\ d' = 2*d /\ 0<= r < d /\ 0 <= r' < d'] *) + Definition Zdiv_rest_aux (qrd:Z * Z * Z) := + let (qr, d) := qrd in + let (q, r) := qr in + (match q with + | Z0 => (0, r) + | Zpos xH => (0, d + r) + | Zpos (xI n) => (Zpos n, d + r) + | Zpos (xO n) => (Zpos n, r) + | Zneg xH => (-1, d + r) + | Zneg (xI n) => (Zneg n - 1, d + r) + | Zneg (xO n) => (Zneg n, r) + end, 2 * d). + + Definition Zdiv_rest (x:Z) (p:positive) := + let (qr, d) := iter_pos p _ Zdiv_rest_aux (x, 0, 1) in qr. + + Lemma Zdiv_rest_correct1 : + forall (x:Z) (p:positive), + let (qr, d) := iter_pos p _ Zdiv_rest_aux (x, 0, 1) in d = two_power_pos p. + Proof. + intros x p; rewrite (iter_nat_of_P p _ Zdiv_rest_aux (x, 0, 1)); + rewrite (two_power_pos_nat p); elim (nat_of_P p); + simpl in |- *; + [ trivial with zarith + | intro n; rewrite (two_power_nat_S n); unfold Zdiv_rest_aux at 2 in |- *; + elim (iter_nat n (Z * Z * Z) Zdiv_rest_aux (x, 0, 1)); + destruct a; intros; apply f_equal with (f := fun z:Z => 2 * z); + assumption ]. + Qed. + + Lemma Zdiv_rest_correct2 : + forall (x:Z) (p:positive), + let (qr, d) := iter_pos p _ Zdiv_rest_aux (x, 0, 1) in + let (q, r) := qr in x = q * d + r /\ 0 <= r < d. + Proof. + intros; + apply iter_pos_invariant with + (f := Zdiv_rest_aux) + (Inv := fun qrd:Z * Z * Z => + let (qr, d) := qrd in let (q, r) := qr in x = q * d + r /\ 0 <= r < d); - [ intro x0; elim x0; intro y0; elim y0; intros q r d; - unfold Zdiv_rest_aux in |- *; elim q; - [ omega - | destruct p0; - [ rewrite BinInt.Zpos_xI; intro; elim H; intros; split; - [ rewrite H0; rewrite Zplus_assoc; rewrite Zmult_plus_distr_l; - rewrite Zmult_1_l; rewrite Zmult_assoc; - rewrite (Zmult_comm (Zpos p0) 2); apply refl_equal - | omega ] - | rewrite BinInt.Zpos_xO; intro; elim H; intros; split; - [ rewrite H0; rewrite Zmult_assoc; rewrite (Zmult_comm (Zpos p0) 2); - apply refl_equal - | omega ] - | omega ] - | destruct p0; - [ rewrite BinInt.Zneg_xI; unfold Zminus in |- *; intro; elim H; intros; - split; - [ rewrite H0; rewrite Zplus_assoc; - apply f_equal with (f := fun z:Z => z + r); - do 2 rewrite Zmult_plus_distr_l; rewrite Zmult_assoc; - rewrite (Zmult_comm (Zneg p0) 2); rewrite <- Zplus_assoc; - apply f_equal with (f := fun z:Z => 2 * Zneg p0 * d + z); - omega - | omega ] - | rewrite BinInt.Zneg_xO; unfold Zminus in |- *; intro; elim H; intros; - split; - [ rewrite H0; rewrite Zmult_assoc; rewrite (Zmult_comm (Zneg p0) 2); - apply refl_equal - | omega ] - | omega ] ] - | omega ]. -Qed. - -Inductive Zdiv_rest_proofs (x:Z) (p:positive) : Set := + [ intro x0; elim x0; intro y0; elim y0; intros q r d; + unfold Zdiv_rest_aux in |- *; elim q; + [ omega + | destruct p0; + [ rewrite BinInt.Zpos_xI; intro; elim H; intros; split; + [ rewrite H0; rewrite Zplus_assoc; rewrite Zmult_plus_distr_l; + rewrite Zmult_1_l; rewrite Zmult_assoc; + rewrite (Zmult_comm (Zpos p0) 2); apply refl_equal + | omega ] + | rewrite BinInt.Zpos_xO; intro; elim H; intros; split; + [ rewrite H0; rewrite Zmult_assoc; rewrite (Zmult_comm (Zpos p0) 2); + apply refl_equal + | omega ] + | omega ] + | destruct p0; + [ rewrite BinInt.Zneg_xI; unfold Zminus in |- *; intro; elim H; intros; + split; + [ rewrite H0; rewrite Zplus_assoc; + apply f_equal with (f := fun z:Z => z + r); + do 2 rewrite Zmult_plus_distr_l; rewrite Zmult_assoc; + rewrite (Zmult_comm (Zneg p0) 2); rewrite <- Zplus_assoc; + apply f_equal with (f := fun z:Z => 2 * Zneg p0 * d + z); + omega + | omega ] + | rewrite BinInt.Zneg_xO; unfold Zminus in |- *; intro; elim H; intros; + split; + [ rewrite H0; rewrite Zmult_assoc; rewrite (Zmult_comm (Zneg p0) 2); + apply refl_equal + | omega ] + | omega ] ] + | omega ]. + Qed. + + Inductive Zdiv_rest_proofs (x:Z) (p:positive) : Set := Zdiv_rest_proof : - forall q r:Z, - x = q * two_power_pos p + r -> - 0 <= r -> r < two_power_pos p -> Zdiv_rest_proofs x p. - -Lemma Zdiv_rest_correct : forall (x:Z) (p:positive), Zdiv_rest_proofs x p. -intros x p. -generalize (Zdiv_rest_correct1 x p); generalize (Zdiv_rest_correct2 x p). -elim (iter_pos p (Z * Z * Z) Zdiv_rest_aux (x, 0, 1)). -simple induction a. -intros. -elim H; intros H1 H2; clear H. -rewrite H0 in H1; rewrite H0 in H2; elim H2; intros; - apply Zdiv_rest_proof with (q := a0) (r := b); assumption. -Qed. + forall q r:Z, + x = q * two_power_pos p + r -> + 0 <= r -> r < two_power_pos p -> Zdiv_rest_proofs x p. + + Lemma Zdiv_rest_correct : forall (x:Z) (p:positive), Zdiv_rest_proofs x p. + Proof. + intros x p. + generalize (Zdiv_rest_correct1 x p); generalize (Zdiv_rest_correct2 x p). + elim (iter_pos p (Z * Z * Z) Zdiv_rest_aux (x, 0, 1)). + simple induction a. + intros. + elim H; intros H1 H2; clear H. + rewrite H0 in H1; rewrite H0 in H2; elim H2; intros; + apply Zdiv_rest_proof with (q := a0) (r := b); assumption. + Qed. End power_div_with_rest.
\ No newline at end of file diff --git a/theories/ZArith/Zsqrt.v b/theories/ZArith/Zsqrt.v index cf4acb5f..9893bed3 100644 --- a/theories/ZArith/Zsqrt.v +++ b/theories/ZArith/Zsqrt.v @@ -6,11 +6,11 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: Zsqrt.v 6199 2004-10-11 11:39:18Z herbelin $ *) +(* $Id: Zsqrt.v 9245 2006-10-17 12:53:34Z notin $ *) +Require Import ZArithRing. Require Import Omega. Require Export ZArith_base. -Require Export ZArithRing. Open Local Scope Z_scope. (**********************************************************************) @@ -20,73 +20,73 @@ Open Local Scope Z_scope. `2*(POS ...)+1`, but only when ... is not made only with xO, XI, or xH. *) Ltac compute_POS := match goal with - | |- context [(Zpos (xI ?X1))] => + | |- context [(Zpos (xI ?X1))] => match constr:X1 with - | context [1%positive] => fail 1 - | _ => rewrite (BinInt.Zpos_xI X1) + | context [1%positive] => fail 1 + | _ => rewrite (BinInt.Zpos_xI X1) end - | |- context [(Zpos (xO ?X1))] => + | |- context [(Zpos (xO ?X1))] => match constr:X1 with - | context [1%positive] => fail 1 - | _ => rewrite (BinInt.Zpos_xO X1) + | context [1%positive] => fail 1 + | _ => rewrite (BinInt.Zpos_xO X1) end end. Inductive sqrt_data (n:Z) : Set := - c_sqrt : forall s r:Z, n = s * s + r -> 0 <= r <= 2 * s -> sqrt_data n. + c_sqrt : forall s r:Z, n = s * s + r -> 0 <= r <= 2 * s -> sqrt_data n. Definition sqrtrempos : forall p:positive, sqrt_data (Zpos p). -refine - (fix sqrtrempos (p:positive) : sqrt_data (Zpos p) := - match p return sqrt_data (Zpos p) with - | xH => c_sqrt 1 1 0 _ _ - | xO xH => c_sqrt 2 1 1 _ _ - | xI xH => c_sqrt 3 1 2 _ _ - | xO (xO p') => - match sqrtrempos p' with - | c_sqrt s' r' Heq Hint => - match Z_le_gt_dec (4 * s' + 1) (4 * r') with - | left Hle => - c_sqrt (Zpos (xO (xO p'))) (2 * s' + 1) + refine + (fix sqrtrempos (p:positive) : sqrt_data (Zpos p) := + match p return sqrt_data (Zpos p) with + | xH => c_sqrt 1 1 0 _ _ + | xO xH => c_sqrt 2 1 1 _ _ + | xI xH => c_sqrt 3 1 2 _ _ + | xO (xO p') => + match sqrtrempos p' with + | c_sqrt s' r' Heq Hint => + match Z_le_gt_dec (4 * s' + 1) (4 * r') with + | left Hle => + c_sqrt (Zpos (xO (xO p'))) (2 * s' + 1) (4 * r' - (4 * s' + 1)) _ _ - | right Hgt => c_sqrt (Zpos (xO (xO p'))) (2 * s') (4 * r') _ _ - end - end - | xO (xI p') => - match sqrtrempos p' with - | c_sqrt s' r' Heq Hint => - match Z_le_gt_dec (4 * s' + 1) (4 * r' + 2) with - | left Hle => - c_sqrt (Zpos (xO (xI p'))) (2 * s' + 1) + | right Hgt => c_sqrt (Zpos (xO (xO p'))) (2 * s') (4 * r') _ _ + end + end + | xO (xI p') => + match sqrtrempos p' with + | c_sqrt s' r' Heq Hint => + match Z_le_gt_dec (4 * s' + 1) (4 * r' + 2) with + | left Hle => + c_sqrt (Zpos (xO (xI p'))) (2 * s' + 1) (4 * r' + 2 - (4 * s' + 1)) _ _ - | right Hgt => - c_sqrt (Zpos (xO (xI p'))) (2 * s') (4 * r' + 2) _ _ - end - end - | xI (xO p') => - match sqrtrempos p' with - | c_sqrt s' r' Heq Hint => - match Z_le_gt_dec (4 * s' + 1) (4 * r' + 1) with - | left Hle => - c_sqrt (Zpos (xI (xO p'))) (2 * s' + 1) + | right Hgt => + c_sqrt (Zpos (xO (xI p'))) (2 * s') (4 * r' + 2) _ _ + end + end + | xI (xO p') => + match sqrtrempos p' with + | c_sqrt s' r' Heq Hint => + match Z_le_gt_dec (4 * s' + 1) (4 * r' + 1) with + | left Hle => + c_sqrt (Zpos (xI (xO p'))) (2 * s' + 1) (4 * r' + 1 - (4 * s' + 1)) _ _ - | right Hgt => - c_sqrt (Zpos (xI (xO p'))) (2 * s') (4 * r' + 1) _ _ - end - end - | xI (xI p') => - match sqrtrempos p' with - | c_sqrt s' r' Heq Hint => - match Z_le_gt_dec (4 * s' + 1) (4 * r' + 3) with - | left Hle => - c_sqrt (Zpos (xI (xI p'))) (2 * s' + 1) + | right Hgt => + c_sqrt (Zpos (xI (xO p'))) (2 * s') (4 * r' + 1) _ _ + end + end + | xI (xI p') => + match sqrtrempos p' with + | c_sqrt s' r' Heq Hint => + match Z_le_gt_dec (4 * s' + 1) (4 * r' + 3) with + | left Hle => + c_sqrt (Zpos (xI (xI p'))) (2 * s' + 1) (4 * r' + 3 - (4 * s' + 1)) _ _ | right Hgt => c_sqrt (Zpos (xI (xI p'))) (2 * s') (4 * r' + 3) _ _ end end end); clear sqrtrempos; repeat compute_POS; - try (try rewrite Heq; ring; fail); try omega. + try (try rewrite Heq; ring); try omega. Defined. (** Define with integer input, but with a strong (readable) specification. *) @@ -94,70 +94,71 @@ Definition Zsqrt : forall x:Z, 0 <= x -> {s : Z & {r : Z | x = s * s + r /\ s * s <= x < (s + 1) * (s + 1)}}. -refine - (fun x => - match - x - return + refine + (fun x => + match + x + return 0 <= x -> {s : Z & {r : Z | x = s * s + r /\ s * s <= x < (s + 1) * (s + 1)}} - with - | Zpos p => - fun h => - match sqrtrempos p with - | c_sqrt s r Heq Hint => - existS + with + | Zpos p => + fun h => + match sqrtrempos p with + | c_sqrt s r Heq Hint => + existS (fun s:Z => - {r : Z | - Zpos p = s * s + r /\ s * s <= Zpos p < (s + 1) * (s + 1)}) + {r : Z | + Zpos p = s * s + r /\ s * s <= Zpos p < (s + 1) * (s + 1)}) s (exist - (fun r:Z => - Zpos p = s * s + r /\ - s * s <= Zpos p < (s + 1) * (s + 1)) r _) - end - | Zneg p => - fun h => - False_rec + (fun r:Z => + Zpos p = s * s + r /\ + s * s <= Zpos p < (s + 1) * (s + 1)) r _) + end + | Zneg p => + fun h => + False_rec {s : Z & - {r : Z | - Zneg p = s * s + r /\ s * s <= Zneg p < (s + 1) * (s + 1)}} + {r : Z | + Zneg p = s * s + r /\ s * s <= Zneg p < (s + 1) * (s + 1)}} (h (refl_equal Datatypes.Gt)) - | Z0 => - fun h => - existS + | Z0 => + fun h => + existS (fun s:Z => - {r : Z | 0 = s * s + r /\ s * s <= 0 < (s + 1) * (s + 1)}) 0 + {r : Z | 0 = s * s + r /\ s * s <= 0 < (s + 1) * (s + 1)}) 0 (exist (fun r:Z => 0 = 0 * 0 + r /\ 0 * 0 <= 0 < (0 + 1) * (0 + 1)) 0 _) end); try omega. -split; [ omega | rewrite Heq; ring ((s + 1) * (s + 1)); omega ]. +split; [ omega | rewrite Heq; ring_simplify ((s + 1) * (s + 1)); omega ]. Defined. (** Define a function of type Z->Z that computes the integer square root, but only for positive numbers, and 0 for others. *) Definition Zsqrt_plain (x:Z) : Z := match x with - | Zpos p => + | Zpos p => match Zsqrt (Zpos p) (Zorder.Zle_0_pos p) with - | existS s _ => s + | existS s _ => s end - | Zneg p => 0 - | Z0 => 0 + | Zneg p => 0 + | Z0 => 0 end. (** A basic theorem about Zsqrt_plain *) Theorem Zsqrt_interval : - forall n:Z, - 0 <= n -> - Zsqrt_plain n * Zsqrt_plain n <= n < - (Zsqrt_plain n + 1) * (Zsqrt_plain n + 1). -intros x; case x. -unfold Zsqrt_plain in |- *; omega. -intros p; unfold Zsqrt_plain in |- *; - case (Zsqrt (Zpos p) (Zorder.Zle_0_pos p)). -intros s [r [Heq Hint]] Hle; assumption. -intros p Hle; elim Hle; auto. + forall n:Z, + 0 <= n -> + Zsqrt_plain n * Zsqrt_plain n <= n < + (Zsqrt_plain n + 1) * (Zsqrt_plain n + 1). +Proof. + intros x; case x. + unfold Zsqrt_plain in |- *; omega. + intros p; unfold Zsqrt_plain in |- *; + case (Zsqrt (Zpos p) (Zorder.Zle_0_pos p)). + intros s [r [Heq Hint]] Hle; assumption. + intros p Hle; elim Hle; auto. Qed. diff --git a/theories/ZArith/Zwf.v b/theories/ZArith/Zwf.v index 4ff663fb..bd617204 100644 --- a/theories/ZArith/Zwf.v +++ b/theories/ZArith/Zwf.v @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: Zwf.v 5920 2004-07-16 20:01:26Z herbelin $ *) +(* $Id: Zwf.v 9245 2006-10-17 12:53:34Z notin $ *) Require Import ZArith_base. Require Export Wf_nat. @@ -26,35 +26,35 @@ Definition Zwf (c x y:Z) := c <= y /\ x < y. Section wf_proof. -Variable c : Z. - -(** The proof of well-foundness is classic: we do the proof by induction - on a measure in nat, which is here [|x-c|] *) - -Let f (z:Z) := Zabs_nat (z - c). - -Lemma Zwf_well_founded : well_founded (Zwf c). -red in |- *; intros. -assert (forall (n:nat) (a:Z), (f a < n)%nat \/ a < c -> Acc (Zwf c) a). -clear a; simple induction n; intros. -(** n= 0 *) -case H; intros. -case (lt_n_O (f a)); auto. -apply Acc_intro; unfold Zwf in |- *; intros. -assert False; omega || contradiction. -(** inductive case *) -case H0; clear H0; intro; auto. -apply Acc_intro; intros. -apply H. -unfold Zwf in H1. -case (Zle_or_lt c y); intro; auto with zarith. -left. -red in H0. -apply lt_le_trans with (f a); auto with arith. -unfold f in |- *. -apply Zabs.Zabs_nat_lt; omega. -apply (H (S (f a))); auto. -Qed. + Variable c : Z. + + (** The proof of well-foundness is classic: we do the proof by induction + on a measure in nat, which is here [|x-c|] *) + + Let f (z:Z) := Zabs_nat (z - c). + + Lemma Zwf_well_founded : well_founded (Zwf c). + red in |- *; intros. + assert (forall (n:nat) (a:Z), (f a < n)%nat \/ a < c -> Acc (Zwf c) a). + clear a; simple induction n; intros. + (** n= 0 *) + case H; intros. + case (lt_n_O (f a)); auto. + apply Acc_intro; unfold Zwf in |- *; intros. + assert False; omega || contradiction. + (** inductive case *) + case H0; clear H0; intro; auto. + apply Acc_intro; intros. + apply H. + unfold Zwf in H1. + case (Zle_or_lt c y); intro; auto with zarith. + left. + red in H0. + apply lt_le_trans with (f a); auto with arith. + unfold f in |- *. + apply Zabs.Zabs_nat_lt; omega. + apply (H (S (f a))); auto. + Qed. End wf_proof. @@ -72,25 +72,25 @@ Definition Zwf_up (c x y:Z) := y < x <= c. Section wf_proof_up. -Variable c : Z. + Variable c : Z. -(** The proof of well-foundness is classic: we do the proof by induction - on a measure in nat, which is here [|c-x|] *) + (** The proof of well-foundness is classic: we do the proof by induction + on a measure in nat, which is here [|c-x|] *) -Let f (z:Z) := Zabs_nat (c - z). + Let f (z:Z) := Zabs_nat (c - z). -Lemma Zwf_up_well_founded : well_founded (Zwf_up c). -Proof. -apply well_founded_lt_compat with (f := f). -unfold Zwf_up, f in |- *. -intros. -apply Zabs.Zabs_nat_lt. -unfold Zminus in |- *. split. -apply Zle_left; intuition. -apply Zplus_lt_compat_l; unfold Zlt in |- *; rewrite <- Zcompare_opp; - intuition. -Qed. + Lemma Zwf_up_well_founded : well_founded (Zwf_up c). + Proof. + apply well_founded_lt_compat with (f := f). + unfold Zwf_up, f in |- *. + intros. + apply Zabs.Zabs_nat_lt. + unfold Zminus in |- *. split. + apply Zle_left; intuition. + apply Zplus_lt_compat_l; unfold Zlt in |- *; rewrite <- Zcompare_opp; + intuition. + Qed. End wf_proof_up. -Hint Resolve Zwf_up_well_founded: datatypes v62.
\ No newline at end of file +Hint Resolve Zwf_up_well_founded: datatypes v62. diff --git a/theories/ZArith/auxiliary.v b/theories/ZArith/auxiliary.v index 28cbd1e4..726fb45a 100644 --- a/theories/ZArith/auxiliary.v +++ b/theories/ZArith/auxiliary.v @@ -6,11 +6,11 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: auxiliary.v 5920 2004-07-16 20:01:26Z herbelin $ i*) +(*i $Id: auxiliary.v 9302 2006-10-27 21:21:17Z barras $ i*) (** Binary Integers (Pierre Crégut, CNET, Lannion, France) *) -Require Export Arith. +Require Export Arith_base. Require Import BinInt. Require Import Zorder. Require Import Decidable. @@ -19,132 +19,134 @@ Require Export Compare_dec. Open Local Scope Z_scope. -(**********************************************************************) -(** Moving terms from one side to the other of an inequality *) +(***************************************************************) +(** * Moving terms from one side to the other of an inequality *) Theorem Zne_left : forall n m:Z, Zne n m -> Zne (n + - m) 0. Proof. -intros x y; unfold Zne in |- *; unfold not in |- *; intros H1 H2; apply H1; - apply Zplus_reg_l with (- y); rewrite Zplus_opp_l; - rewrite Zplus_comm; trivial with arith. + intros x y; unfold Zne in |- *; unfold not in |- *; intros H1 H2; apply H1; + apply Zplus_reg_l with (- y); rewrite Zplus_opp_l; + rewrite Zplus_comm; trivial with arith. Qed. Theorem Zegal_left : forall n m:Z, n = m -> n + - m = 0. Proof. -intros x y H; apply (Zplus_reg_l y); rewrite Zplus_permute; - rewrite Zplus_opp_r; do 2 rewrite Zplus_0_r; assumption. + intros x y H; apply (Zplus_reg_l y); rewrite Zplus_permute; + rewrite Zplus_opp_r; do 2 rewrite Zplus_0_r; assumption. Qed. Theorem Zle_left : forall n m:Z, n <= m -> 0 <= m + - n. Proof. -intros x y H; replace 0 with (x + - x). -apply Zplus_le_compat_r; trivial. -apply Zplus_opp_r. + intros x y H; replace 0 with (x + - x). + apply Zplus_le_compat_r; trivial. + apply Zplus_opp_r. Qed. Theorem Zle_left_rev : forall n m:Z, 0 <= m + - n -> n <= m. Proof. -intros x y H; apply Zplus_le_reg_r with (- x). -rewrite Zplus_opp_r; trivial. + intros x y H; apply Zplus_le_reg_r with (- x). + rewrite Zplus_opp_r; trivial. Qed. Theorem Zlt_left_rev : forall n m:Z, 0 < m + - n -> n < m. Proof. -intros x y H; apply Zplus_lt_reg_r with (- x). -rewrite Zplus_opp_r; trivial. + intros x y H; apply Zplus_lt_reg_r with (- x). + rewrite Zplus_opp_r; trivial. Qed. Theorem Zlt_left : forall n m:Z, n < m -> 0 <= m + -1 + - n. Proof. -intros x y H; apply Zle_left; apply Zsucc_le_reg; - change (Zsucc x <= Zsucc (Zpred y)) in |- *; rewrite <- Zsucc_pred; - apply Zlt_le_succ; assumption. + intros x y H; apply Zle_left; apply Zsucc_le_reg; + change (Zsucc x <= Zsucc (Zpred y)) in |- *; rewrite <- Zsucc_pred; + apply Zlt_le_succ; assumption. Qed. Theorem Zlt_left_lt : forall n m:Z, n < m -> 0 < m + - n. Proof. -intros x y H; replace 0 with (x + - x). -apply Zplus_lt_compat_r; trivial. -apply Zplus_opp_r. + intros x y H; replace 0 with (x + - x). + apply Zplus_lt_compat_r; trivial. + apply Zplus_opp_r. Qed. Theorem Zge_left : forall n m:Z, n >= m -> 0 <= n + - m. Proof. -intros x y H; apply Zle_left; apply Zge_le; assumption. + intros x y H; apply Zle_left; apply Zge_le; assumption. Qed. Theorem Zgt_left : forall n m:Z, n > m -> 0 <= n + -1 + - m. Proof. -intros x y H; apply Zlt_left; apply Zgt_lt; assumption. + intros x y H; apply Zlt_left; apply Zgt_lt; assumption. Qed. Theorem Zgt_left_gt : forall n m:Z, n > m -> n + - m > 0. Proof. -intros x y H; replace 0 with (y + - y). -apply Zplus_gt_compat_r; trivial. -apply Zplus_opp_r. + intros x y H; replace 0 with (y + - y). + apply Zplus_gt_compat_r; trivial. + apply Zplus_opp_r. Qed. Theorem Zgt_left_rev : forall n m:Z, n + - m > 0 -> n > m. Proof. -intros x y H; apply Zplus_gt_reg_r with (- y). -rewrite Zplus_opp_r; trivial. + intros x y H; apply Zplus_gt_reg_r with (- y). + rewrite Zplus_opp_r; trivial. Qed. (**********************************************************************) -(** Factorization lemmas *) +(** * Factorization lemmas *) Theorem Zred_factor0 : forall n:Z, n = n * 1. -intro x; rewrite (Zmult_1_r x); reflexivity. + intro x; rewrite (Zmult_1_r x); reflexivity. Qed. Theorem Zred_factor1 : forall n:Z, n + n = n * 2. Proof. -exact Zplus_diag_eq_mult_2. + exact Zplus_diag_eq_mult_2. Qed. Theorem Zred_factor2 : forall n m:Z, n + n * m = n * (1 + m). - -intros x y; pattern x at 1 in |- *; rewrite <- (Zmult_1_r x); - rewrite <- Zmult_plus_distr_r; trivial with arith. +Proof. + intros x y; pattern x at 1 in |- *; rewrite <- (Zmult_1_r x); + rewrite <- Zmult_plus_distr_r; trivial with arith. Qed. Theorem Zred_factor3 : forall n m:Z, n * m + n = n * (1 + m). - -intros x y; pattern x at 2 in |- *; rewrite <- (Zmult_1_r x); - rewrite <- Zmult_plus_distr_r; rewrite Zplus_comm; - trivial with arith. +Proof. + intros x y; pattern x at 2 in |- *; rewrite <- (Zmult_1_r x); + rewrite <- Zmult_plus_distr_r; rewrite Zplus_comm; + trivial with arith. Qed. + Theorem Zred_factor4 : forall n m p:Z, n * m + n * p = n * (m + p). -intros x y z; symmetry in |- *; apply Zmult_plus_distr_r. +Proof. + intros x y z; symmetry in |- *; apply Zmult_plus_distr_r. Qed. Theorem Zred_factor5 : forall n m:Z, n * 0 + m = m. - -intros x y; rewrite <- Zmult_0_r_reverse; auto with arith. +Proof. + intros x y; rewrite <- Zmult_0_r_reverse; auto with arith. Qed. Theorem Zred_factor6 : forall n:Z, n = n + 0. - -intro; rewrite Zplus_0_r; trivial with arith. +Proof. + intro; rewrite Zplus_0_r; trivial with arith. Qed. Theorem Zle_mult_approx : - forall n m p:Z, n > 0 -> p > 0 -> 0 <= m -> 0 <= m * n + p. - -intros x y z H1 H2 H3; apply Zle_trans with (m := y * x); - [ apply Zmult_gt_0_le_0_compat; assumption - | pattern (y * x) at 1 in |- *; rewrite <- Zplus_0_r; - apply Zplus_le_compat_l; apply Zlt_le_weak; apply Zgt_lt; - assumption ]. + forall n m p:Z, n > 0 -> p > 0 -> 0 <= m -> 0 <= m * n + p. +Proof. + intros x y z H1 H2 H3; apply Zle_trans with (m := y * x); + [ apply Zmult_gt_0_le_0_compat; assumption + | pattern (y * x) at 1 in |- *; rewrite <- Zplus_0_r; + apply Zplus_le_compat_l; apply Zlt_le_weak; apply Zgt_lt; + assumption ]. Qed. Theorem Zmult_le_approx : - forall n m p:Z, n > 0 -> n > p -> 0 <= m * n + p -> 0 <= m. - -intros x y z H1 H2 H3; apply Zlt_succ_le; apply Zmult_gt_0_lt_0_reg_r with x; - [ assumption - | apply Zle_lt_trans with (1 := H3); rewrite <- Zmult_succ_l_reverse; - apply Zplus_lt_compat_l; apply Zgt_lt; assumption ]. - + forall n m p:Z, n > 0 -> n > p -> 0 <= m * n + p -> 0 <= m. +Proof. + intros x y z H1 H2 H3; apply Zlt_succ_le; apply Zmult_gt_0_lt_0_reg_r with x; + [ assumption + | apply Zle_lt_trans with (1 := H3); rewrite <- Zmult_succ_l_reverse; + apply Zplus_lt_compat_l; apply Zgt_lt; assumption ]. Qed. + |