diff options
| author |  Stephane Glondu <steph@glondu.net> | 2012-08-20 18:27:01 +0200 |
|---|---|---|
| committer | Stephane Glondu <steph@glondu.net> | 2012-08-20 18:27:01 +0200 |
| commit | e0d682ec25282a348d35c5b169abafec48555690 (patch) | |
| tree | 1a46f0142a85df553388c932110793881f3af52f /theories | |
| parent | 86535d84cc3cffeee1dcd8545343f234e7285530 (diff) | |
Imported Upstream version 8.4dfsgupstream/8.4dfsg
Diffstat (limited to 'theories')
373 files changed, 15472 insertions, 12428 deletions
diff --git a/theories/Arith/Arith.v b/theories/Arith/Arith.v index 6f3827a3..fea10ce1 100644 --- a/theories/Arith/Arith.v +++ b/theories/Arith/Arith.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Arith/Arith_base.v b/theories/Arith/Arith_base.v index 4f21dadf..9f0f05db 100644 --- a/theories/Arith/Arith_base.v +++ b/theories/Arith/Arith_base.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Arith/Between.v b/theories/Arith/Between.v index dd514653..fb488526 100644 --- a/theories/Arith/Between.v +++ b/theories/Arith/Between.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -9,7 +9,7 @@ Require Import Le. Require Import Lt. -Open Local Scope nat_scope. +Local Open Scope nat_scope. Implicit Types k l p q r : nat. @@ -74,7 +74,7 @@ Section Between. Lemma in_int_intro : forall p q r, p <= r -> r < q -> in_int p q r. Proof. - red in |- *; auto with arith. + red; auto with arith. Qed. Hint Resolve in_int_intro: arith v62. @@ -149,7 +149,7 @@ Section Between. 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. + induction 1; red; 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'. diff --git a/theories/Arith/Bool_nat.v b/theories/Arith/Bool_nat.v index f384e148..4c15a173 100644 --- a/theories/Arith/Bool_nat.v +++ b/theories/Arith/Bool_nat.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -10,7 +10,7 @@ Require Export Compare_dec. Require Export Peano_dec. Require Import Sumbool. -Open Local Scope nat_scope. +Local Open Scope nat_scope. Implicit Types m n x y : nat. diff --git a/theories/Arith/Compare.v b/theories/Arith/Compare.v index c9e6d3cf..65219655 100644 --- a/theories/Arith/Compare.v +++ b/theories/Arith/Compare.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,9 +8,9 @@ (** Equality is decidable on [nat] *) -Open Local Scope nat_scope. +Local Open Scope nat_scope. -Notation not_eq_sym := sym_not_eq. +Notation not_eq_sym := not_eq_sym (only parsing). Implicit Types m n p q : nat. @@ -41,7 +41,7 @@ Proof. 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 |- *. + right; exists (n - S (S m)); simpl. 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)). diff --git a/theories/Arith/Compare_dec.v b/theories/Arith/Compare_dec.v index 360d760a..a90a9ce9 100644 --- a/theories/Arith/Compare_dec.v +++ b/theories/Arith/Compare_dec.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -11,7 +11,7 @@ Require Import Lt. Require Import Gt. Require Import Decidable. -Open Local Scope nat_scope. +Local Open Scope nat_scope. Implicit Types m n x y : nat. @@ -138,7 +138,7 @@ Proof. Qed. -(** A ternary comparison function in the spirit of [Zcompare]. *) +(** A ternary comparison function in the spirit of [Z.compare]. *) Fixpoint nat_compare n m := match n, m with @@ -202,7 +202,7 @@ Lemma nat_compare_spec : forall x y, CompareSpec (x=y) (x<y) (y<x) (nat_compare x y). Proof. intros. - destruct (nat_compare x y) as [ ]_eqn; constructor. + destruct (nat_compare x y) eqn:?; constructor. apply nat_compare_eq; auto. apply <- nat_compare_lt; auto. apply <- nat_compare_gt; auto. @@ -256,7 +256,7 @@ Lemma leb_correct : forall m n, m <= n -> leb m n = true. Proof. induction m as [| m IHm]. trivial. destruct n. intro H. elim (le_Sn_O _ H). - intros. simpl in |- *. apply IHm. apply le_S_n. assumption. + intros. simpl. apply IHm. apply le_S_n. assumption. Qed. Lemma leb_complete : forall m n, leb m n = true -> m <= n. diff --git a/theories/Arith/Div2.v b/theories/Arith/Div2.v index da1d9e98..56115c7f 100644 --- a/theories/Arith/Div2.v +++ b/theories/Arith/Div2.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -43,7 +43,7 @@ Qed. Lemma lt_div2 : forall n, 0 < n -> div2 n < n. Proof. - intro n. pattern n in |- *. apply ind_0_1_SS. + intro n. pattern n. apply ind_0_1_SS. (* n = 0 *) inversion 1. (* n=1 *) @@ -99,12 +99,12 @@ 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. simpl. 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 |- *. + intros m n. unfold double. do 2 rewrite plus_assoc_reverse. rewrite (plus_permute n). reflexivity. Qed. @@ -115,7 +115,7 @@ Lemma even_odd_double : 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. + intro n. pattern n. apply ind_0_1_SS. (* n = 0 *) split; split; auto with arith. intro H. inversion H. @@ -126,11 +126,11 @@ Proof. intros. destruct H as ((IH1,IH2),(IH3,IH4)). 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. + simpl. rewrite (double_S (div2 n0)). auto with arith. + simpl. 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. + simpl. rewrite (double_S (div2 n0)). auto with arith. + simpl. rewrite (double_S (div2 n0)). intro H. injection H. auto with arith. Qed. (** Specializations *) diff --git a/theories/Arith/EqNat.v b/theories/Arith/EqNat.v index 94986278..ce8eb478 100644 --- a/theories/Arith/EqNat.v +++ b/theories/Arith/EqNat.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,7 +8,7 @@ (** Equality on natural numbers *) -Open Local Scope nat_scope. +Local Open Scope nat_scope. Implicit Types m n x y : nat. @@ -23,7 +23,7 @@ Fixpoint eq_nat n m : Prop := end. Theorem eq_nat_refl : forall n, eq_nat n n. - induction n; simpl in |- *; auto. + induction n; simpl; auto. Qed. Hint Resolve eq_nat_refl: arith v62. @@ -35,7 +35,7 @@ Qed. Hint Immediate eq_eq_nat: arith v62. Lemma eq_nat_eq : forall n m, eq_nat n m -> n = m. - induction n; induction m; simpl in |- *; contradiction || auto with arith. + induction n; induction m; simpl; contradiction || auto with arith. Qed. Hint Immediate eq_nat_eq: arith v62. @@ -55,11 +55,11 @@ Proof. induction n. destruct m as [| n]. auto with arith. - intros; right; red in |- *; trivial with arith. + intros; right; red; trivial with arith. destruct m as [| n0]. - right; red in |- *; auto with arith. + right; red; auto with arith. intros. - simpl in |- *. + simpl. apply IHn. Defined. @@ -76,12 +76,12 @@ Fixpoint beq_nat n m : bool := Lemma beq_nat_refl : forall n, true = beq_nat n n. Proof. - intro x; induction x; simpl in |- *; auto. + intro x; induction x; simpl; auto. Qed. Definition beq_nat_eq : forall x y, true = beq_nat x y -> x = y. Proof. - double induction x y; simpl in |- *. + double induction x y; simpl. reflexivity. intros n H1 H2. discriminate H2. intros n H1 H2. discriminate H2. diff --git a/theories/Arith/Euclid.v b/theories/Arith/Euclid.v index 513fd110..3abdff98 100644 --- a/theories/Arith/Euclid.v +++ b/theories/Arith/Euclid.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -19,16 +19,16 @@ Inductive diveucl a b : Set := Lemma eucl_dev : forall n, n > 0 -> forall m:nat, diveucl m n. Proof. - intros b H a; pattern a in |- *; apply gt_wf_rec; intros n H0. + intros b H a; pattern a; 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. + apply divex with (S q) r; simpl; auto with arith. elim plus_assoc. elim e; auto with arith. intros gtbn. - apply divex with 0 n; simpl in |- *; auto with arith. + apply divex with 0 n; simpl; auto with arith. Defined. Lemma quotient : @@ -36,17 +36,17 @@ Lemma quotient : 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. + intros b H a; pattern a; 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. + exists r; simpl; elim Hr; intros. elim plus_assoc. elim H1; auto with arith. intros gtbn. - exists 0; exists n; simpl in |- *; auto with arith. + exists 0; exists n; simpl; auto with arith. Defined. Lemma modulo : @@ -54,15 +54,15 @@ Lemma modulo : 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. + intros b H a; pattern a; 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 Hq; intros; exists (S q); simpl. elim plus_assoc. elim H1; auto with arith. intros gtbn. - exists n; exists 0; simpl in |- *; auto with arith. + exists n; exists 0; simpl; auto with arith. Defined. diff --git a/theories/Arith/Even.v b/theories/Arith/Even.v index cd4dae98..4f679fe2 100644 --- a/theories/Arith/Even.v +++ b/theories/Arith/Even.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -10,7 +10,7 @@ and we prove the decidability and the exclusion of those predicates. The main results about parity are proved in the module Div2. *) -Open Local Scope nat_scope. +Local Open Scope nat_scope. Implicit Types m n : nat. @@ -145,7 +145,7 @@ Lemma even_mult_aux : 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 n; elim n; simpl; auto with arith. intros m; split; split; auto with arith. intros H'; inversion H'. intros H'; elim H'; auto. diff --git a/theories/Arith/Factorial.v b/theories/Arith/Factorial.v index 146546dc..37aa1b2c 100644 --- a/theories/Arith/Factorial.v +++ b/theories/Arith/Factorial.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -9,7 +9,7 @@ Require Import Plus. Require Import Mult. Require Import Lt. -Open Local Scope nat_scope. +Local Open Scope nat_scope. (** Factorial *) @@ -23,13 +23,13 @@ Arguments fact n%nat. 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; simpl; auto with arith. Qed. Lemma fact_neq_0 : forall n:nat, fact n <> 0. Proof. intro. - apply sym_not_eq. + apply not_eq_sym. apply lt_O_neq. apply lt_O_fact. Qed. diff --git a/theories/Arith/Gt.v b/theories/Arith/Gt.v index 32f453e5..31b15507 100644 --- a/theories/Arith/Gt.v +++ b/theories/Arith/Gt.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -15,7 +15,7 @@ Definition gt (n m:nat) := m < n. Require Import Le. Require Import Lt. Require Import Plus. -Open Local Scope nat_scope. +Local Open Scope nat_scope. Implicit Types m n p : nat. @@ -47,7 +47,7 @@ Hint Immediate gt_S_n: arith v62. Theorem gt_S : forall n m, S n > m -> n > m \/ m = n. Proof. - intros n m H; unfold gt in |- *; apply le_lt_or_eq; auto with arith. + intros n m H; unfold gt; apply le_lt_or_eq; auto with arith. Qed. Lemma gt_pred : forall n m, m > S n -> pred m > n. @@ -110,23 +110,23 @@ Hint Resolve le_gt_S: arith v62. Theorem le_gt_trans : forall n m p, m <= n -> m > p -> n > p. Proof. - red in |- *; intros; apply lt_le_trans with m; auto with arith. + red; intros; apply lt_le_trans with m; auto with arith. Qed. Theorem gt_le_trans : forall n m p, n > m -> p <= m -> n > p. Proof. - red in |- *; intros; apply le_lt_trans with m; auto with arith. + red; intros; apply le_lt_trans with m; auto with arith. Qed. Lemma gt_trans : forall n m p, n > m -> m > p -> n > p. Proof. - red in |- *; intros n m p H1 H2. + red; intros n m p H1 H2. apply lt_trans with m; auto with arith. Qed. Theorem gt_trans_S : forall n m p, S n > m -> m > p -> n > p. Proof. - red in |- *; intros; apply lt_le_trans with m; auto with arith. + red; intros; apply lt_le_trans with m; auto with arith. Qed. Hint Resolve gt_trans_S le_gt_trans gt_le_trans: arith v62. @@ -142,7 +142,7 @@ Qed. Lemma plus_gt_reg_l : forall n m p, p + n > p + m -> n > m. Proof. - red in |- *; intros n m p H; apply plus_lt_reg_l with p; auto with arith. + red; intros n m p H; apply plus_lt_reg_l with p; auto with arith. Qed. Lemma plus_gt_compat_l : forall n m p, n > m -> p + n > p + m. diff --git a/theories/Arith/Le.v b/theories/Arith/Le.v index f0ebf162..1febb76b 100644 --- a/theories/Arith/Le.v +++ b/theories/Arith/Le.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -16,7 +16,7 @@ where "n <= m" := (le n m) : nat_scope. >> *) -Open Local Scope nat_scope. +Local Open Scope nat_scope. Implicit Types m n p : nat. @@ -46,8 +46,8 @@ Qed. Theorem le_Sn_0 : forall n, ~ S n <= 0. Proof. - red in |- *; intros n H. - change (IsSucc 0) in |- *; elim H; simpl in |- *; auto with arith. + red; intros n H. + change (IsSucc 0); elim H; simpl; auto with arith. Qed. Hint Resolve le_0_n le_Sn_0: arith v62. diff --git a/theories/Arith/Lt.v b/theories/Arith/Lt.v index e07bba8d..8559b782 100644 --- a/theories/Arith/Lt.v +++ b/theories/Arith/Lt.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -14,7 +14,7 @@ Infix "<" := lt : nat_scope. *) Require Import Le. -Open Local Scope nat_scope. +Local Open Scope nat_scope. Implicit Types m n p : nat. @@ -51,7 +51,7 @@ 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; intros n m Lt Le; exact (le_not_lt m n Le Lt). Qed. Hint Immediate le_not_lt lt_not_le: arith v62. @@ -107,12 +107,12 @@ Qed. Lemma lt_pred : forall n m, S n < m -> n < pred m. Proof. -induction 1; simpl in |- *; auto with arith. +induction 1; simpl; auto with arith. Qed. Hint Immediate lt_pred: arith v62. Lemma lt_pred_n_n : forall n, 0 < n -> pred n < n. -destruct 1; simpl in |- *; auto with arith. +destruct 1; simpl; auto with arith. Qed. Hint Resolve lt_pred_n_n: arith v62. @@ -159,7 +159,7 @@ Hint Immediate lt_le_weak: arith v62. 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. + intros n m; pattern n, m; apply nat_double_ind; auto with arith. induction 1; auto with arith. Qed. diff --git a/theories/Arith/Max.v b/theories/Arith/Max.v index 77dfa508..5623564a 100644 --- a/theories/Arith/Max.v +++ b/theories/Arith/Max.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Arith/Min.v b/theories/Arith/Min.v index bcfbe0ef..a2a7930d 100644 --- a/theories/Arith/Min.v +++ b/theories/Arith/Min.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -10,7 +10,7 @@ Require Import NPeano. -Open Local Scope nat_scope. +Local Open Scope nat_scope. Implicit Types m n p : nat. Notation min := Peano.min (only parsing). diff --git a/theories/Arith/Minus.v b/theories/Arith/Minus.v index ed215f54..48024331 100644 --- a/theories/Arith/Minus.v +++ b/theories/Arith/Minus.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -21,7 +21,7 @@ where "n - m" := (minus n m) : nat_scope. Require Import Lt. Require Import Le. -Open Local Scope nat_scope. +Local Open Scope nat_scope. Implicit Types m n p : nat. @@ -29,7 +29,7 @@ Implicit Types m n p : nat. Lemma minus_n_O : forall n, n = n - 0. Proof. - induction n; simpl in |- *; auto with arith. + induction n; simpl; auto with arith. Qed. Hint Resolve minus_n_O: arith v62. @@ -37,21 +37,21 @@ Hint Resolve minus_n_O: arith v62. 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 |- *; + intros n m Le; pattern m, n; apply le_elim_rel; simpl; auto with arith. Qed. Hint Resolve minus_Sn_m: arith v62. Theorem pred_of_minus : forall n, pred n = n - 1. Proof. - intro x; induction x; simpl in |- *; auto with arith. + intro x; induction x; simpl; auto with arith. Qed. (** * Diagonal *) Lemma minus_diag : forall n, n - n = 0. Proof. - induction n; simpl in |- *; auto with arith. + induction n; simpl; auto with arith. Qed. Lemma minus_diag_reverse : forall n, 0 = n - n. @@ -66,7 +66,7 @@ Notation minus_n_n := minus_diag_reverse. Lemma minus_plus_simpl_l_reverse : forall n m p, n - m = p + n - (p + m). Proof. - induction p; simpl in |- *; auto with arith. + induction p; simpl; auto with arith. Qed. Hint Resolve minus_plus_simpl_l_reverse: arith v62. @@ -74,7 +74,7 @@ Hint Resolve minus_plus_simpl_l_reverse: arith v62. 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 n m p; pattern m, n; apply nat_double_ind; simpl; intros. replace (n0 - 0) with n0; auto with arith. absurd (0 = S (n0 + p)); auto with arith. @@ -83,20 +83,20 @@ Qed. Hint Immediate plus_minus: arith v62. Lemma minus_plus : forall n m, n + m - n = m. - symmetry in |- *; auto with arith. + symmetry ; 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 |- *; + intros n m Le; pattern n, m; apply le_elim_rel; simpl; 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 ; auto with arith. Qed. Hint Resolve le_plus_minus_r: arith v62. @@ -132,7 +132,7 @@ 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 |- *; + intros n m Le; pattern m, n; apply le_elim_rel; simpl; auto using le_minus with arith. intros; absurd (0 < 0); auto with arith. Qed. @@ -140,7 +140,7 @@ 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 |- *; + intros n m; pattern n, m; apply nat_double_ind; simpl; auto with arith. intros; absurd (0 < 0); trivial with arith. Qed. @@ -148,9 +148,9 @@ Hint Immediate lt_O_minus_lt: arith v62. Theorem not_le_minus_0 : forall n m, ~ m <= n -> n - m = 0. Proof. - intros y x; pattern y, x in |- *; apply nat_double_ind; - [ simpl in |- *; trivial with arith + intros y x; pattern y, x; apply nat_double_ind; + [ simpl; 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; + | simpl; intros n m H1 H2; apply H1; unfold not; intros H3; apply H2; apply le_n_S; assumption ]. Qed. diff --git a/theories/Arith/Mult.v b/theories/Arith/Mult.v index 479138a9..cbb9b376 100644 --- a/theories/Arith/Mult.v +++ b/theories/Arith/Mult.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -11,7 +11,7 @@ Require Export Minus. Require Export Lt. Require Export Le. -Open Local Scope nat_scope. +Local Open Scope nat_scope. Implicit Types m n p : nat. @@ -23,7 +23,7 @@ Implicit Types m n p : nat. Lemma mult_0_r : forall n, n * 0 = 0. Proof. - intro; symmetry in |- *; apply mult_n_O. + intro; symmetry ; apply mult_n_O. Qed. Lemma mult_0_l : forall n, 0 * n = 0. @@ -35,7 +35,7 @@ Qed. Lemma mult_1_l : forall n, 1 * n = n. Proof. - simpl in |- *; auto with arith. + simpl; auto with arith. Qed. Hint Resolve mult_1_l: arith v62. @@ -68,12 +68,12 @@ Hint Resolve mult_plus_distr_r: arith v62. Lemma mult_plus_distr_l : forall n m p, n * (m + p) = n * m + n * p. Proof. induction n. trivial. - intros. simpl in |- *. rewrite IHn. symmetry. apply plus_permute_2_in_4. + intros. simpl. rewrite IHn. symmetry. apply plus_permute_2_in_4. Qed. Lemma mult_minus_distr_r : forall n m p, (n - m) * p = n * p - m * p. Proof. - intros; induction n m using nat_double_ind; simpl; auto with arith. + intros; induction n, m using nat_double_ind; simpl; auto with arith. rewrite <- minus_plus_simpl_l_reverse; auto with arith. Qed. Hint Resolve mult_minus_distr_r: arith v62. @@ -137,13 +137,13 @@ Qed. Lemma mult_O_le : forall n m, m = 0 \/ n <= m * n. Proof. - induction m; simpl in |- *; auto with arith. + induction m; simpl; auto with arith. Qed. Hint Resolve mult_O_le: arith v62. Lemma mult_le_compat_l : forall n m p, n <= m -> p * n <= p * m. Proof. - induction p as [| p IHp]; intros; simpl in |- *. + induction p as [| p IHp]; intros; simpl. apply le_n. auto using plus_le_compat. Qed. @@ -167,7 +167,7 @@ Proof. assumption. apply le_plus_l. (* m*p<=m0*q -> m*p<=(S m0)*q *) - simpl in |- *; apply le_trans with (m0 * q). + simpl; apply le_trans with (m0 * q). assumption. apply le_plus_r. Qed. @@ -232,7 +232,7 @@ Fixpoint mult_acc (s:nat) m n : nat := 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. + induction n as [| p IHp]; simpl; auto. intros s m; rewrite <- plus_tail_plus; rewrite <- IHp. rewrite <- plus_assoc_reverse; apply f_equal2; auto. rewrite plus_comm; auto. @@ -242,7 +242,7 @@ 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; rewrite <- mult_acc_aux; auto. Qed. (** [TailSimpl] transforms any [tail_plus] and [tail_mult] into [plus] @@ -250,4 +250,4 @@ Qed. Ltac tail_simpl := repeat rewrite <- plus_tail_plus; repeat rewrite <- mult_tail_mult; - simpl in |- *. + simpl. diff --git a/theories/Arith/Peano_dec.v b/theories/Arith/Peano_dec.v index 6eb667c1..e0bed0d3 100644 --- a/theories/Arith/Peano_dec.v +++ b/theories/Arith/Peano_dec.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -9,7 +9,7 @@ Require Import Decidable. Require Eqdep_dec. Require Import Le Lt. -Open Local Scope nat_scope. +Local Open Scope nat_scope. Implicit Types m n x y : nat. @@ -29,7 +29,7 @@ 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; elim (eq_nat_dec x y); auto with arith. Defined. Definition UIP_nat:= Eqdep_dec.UIP_dec eq_nat_dec. diff --git a/theories/Arith/Plus.v b/theories/Arith/Plus.v index 02975d8f..5428ada3 100644 --- a/theories/Arith/Plus.v +++ b/theories/Arith/Plus.v @@ -20,7 +20,7 @@ where "n + m" := (plus n m) : nat_scope. Require Import Le. Require Import Lt. -Open Local Scope nat_scope. +Local Open Scope nat_scope. Implicit Types m n p q : nat. @@ -33,7 +33,7 @@ Definition plus_0_r n := eq_sym (plus_n_O n). Lemma plus_comm : forall n m, n + m = m + n. Proof. - intros n m; elim n; simpl in |- *; auto with arith. + intros n m; elim n; simpl; auto with arith. intros y H; elim (plus_n_Sm m y); auto with arith. Qed. Hint Immediate plus_comm: arith v62. @@ -45,7 +45,7 @@ Definition plus_Snm_nSm : forall n m, S n + m = n + S m:= 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; auto with arith. Qed. Hint Resolve plus_assoc: arith v62. @@ -64,42 +64,42 @@ Hint Resolve plus_assoc_reverse: arith v62. 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; 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; 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; auto with arith. Qed. (** * 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; 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; 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; 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; auto with arith. Qed. Hint Resolve le_plus_r: arith v62. @@ -117,7 +117,7 @@ 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; auto with arith. Qed. Hint Resolve plus_lt_compat_l: arith v62. @@ -131,18 +131,18 @@ 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. + elim H; simpl; auto with arith. Qed. Lemma plus_le_lt_compat : forall n m p q, n <= m -> p < q -> n + p < m + q. Proof. - unfold lt in |- *. intros. change (S n + p <= m + q) in |- *. rewrite plus_Snm_nSm. + unfold lt. intros. change (S n + p <= m + q). rewrite plus_Snm_nSm. apply plus_le_compat; assumption. Qed. Lemma plus_lt_le_compat : forall n m p q, n < m -> p <= q -> n + p < m + q. Proof. - unfold lt in |- *. intros. change (S n + p <= m + q) in |- *. apply plus_le_compat; assumption. + unfold lt. intros. change (S n + p <= m + q). apply plus_le_compat; assumption. Qed. Lemma plus_lt_compat : forall n m p q, n < m -> p < q -> n + p < m + q. @@ -190,8 +190,8 @@ Fixpoint tail_plus n m : nat := end. Lemma plus_tail_plus : forall n m, n + m = tail_plus n m. -induction n as [| n IHn]; simpl in |- *; auto. -intro m; rewrite <- IHn; simpl in |- *; auto. +induction n as [| n IHn]; simpl; auto. +intro m; rewrite <- IHn; simpl; auto. Qed. (** * Discrimination *) diff --git a/theories/Arith/Wf_nat.v b/theories/Arith/Wf_nat.v index b4468dd1..b5545123 100644 --- a/theories/Arith/Wf_nat.v +++ b/theories/Arith/Wf_nat.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -10,7 +10,7 @@ Require Import Lt. -Open Local Scope nat_scope. +Local Open Scope nat_scope. Implicit Types m n p : nat. @@ -24,14 +24,14 @@ Definition gtof (a b:A) := f b > f a. Theorem well_founded_ltof : well_founded ltof. Proof. - red in |- *. + red. 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. + unfold ltof; intros b ltfafb. apply IHn. apply lt_le_trans with (f a); auto with arith. Defined. @@ -73,7 +73,7 @@ Proof. intros; absurd (f a < 0); auto with arith. intros a ltSma. apply F. - unfold ltof in |- *; intros b ltfafb. + unfold ltof; intros b ltfafb. apply IHn. apply lt_le_trans with (f a); auto with arith. Defined. @@ -108,7 +108,7 @@ 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 |- *. + red. cut (forall n (a:A), f a < n -> Acc R a). intros H a; apply (H (S (f a))); auto with arith. induction n. @@ -161,8 +161,8 @@ Lemma lt_wf_double_rec : (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; apply lt_wf_rec. + intros n H q; pattern q; apply lt_wf_rec; auto with arith. Defined. Lemma lt_wf_double_ind : @@ -171,8 +171,8 @@ Lemma lt_wf_double_ind : (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; apply lt_wf_ind. + intros n H q; pattern q; apply lt_wf_ind; auto with arith. Qed. Hint Resolve lt_wf: arith. @@ -190,7 +190,7 @@ Section LT_WF_REL. 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. + pattern n; apply lt_wf_ind; intros. constructor; intros. destruct (F_compat y x) as (x0,H1,H2); trivial. apply (H x0); auto. diff --git a/theories/Bool/Bool.v b/theories/Bool/Bool.v index d5d11cea..a947e4fd 100644 --- a/theories/Bool/Bool.v +++ b/theories/Bool/Bool.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -615,12 +615,12 @@ Proof. Qed. Hint Resolve absurd_eq_true. -(* A specific instance of trans_eq that preserves compatibility with +(* A specific instance of eq_trans that preserves compatibility with old hint bool_2 *) Lemma trans_eq_bool : forall x y z:bool, x = y -> y = z -> x = z. Proof. - apply trans_eq. + apply eq_trans. Qed. Hint Resolve trans_eq_bool. @@ -754,7 +754,7 @@ Notation "a &&& b" := (if a then b else false) Notation "a ||| b" := (if a then true else b) (at level 50, left associativity) : lazy_bool_scope. -Open Local Scope lazy_bool_scope. +Local Open Scope lazy_bool_scope. Lemma andb_lazy_alt : forall a b : bool, a && b = a &&& b. Proof. diff --git a/theories/Bool/BoolEq.v b/theories/Bool/BoolEq.v index d40e56bf..34777491 100644 --- a/theories/Bool/BoolEq.v +++ b/theories/Bool/BoolEq.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -52,12 +52,12 @@ Section Bool_eq_dec. Definition not_eq_false_beq : forall x y:A, x <> y -> false = beq x y. Proof. intros x y H. - symmetry in |- *. + symmetry . apply not_true_is_false. intro. apply H. apply beq_eq. - symmetry in |- *. + symmetry . assumption. Defined. diff --git a/theories/Bool/Bvector.v b/theories/Bool/Bvector.v index 0c218163..d7162e62 100644 --- a/theories/Bool/Bvector.v +++ b/theories/Bool/Bvector.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -13,7 +13,7 @@ Require Vector. Export Vector.VectorNotations. Require Import Minus. -Open Local Scope nat_scope. +Local Open Scope nat_scope. (** We build bit vectors in the spirit of List.v. diff --git a/theories/Bool/DecBool.v b/theories/Bool/DecBool.v index 3f03d2c1..ae01b9da 100644 --- a/theories/Bool/DecBool.v +++ b/theories/Bool/DecBool.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Bool/IfProp.v b/theories/Bool/IfProp.v index 6872eaea..57ffa6a4 100644 --- a/theories/Bool/IfProp.v +++ b/theories/Bool/IfProp.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Bool/Sumbool.v b/theories/Bool/Sumbool.v index 24b6a776..5a9daa94 100644 --- a/theories/Bool/Sumbool.v +++ b/theories/Bool/Sumbool.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Bool/Zerob.v b/theories/Bool/Zerob.v index bac4c0d6..e8798d0d 100644 --- a/theories/Bool/Zerob.v +++ b/theories/Bool/Zerob.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -9,7 +9,7 @@ Require Import Arith. Require Import Bool. -Open Local Scope nat_scope. +Local Open Scope nat_scope. Definition zerob (n:nat) : bool := match n with diff --git a/theories/Classes/EquivDec.v b/theories/Classes/EquivDec.v index 719a9a84..cb1bdb1d 100644 --- a/theories/Classes/EquivDec.v +++ b/theories/Classes/EquivDec.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -49,7 +49,7 @@ Definition swap_sumbool {A B} (x : { A } + { B }) : { B } + { A } := | right H => @left _ _ H end. -Open Local Scope program_scope. +Local Open Scope program_scope. (** Invert the branches. *) diff --git a/theories/Classes/Equivalence.v b/theories/Classes/Equivalence.v index d9e9fe25..e0f5a395 100644 --- a/theories/Classes/Equivalence.v +++ b/theories/Classes/Equivalence.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -26,7 +26,7 @@ Unset Strict Implicit. Generalizable Variables A R eqA B S eqB. Local Obligation Tactic := simpl_relation. -Open Local Scope signature_scope. +Local Open Scope signature_scope. Definition equiv `{Equivalence A R} : relation A := R. @@ -37,7 +37,7 @@ Notation " x === y " := (equiv x y) (at level 70, no associativity) : equiv_scop Notation " x =/= y " := (complement equiv x y) (at level 70, no associativity) : equiv_scope. -Open Local Scope equiv_scope. +Local Open Scope equiv_scope. (** Overloading for [PER]. *) diff --git a/theories/Classes/Init.v b/theories/Classes/Init.v index a001f2e9..06730095 100644 --- a/theories/Classes/Init.v +++ b/theories/Classes/Init.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Classes/Morphisms.v b/theories/Classes/Morphisms.v index 8e491b1b..617ff190 100644 --- a/theories/Classes/Morphisms.v +++ b/theories/Classes/Morphisms.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -73,7 +73,7 @@ End ProperNotations. Export ProperNotations. -Open Local Scope signature_scope. +Local Open Scope signature_scope. (** [solve_proper] try to solve the goal [Proper (?==> ... ==>?) f] by repeated introductions and setoid rewrites. It should work diff --git a/theories/Classes/Morphisms_Prop.v b/theories/Classes/Morphisms_Prop.v index 256bcc37..2252e42f 100644 --- a/theories/Classes/Morphisms_Prop.v +++ b/theories/Classes/Morphisms_Prop.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Classes/Morphisms_Relations.v b/theories/Classes/Morphisms_Relations.v index 7ac49eeb..ea2afb30 100644 --- a/theories/Classes/Morphisms_Relations.v +++ b/theories/Classes/Morphisms_Relations.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Classes/RelationClasses.v b/theories/Classes/RelationClasses.v index cf05d9d4..71647953 100644 --- a/theories/Classes/RelationClasses.v +++ b/theories/Classes/RelationClasses.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -286,7 +286,7 @@ Definition predicate_implication {l : Tlist} := Infix "<∙>" := predicate_equivalence (at level 95, no associativity) : predicate_scope. Infix "-∙>" := predicate_implication (at level 70, right associativity) : predicate_scope. -Open Local Scope predicate_scope. +Local Open Scope predicate_scope. (** The pointwise liftings of conjunction and disjunctions. Note that these are [binary_operation]s, building new relations out of old ones. *) diff --git a/theories/Classes/SetoidClass.v b/theories/Classes/SetoidClass.v index 591671d9..6efc2302 100644 --- a/theories/Classes/SetoidClass.v +++ b/theories/Classes/SetoidClass.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Classes/SetoidDec.v b/theories/Classes/SetoidDec.v index 6708220e..ac1e1dc4 100644 --- a/theories/Classes/SetoidDec.v +++ b/theories/Classes/SetoidDec.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -50,7 +50,7 @@ Definition swap_sumbool {A B} (x : { A } + { B }) : { B } + { A } := Require Import Coq.Program.Program. -Open Local Scope program_scope. +Local Open Scope program_scope. (** Invert the branches. *) diff --git a/theories/Classes/SetoidTactics.v b/theories/Classes/SetoidTactics.v index 31a4f5f2..fa939e22 100644 --- a/theories/Classes/SetoidTactics.v +++ b/theories/Classes/SetoidTactics.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -146,7 +146,7 @@ Tactic Notation "setoid_replace" constr(x) "with" constr(y) Require Import Coq.Program.Tactics. -Open Local Scope signature_scope. +Local Open Scope signature_scope. Ltac red_subst_eq_morphism concl := match concl with diff --git a/theories/FSets/FMapAVL.v b/theories/FSets/FMapAVL.v index c761e2a7..980cfeac 100644 --- a/theories/FSets/FMapAVL.v +++ b/theories/FSets/FMapAVL.v @@ -32,9 +32,9 @@ Notation "s #2" := (snd s) (at level 9, format "s '#2'") : pair_scope. preservation *) Module Raw (Import I:Int)(X: OrderedType). -Open Local Scope pair_scope. -Open Local Scope lazy_bool_scope. -Open Local Scope Int_scope. +Local Open Scope pair_scope. +Local Open Scope lazy_bool_scope. +Local Open Scope Int_scope. Definition key := X.t. Hint Transparent key. @@ -603,12 +603,12 @@ Qed. Lemma lt_leaf : forall x, lt_tree x (Leaf elt). Proof. - unfold lt_tree in |- *; intros; intuition_in. + unfold lt_tree; intros; intuition_in. Qed. Lemma gt_leaf : forall x, gt_tree x (Leaf elt). Proof. - unfold gt_tree in |- *; intros; intuition_in. + unfold gt_tree; intros; intuition_in. Qed. Lemma lt_tree_node : forall x y l r e h, @@ -1388,8 +1388,8 @@ Lemma fold_equiv_aux : L.fold f (elements_aux acc s) a = L.fold f acc (fold f s a). Proof. simple induction s. - simpl in |- *; intuition. - simpl in |- *; intros. + simpl; intuition. + simpl; intros. rewrite H. simpl. apply H0. @@ -1399,11 +1399,11 @@ Lemma fold_equiv : forall (A : Type) (s : t elt) (f : key -> elt -> A -> A) (a : A), fold f s a = fold' f s a. Proof. - unfold fold', elements in |- *. - simple induction s; simpl in |- *; auto; intros. + unfold fold', elements. + simple induction s; simpl; auto; intros. rewrite fold_equiv_aux. rewrite H0. - simpl in |- *; auto. + simpl; auto. Qed. Lemma fold_1 : diff --git a/theories/FSets/FMapFullAVL.v b/theories/FSets/FMapFullAVL.v index 774bcd9b..e1c60351 100644 --- a/theories/FSets/FMapFullAVL.v +++ b/theories/FSets/FMapFullAVL.v @@ -34,8 +34,8 @@ Module AvlProofs (Import I:Int)(X: OrderedType). Module Import Raw := Raw I X. Module Import II:=MoreInt(I). Import Raw.Proofs. -Open Local Scope pair_scope. -Open Local Scope Int_scope. +Local Open Scope pair_scope. +Local Open Scope Int_scope. Ltac omega_max := i2z_refl; romega with Z. diff --git a/theories/FSets/FMapPositive.v b/theories/FSets/FMapPositive.v index 2e2eb166..c59f7c22 100644 --- a/theories/FSets/FMapPositive.v +++ b/theories/FSets/FMapPositive.v @@ -11,7 +11,7 @@ Require Import Bool ZArith OrderedType OrderedTypeEx FMapInterface. Set Implicit Arguments. -Open Local Scope positive_scope. +Local Open Scope positive_scope. Local Unset Elimination Schemes. Local Unset Case Analysis Schemes. diff --git a/theories/FSets/FSetBridge.v b/theories/FSets/FSetBridge.v index 25ce5577..1ac544e1 100644 --- a/theories/FSets/FSetBridge.v +++ b/theories/FSets/FSetBridge.v @@ -44,7 +44,7 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. Definition add : forall (x : elt) (s : t), {s' : t | Add x s s'}. Proof. intros; exists (add x s); auto. - unfold Add in |- *; intuition. + unfold Add; intuition. elim (E.eq_dec x y); auto. intros; right. eapply add_3; eauto. @@ -131,7 +131,7 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}), compat_P E.eq P -> compat_bool E.eq (fdec Pdec). Proof. - unfold compat_P, compat_bool, Proper, respectful, fdec in |- *; intros. + unfold compat_P, compat_bool, Proper, respectful, fdec; intros. generalize (E.eq_sym H0); case (Pdec x); case (Pdec y); firstorder. Qed. @@ -147,11 +147,11 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. intuition. eauto with set. generalize (filter_2 H0 H1). - unfold fdec in |- *. + unfold fdec. case (Pdec x); intuition. inversion H2. apply filter_3; auto. - unfold fdec in |- *; simpl in |- *. + unfold fdec; simpl. case (Pdec x); intuition. Qed. @@ -162,17 +162,17 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. intros. generalize (for_all_1 (s:=s) (f:=fdec Pdec)) (for_all_2 (s:=s) (f:=fdec Pdec)). - case (for_all (fdec Pdec) s); unfold For_all in |- *; [ left | right ]; + case (for_all (fdec Pdec) s); unfold For_all; [ left | right ]; intros. assert (compat_bool E.eq (fdec Pdec)); auto. - generalize (H0 H3 (refl_equal _) _ H2). - unfold fdec in |- *. + generalize (H0 H3 Logic.eq_refl _ H2). + unfold fdec. case (Pdec x); intuition. inversion H4. intuition. absurd (false = true); [ auto with bool | apply H; auto ]. intro. - unfold fdec in |- *. + unfold fdec. case (Pdec x); intuition. Qed. @@ -183,19 +183,19 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. intros. generalize (exists_1 (s:=s) (f:=fdec Pdec)) (exists_2 (s:=s) (f:=fdec Pdec)). - case (exists_ (fdec Pdec) s); unfold Exists in |- *; [ left | right ]; + case (exists_ (fdec Pdec) s); unfold Exists; [ left | right ]; intros. elim H0; auto; intros. exists x; intuition. generalize H4. - unfold fdec in |- *. + unfold fdec. case (Pdec x); intuition. inversion H2. intuition. elim H2; intros. absurd (false = true); [ auto with bool | apply H; auto ]. exists x; intuition. - unfold fdec in |- *. + unfold fdec. case (Pdec x); intuition. Qed. @@ -212,26 +212,26 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. exists (partition (fdec Pdec) s). generalize (partition_1 s (f:=fdec Pdec)) (partition_2 s (f:=fdec Pdec)). case (partition (fdec Pdec) s). - intros s1 s2; simpl in |- *. + intros s1 s2; simpl. intros; assert (compat_bool E.eq (fdec Pdec)); auto. intros; assert (compat_bool E.eq (fun x => negb (fdec Pdec x))). - generalize H2; unfold compat_bool, Proper, respectful in |- *; intuition; + generalize H2; unfold compat_bool, Proper, respectful; intuition; apply (f_equal negb); auto. intuition. - generalize H4; unfold For_all, Equal in |- *; intuition. + generalize H4; unfold For_all, Equal; intuition. elim (H0 x); intros. assert (fdec Pdec x = true). eapply filter_2; eauto with set. - generalize H8; unfold fdec in |- *; case (Pdec x); intuition. + generalize H8; unfold fdec; case (Pdec x); intuition. inversion H9. - generalize H; unfold For_all, Equal in |- *; intuition. + generalize H; unfold For_all, Equal; intuition. elim (H0 x); intros. cut ((fun x => negb (fdec Pdec x)) x = true). - unfold fdec in |- *; case (Pdec x); intuition. - change ((fun x => negb (fdec Pdec x)) x = true) in |- *. + unfold fdec; case (Pdec x); intuition. + change ((fun x => negb (fdec Pdec x)) x = true). apply (filter_2 (s:=s) (x:=x)); auto. - set (b := fdec Pdec x) in *; generalize (refl_equal b); - pattern b at -1 in |- *; case b; unfold b in |- *; + set (b := fdec Pdec x) in *; generalize (Logic.eq_refl b); + pattern b at -1; case b; unfold b; [ left | right ]. elim (H4 x); intros _ B; apply B; auto with set. elim (H x); intros _ B; apply B; auto with set. @@ -308,7 +308,7 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. intros; generalize (min_elt_1 (s:=s)) (min_elt_2 (s:=s)) (min_elt_3 (s:=s)). case (min_elt s); [ left | right ]; auto. - exists e; unfold For_all in |- *; eauto. + exists e; unfold For_all; eauto. Qed. Definition max_elt : @@ -318,7 +318,7 @@ Module DepOfNodep (Import M: S) <: Sdep with Module E := M.E. intros; generalize (max_elt_1 (s:=s)) (max_elt_2 (s:=s)) (max_elt_3 (s:=s)). case (max_elt s); [ left | right ]; auto. - exists e; unfold For_all in |- *; eauto. + exists e; unfold For_all; eauto. Qed. Definition elt := elt. @@ -360,7 +360,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Lemma empty_1 : Empty empty. Proof. - unfold empty in |- *; case M.empty; auto. + unfold empty; case M.empty; auto. Qed. Definition is_empty (s : t) : bool := @@ -368,12 +368,12 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Lemma is_empty_1 : forall s : t, Empty s -> is_empty s = true. Proof. - intros; unfold is_empty in |- *; case (M.is_empty s); auto. + intros; unfold is_empty; case (M.is_empty s); auto. Qed. Lemma is_empty_2 : forall s : t, is_empty s = true -> Empty s. Proof. - intro s; unfold is_empty in |- *; case (M.is_empty s); auto. + intro s; unfold is_empty; case (M.is_empty s); auto. intros; discriminate H. Qed. @@ -382,12 +382,12 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Lemma mem_1 : forall (s : t) (x : elt), In x s -> mem x s = true. Proof. - intros; unfold mem in |- *; case (M.mem x s); auto. + intros; unfold mem; case (M.mem x s); auto. Qed. Lemma mem_2 : forall (s : t) (x : elt), mem x s = true -> In x s. Proof. - intros s x; unfold mem in |- *; case (M.mem x s); auto. + intros s x; unfold mem; case (M.mem x s); auto. intros; discriminate H. Qed. @@ -398,12 +398,12 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Lemma equal_1 : forall s s' : t, Equal s s' -> equal s s' = true. Proof. - intros; unfold equal in |- *; case M.equal; intuition. + intros; unfold equal; case M.equal; intuition. Qed. Lemma equal_2 : forall s s' : t, equal s s' = true -> Equal s s'. Proof. - intros s s'; unfold equal in |- *; case (M.equal s s'); intuition; + intros s s'; unfold equal; case (M.equal s s'); intuition; inversion H. Qed. @@ -412,12 +412,12 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Lemma subset_1 : forall s s' : t, Subset s s' -> subset s s' = true. Proof. - intros; unfold subset in |- *; case M.subset; intuition. + intros; unfold subset; case M.subset; intuition. Qed. Lemma subset_2 : forall s s' : t, subset s s' = true -> Subset s s'. Proof. - intros s s'; unfold subset in |- *; case (M.subset s s'); intuition; + intros s s'; unfold subset; case (M.subset s s'); intuition; inversion H. Qed. @@ -429,14 +429,14 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Lemma choose_1 : forall (s : t) (x : elt), choose s = Some x -> In x s. Proof. - intros s x; unfold choose in |- *; case (M.choose s). + intros s x; unfold choose; case (M.choose s). simple destruct s0; intros; injection H; intros; subst; auto. intros; discriminate H. Qed. Lemma choose_2 : forall s : t, choose s = None -> Empty s. Proof. - intro s; unfold choose in |- *; case (M.choose s); auto. + intro s; unfold choose; case (M.choose s); auto. simple destruct s0; intros; discriminate H. Qed. @@ -453,17 +453,17 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Lemma elements_1 : forall (s : t) (x : elt), In x s -> InA E.eq x (elements s). Proof. - intros; unfold elements in |- *; case (M.elements s); firstorder. + intros; unfold elements; case (M.elements s); firstorder. Qed. Lemma elements_2 : forall (s : t) (x : elt), InA E.eq x (elements s) -> In x s. Proof. - intros s x; unfold elements in |- *; case (M.elements s); firstorder. + intros s x; unfold elements; case (M.elements s); firstorder. Qed. Lemma elements_3 : forall s : t, sort E.lt (elements s). Proof. - intros; unfold elements in |- *; case (M.elements s); firstorder. + intros; unfold elements; case (M.elements s); firstorder. Qed. Hint Resolve elements_3. @@ -478,7 +478,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Lemma min_elt_1 : forall (s : t) (x : elt), min_elt s = Some x -> In x s. Proof. - intros s x; unfold min_elt in |- *; case (M.min_elt s). + intros s x; unfold min_elt; case (M.min_elt s). simple destruct s0; intros; injection H; intros; subst; intuition. intros; discriminate H. Qed. @@ -486,15 +486,15 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Lemma min_elt_2 : forall (s : t) (x y : elt), min_elt s = Some x -> In y s -> ~ E.lt y x. Proof. - intros s x y; unfold min_elt in |- *; case (M.min_elt s). - unfold For_all in |- *; simple destruct s0; intros; injection H; intros; + intros s x y; unfold min_elt; case (M.min_elt s). + unfold For_all; simple destruct s0; intros; injection H; intros; subst; firstorder. intros; discriminate H. Qed. Lemma min_elt_3 : forall s : t, min_elt s = None -> Empty s. Proof. - intros s; unfold min_elt in |- *; case (M.min_elt s); auto. + intros s; unfold min_elt; case (M.min_elt s); auto. simple destruct s0; intros; discriminate H. Qed. @@ -506,7 +506,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Lemma max_elt_1 : forall (s : t) (x : elt), max_elt s = Some x -> In x s. Proof. - intros s x; unfold max_elt in |- *; case (M.max_elt s). + intros s x; unfold max_elt; case (M.max_elt s). simple destruct s0; intros; injection H; intros; subst; intuition. intros; discriminate H. Qed. @@ -514,15 +514,15 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Lemma max_elt_2 : forall (s : t) (x y : elt), max_elt s = Some x -> In y s -> ~ E.lt x y. Proof. - intros s x y; unfold max_elt in |- *; case (M.max_elt s). - unfold For_all in |- *; simple destruct s0; intros; injection H; intros; + intros s x y; unfold max_elt; case (M.max_elt s). + unfold For_all; simple destruct s0; intros; injection H; intros; subst; firstorder. intros; discriminate H. Qed. Lemma max_elt_3 : forall s : t, max_elt s = None -> Empty s. Proof. - intros s; unfold max_elt in |- *; case (M.max_elt s); auto. + intros s; unfold max_elt; case (M.max_elt s); auto. simple destruct s0; intros; discriminate H. Qed. @@ -530,20 +530,20 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Lemma add_1 : forall (s : t) (x y : elt), E.eq x y -> In y (add x s). Proof. - intros; unfold add in |- *; case (M.add x s); unfold Add in |- *; + intros; unfold add; case (M.add x s); unfold Add; firstorder. Qed. Lemma add_2 : forall (s : t) (x y : elt), In y s -> In y (add x s). Proof. - intros; unfold add in |- *; case (M.add x s); unfold Add in |- *; + intros; unfold add; case (M.add x s); unfold Add; firstorder. Qed. Lemma add_3 : forall (s : t) (x y : elt), ~ E.eq x y -> In y (add x s) -> In y s. Proof. - intros s x y; unfold add in |- *; case (M.add x s); unfold Add in |- *; + intros s x y; unfold add; case (M.add x s); unfold Add; firstorder. Qed. @@ -551,30 +551,30 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Lemma remove_1 : forall (s : t) (x y : elt), E.eq x y -> ~ In y (remove x s). Proof. - intros; unfold remove in |- *; case (M.remove x s); firstorder. + intros; unfold remove; case (M.remove x s); firstorder. Qed. Lemma remove_2 : forall (s : t) (x y : elt), ~ E.eq x y -> In y s -> In y (remove x s). Proof. - intros; unfold remove in |- *; case (M.remove x s); firstorder. + intros; unfold remove; case (M.remove x s); firstorder. Qed. Lemma remove_3 : forall (s : t) (x y : elt), In y (remove x s) -> In y s. Proof. - intros s x y; unfold remove in |- *; case (M.remove x s); firstorder. + intros s x y; unfold remove; case (M.remove x s); firstorder. Qed. Definition singleton (x : elt) : t := let (s, _) := singleton x in s. Lemma singleton_1 : forall x y : elt, In y (singleton x) -> E.eq x y. Proof. - intros x y; unfold singleton in |- *; case (M.singleton x); firstorder. + intros x y; unfold singleton; case (M.singleton x); firstorder. Qed. Lemma singleton_2 : forall x y : elt, E.eq x y -> In y (singleton x). Proof. - intros x y; unfold singleton in |- *; case (M.singleton x); firstorder. + intros x y; unfold singleton; case (M.singleton x); firstorder. Qed. Definition union (s s' : t) : t := let (s'', _) := union s s' in s''. @@ -582,60 +582,60 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Lemma union_1 : forall (s s' : t) (x : elt), In x (union s s') -> In x s \/ In x s'. Proof. - intros s s' x; unfold union in |- *; case (M.union s s'); firstorder. + intros s s' x; unfold union; case (M.union s s'); firstorder. Qed. Lemma union_2 : forall (s s' : t) (x : elt), In x s -> In x (union s s'). Proof. - intros s s' x; unfold union in |- *; case (M.union s s'); firstorder. + intros s s' x; unfold union; case (M.union s s'); firstorder. Qed. Lemma union_3 : forall (s s' : t) (x : elt), In x s' -> In x (union s s'). Proof. - intros s s' x; unfold union in |- *; case (M.union s s'); firstorder. + intros s s' x; unfold union; case (M.union s s'); firstorder. Qed. Definition inter (s s' : t) : t := let (s'', _) := inter s s' in s''. Lemma inter_1 : forall (s s' : t) (x : elt), In x (inter s s') -> In x s. Proof. - intros s s' x; unfold inter in |- *; case (M.inter s s'); firstorder. + intros s s' x; unfold inter; case (M.inter s s'); firstorder. Qed. Lemma inter_2 : forall (s s' : t) (x : elt), In x (inter s s') -> In x s'. Proof. - intros s s' x; unfold inter in |- *; case (M.inter s s'); firstorder. + intros s s' x; unfold inter; case (M.inter s s'); firstorder. Qed. Lemma inter_3 : forall (s s' : t) (x : elt), In x s -> In x s' -> In x (inter s s'). Proof. - intros s s' x; unfold inter in |- *; case (M.inter s s'); firstorder. + intros s s' x; unfold inter; case (M.inter s s'); firstorder. Qed. Definition diff (s s' : t) : t := let (s'', _) := diff s s' in s''. Lemma diff_1 : forall (s s' : t) (x : elt), In x (diff s s') -> In x s. Proof. - intros s s' x; unfold diff in |- *; case (M.diff s s'); firstorder. + intros s s' x; unfold diff; case (M.diff s s'); firstorder. Qed. Lemma diff_2 : forall (s s' : t) (x : elt), In x (diff s s') -> ~ In x s'. Proof. - intros s s' x; unfold diff in |- *; case (M.diff s s'); firstorder. + intros s s' x; unfold diff; case (M.diff s s'); firstorder. Qed. Lemma diff_3 : forall (s s' : t) (x : elt), In x s -> ~ In x s' -> In x (diff s s'). Proof. - intros s s' x; unfold diff in |- *; case (M.diff s s'); firstorder. + intros s s' x; unfold diff; case (M.diff s s'); firstorder. Qed. Definition cardinal (s : t) : nat := let (f, _) := cardinal s in f. Lemma cardinal_1 : forall s, cardinal s = length (elements s). Proof. - intros; unfold cardinal in |- *; case (M.cardinal s); unfold elements in *; + intros; unfold cardinal; case (M.cardinal s); unfold elements in *; destruct (M.elements s); auto. Qed. @@ -646,7 +646,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. forall (s : t) (A : Type) (i : A) (f : elt -> A -> A), fold f s i = fold_left (fun a e => f e a) (elements s) i. Proof. - intros; unfold fold in |- *; case (M.fold f s i); unfold elements in *; + intros; unfold fold; case (M.fold f s i); unfold elements in *; destruct (M.elements s); auto. Qed. @@ -673,7 +673,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. forall (s : t) (x : elt) (f : elt -> bool), compat_bool E.eq f -> In x (filter f s) -> In x s. Proof. - intros s x f; unfold filter in |- *; case M.filter; intuition. + intros s x f; unfold filter; case M.filter; intuition. generalize (i (compat_P_aux H)); firstorder. Qed. @@ -681,7 +681,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. forall (s : t) (x : elt) (f : elt -> bool), compat_bool E.eq f -> In x (filter f s) -> f x = true. Proof. - intros s x f; unfold filter in |- *; case M.filter; intuition. + intros s x f; unfold filter; case M.filter; intuition. generalize (i (compat_P_aux H)); firstorder. Qed. @@ -689,7 +689,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. forall (s : t) (x : elt) (f : elt -> bool), compat_bool E.eq f -> In x s -> f x = true -> In x (filter f s). Proof. - intros s x f; unfold filter in |- *; case M.filter; intuition. + intros s x f; unfold filter; case M.filter; intuition. generalize (i (compat_P_aux H)); firstorder. Qed. @@ -703,7 +703,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. compat_bool E.eq f -> For_all (fun x => f x = true) s -> for_all f s = true. Proof. - intros s f; unfold for_all in |- *; case M.for_all; intuition; elim n; + intros s f; unfold for_all; case M.for_all; intuition; elim n; auto. Qed. @@ -712,7 +712,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. compat_bool E.eq f -> for_all f s = true -> For_all (fun x => f x = true) s. Proof. - intros s f; unfold for_all in |- *; case M.for_all; intuition; + intros s f; unfold for_all; case M.for_all; intuition; inversion H0. Qed. @@ -725,7 +725,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. forall (s : t) (f : elt -> bool), compat_bool E.eq f -> Exists (fun x => f x = true) s -> exists_ f s = true. Proof. - intros s f; unfold exists_ in |- *; case M.exists_; intuition; elim n; + intros s f; unfold exists_; case M.exists_; intuition; elim n; auto. Qed. @@ -733,7 +733,7 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. forall (s : t) (f : elt -> bool), compat_bool E.eq f -> exists_ f s = true -> Exists (fun x => f x = true) s. Proof. - intros s f; unfold exists_ in |- *; case M.exists_; intuition; + intros s f; unfold exists_; case M.exists_; intuition; inversion H0. Qed. @@ -745,10 +745,10 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. forall (s : t) (f : elt -> bool), compat_bool E.eq f -> Equal (fst (partition f s)) (filter f s). Proof. - intros s f; unfold partition in |- *; case M.partition. + intros s f; unfold partition; case M.partition. intro p; case p; clear p; intros s1 s2 H C. generalize (H (compat_P_aux C)); clear H; intro H. - simpl in |- *; unfold Equal in |- *; intuition. + simpl; unfold Equal; intuition. apply filter_3; firstorder. elim (H2 a); intros. assert (In a s). @@ -763,13 +763,13 @@ Module NodepOfDep (M: Sdep) <: S with Module E := M.E. forall (s : t) (f : elt -> bool), compat_bool E.eq f -> Equal (snd (partition f s)) (filter (fun x => negb (f x)) s). Proof. - intros s f; unfold partition in |- *; case M.partition. + intros s f; unfold partition; case M.partition. intro p; case p; clear p; intros s1 s2 H C. generalize (H (compat_P_aux C)); clear H; intro H. assert (D : compat_bool E.eq (fun x => negb (f x))). generalize C; unfold compat_bool, Proper, respectful; intros; apply (f_equal negb); auto. - simpl in |- *; unfold Equal in |- *; intuition. + simpl; unfold Equal; intuition. apply filter_3; firstorder. elim (H2 a); intros. assert (In a s). diff --git a/theories/FSets/FSetEqProperties.v b/theories/FSets/FSetEqProperties.v index 755bc7dd..ac495c04 100644 --- a/theories/FSets/FSetEqProperties.v +++ b/theories/FSets/FSetEqProperties.v @@ -206,7 +206,7 @@ intros. generalize (@choose_1 s) (@choose_2 s). destruct (choose s);intros. exists e;auto with set. -generalize (H1 (refl_equal None)); clear H1. +generalize (H1 Logic.eq_refl); clear H1. intros; rewrite (is_empty_1 H1) in H; discriminate. Qed. @@ -631,7 +631,7 @@ destruct (choose (filter f s)). intros H0 _; apply exists_1; auto. exists e; generalize (H0 e); rewrite filter_iff; auto. intros _ H0. -rewrite (is_empty_1 (H0 (refl_equal None))) in H; auto; discriminate. +rewrite (is_empty_1 (H0 Logic.eq_refl)) in H; auto; discriminate. Qed. Lemma partition_filter_1: @@ -881,8 +881,8 @@ generalize (@add_filter_1 f Hf s0 (add x s0) x) (@add_filter_2 f Hf s0 (add x s0 assert (~ In x (filter f s0)). intro H1; rewrite (mem_1 (filter_1 Hf H1)) in H; discriminate H. case (f x); simpl; intros. -rewrite (MP.cardinal_2 H1 (H2 (refl_equal true) (MP.Add_add s0 x))); auto. -rewrite <- (MP.Equal_cardinal (H3 (refl_equal false) (MP.Add_add s0 x))); auto. +rewrite (MP.cardinal_2 H1 (H2 Logic.eq_refl (MP.Add_add s0 x))); auto. +rewrite <- (MP.Equal_cardinal (H3 Logic.eq_refl (MP.Add_add s0 x))); auto. intros; rewrite fold_empty;auto. rewrite MP.cardinal_1; auto. unfold Empty; intros. diff --git a/theories/FSets/FSetFacts.v b/theories/FSets/FSetFacts.v index f473b334..b240ede4 100644 --- a/theories/FSets/FSetFacts.v +++ b/theories/FSets/FSetFacts.v @@ -315,11 +315,11 @@ symmetry. rewrite <- H1; intros a Ha. rewrite <- (H a) in Ha. destruct H0 as (_,H0). -exact (H0 (refl_equal true) _ Ha). +exact (H0 Logic.eq_refl _ Ha). rewrite <- H0; intros a Ha. rewrite (H a) in Ha. destruct H1 as (_,H1). -exact (H1 (refl_equal true) _ Ha). +exact (H1 Logic.eq_refl _ Ha). Qed. Instance Empty_m : Proper (Equal ==> iff) Empty. @@ -489,5 +489,3 @@ End WFacts_fun. Module WFacts (M:WS) := WFacts_fun M.E M. Module Facts := WFacts. - - diff --git a/theories/FSets/FSetProperties.v b/theories/FSets/FSetProperties.v index 1bad8061..d53ce0c8 100644 --- a/theories/FSets/FSetProperties.v +++ b/theories/FSets/FSetProperties.v @@ -823,7 +823,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E). rewrite (inter_subset_equal H). generalize (@cardinal_inv_1 (diff s' s)). destruct (cardinal (diff s' s)). - intro H2; destruct (H2 (refl_equal _) x). + intro H2; destruct (H2 Logic.eq_refl x). set_iff; auto. intros _. change (0 + cardinal s < S n + cardinal s). diff --git a/theories/Init/Datatypes.v b/theories/Init/Datatypes.v index 41f6b70b..fc620f71 100644 --- a/theories/Init/Datatypes.v +++ b/theories/Init/Datatypes.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -72,7 +72,7 @@ Hint Resolve andb_prop: bool. Lemma andb_true_intro : forall b1 b2:bool, b1 = true /\ b2 = true -> andb b1 b2 = true. Proof. - destruct b1; destruct b2; simpl in |- *; tauto || auto with bool. + destruct b1; destruct b2; simpl; intros [? ?]; assumption. Qed. Hint Resolve andb_true_intro: bool. @@ -203,7 +203,7 @@ Lemma injective_projections : 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. + destruct p1; destruct p2; simpl; intros Hfst Hsnd. rewrite Hfst; rewrite Hsnd; reflexivity. Qed. @@ -344,14 +344,14 @@ Definition id : ID := fun A x => x. (* Compatibility *) -Notation prodT := prod (only parsing). -Notation pairT := pair (only parsing). -Notation prodT_rect := prod_rect (only parsing). -Notation prodT_rec := prod_rec (only parsing). -Notation prodT_ind := prod_ind (only parsing). -Notation fstT := fst (only parsing). -Notation sndT := snd (only parsing). -Notation prodT_uncurry := prod_uncurry (only parsing). -Notation prodT_curry := prod_curry (only parsing). +Notation prodT := prod (compat "8.2"). +Notation pairT := pair (compat "8.2"). +Notation prodT_rect := prod_rect (compat "8.2"). +Notation prodT_rec := prod_rec (compat "8.2"). +Notation prodT_ind := prod_ind (compat "8.2"). +Notation fstT := fst (compat "8.2"). +Notation sndT := snd (compat "8.2"). +Notation prodT_uncurry := prod_uncurry (compat "8.2"). +Notation prodT_curry := prod_curry (compat "8.2"). (* end hide *) diff --git a/theories/Init/Logic.v b/theories/Init/Logic.v index 9cd0b31b..4e6df444 100644 --- a/theories/Init/Logic.v +++ b/theories/Init/Logic.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -240,12 +240,12 @@ Section universal_quantification. Theorem inst : forall x:A, all (fun x => P x) -> P x. Proof. - unfold all in |- *; auto. + unfold all; auto. Qed. Theorem gen : forall (B:Prop) (f:forall y:A, B -> P y), B -> all P. Proof. - red in |- *; auto. + red; auto. Qed. End universal_quantification. @@ -284,7 +284,7 @@ Section Logic_lemmas. Theorem absurd : forall A C:Prop, A -> ~ A -> C. Proof. - unfold not in |- *; intros A C h1 h2. + unfold not; intros A C h1 h2. destruct (h2 h1). Qed. @@ -313,7 +313,7 @@ Section Logic_lemmas. Theorem not_eq_sym : x <> y -> y <> x. Proof. - red in |- *; intros h1 h2; apply h1; destruct h2; trivial. + red; intros h1 h2; apply h1; destruct h2; trivial. Qed. End equality. @@ -378,14 +378,14 @@ Qed. (* Aliases *) -Notation sym_eq := eq_sym (only parsing). -Notation trans_eq := eq_trans (only parsing). -Notation sym_not_eq := not_eq_sym (only parsing). +Notation sym_eq := eq_sym (compat "8.3"). +Notation trans_eq := eq_trans (compat "8.3"). +Notation sym_not_eq := not_eq_sym (compat "8.3"). -Notation refl_equal := eq_refl (only parsing). -Notation sym_equal := eq_sym (only parsing). -Notation trans_equal := eq_trans (only parsing). -Notation sym_not_equal := not_eq_sym (only parsing). +Notation refl_equal := eq_refl (compat "8.3"). +Notation sym_equal := eq_sym (compat "8.3"). +Notation trans_equal := eq_trans (compat "8.3"). +Notation sym_not_equal := not_eq_sym (compat "8.3"). Hint Immediate eq_sym not_eq_sym: core. diff --git a/theories/Init/Logic_Type.v b/theories/Init/Logic_Type.v index 2a833576..0281c516 100644 --- a/theories/Init/Logic_Type.v +++ b/theories/Init/Logic_Type.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -44,7 +44,7 @@ Section identity_is_a_congruence. Lemma not_identity_sym : notT (identity x y) -> notT (identity y x). Proof. - red in |- *; intros H H'; apply H; destruct H'; trivial. + red; intros H H'; apply H; destruct H'; trivial. Qed. End identity_is_a_congruence. @@ -66,7 +66,7 @@ Defined. Hint Immediate identity_sym not_identity_sym: core v62. -Notation refl_id := identity_refl (only parsing). -Notation sym_id := identity_sym (only parsing). -Notation trans_id := identity_trans (only parsing). -Notation sym_not_id := not_identity_sym (only parsing). +Notation refl_id := identity_refl (compat "8.3"). +Notation sym_id := identity_sym (compat "8.3"). +Notation trans_id := identity_trans (compat "8.3"). +Notation sym_not_id := not_identity_sym (compat "8.3"). diff --git a/theories/Init/Notations.v b/theories/Init/Notations.v index 490cbf57..323dab90 100644 --- a/theories/Init/Notations.v +++ b/theories/Init/Notations.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Init/Peano.v b/theories/Init/Peano.v index c3716eaa..8c6fba50 100644 --- a/theories/Init/Peano.v +++ b/theories/Init/Peano.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -54,7 +54,7 @@ Hint Immediate eq_add_S: core. Theorem not_eq_S : forall n m:nat, n <> m -> S n <> S m. Proof. - red in |- *; auto. + red; auto. Qed. Hint Resolve not_eq_S: core. @@ -93,7 +93,7 @@ Hint Resolve (f_equal2 (A1:=nat) (A2:=nat)): core. Lemma plus_n_O : forall n:nat, n = n + 0. Proof. - induction n; simpl in |- *; auto. + induction n; simpl; auto. Qed. Hint Resolve plus_n_O: core. @@ -104,7 +104,7 @@ Qed. Lemma plus_n_Sm : forall n m:nat, S (n + m) = n + S m. Proof. - intros n m; induction n; simpl in |- *; auto. + intros n m; induction n; simpl; auto. Qed. Hint Resolve plus_n_Sm: core. @@ -115,8 +115,8 @@ Qed. (** Standard associated names *) -Notation plus_0_r_reverse := plus_n_O (only parsing). -Notation plus_succ_r_reverse := plus_n_Sm (only parsing). +Notation plus_0_r_reverse := plus_n_O (compat "8.2"). +Notation plus_succ_r_reverse := plus_n_Sm (compat "8.2"). (** Multiplication *) @@ -132,22 +132,22 @@ Hint Resolve (f_equal2 mult): core. Lemma mult_n_O : forall n:nat, 0 = n * 0. Proof. - induction n; simpl in |- *; auto. + induction n; simpl; auto. Qed. Hint Resolve mult_n_O: core. Lemma mult_n_Sm : forall n m:nat, n * m + n = n * S m. Proof. - intros; induction n as [| p H]; simpl in |- *; auto. - destruct H; rewrite <- plus_n_Sm; apply (f_equal S). - pattern m at 1 3 in |- *; elim m; simpl in |- *; auto. + intros; induction n as [| p H]; simpl; auto. + destruct H; rewrite <- plus_n_Sm; apply eq_S. + pattern m at 1 3; elim m; simpl; auto. Qed. Hint Resolve mult_n_Sm: core. (** Standard associated names *) -Notation mult_0_r_reverse := mult_n_O (only parsing). -Notation mult_succ_r_reverse := mult_n_Sm (only parsing). +Notation mult_0_r_reverse := mult_n_O (compat "8.2"). +Notation mult_succ_r_reverse := mult_n_Sm (compat "8.2"). (** Truncated subtraction: [m-n] is [0] if [n>=m] *) @@ -219,7 +219,7 @@ Theorem nat_double_ind : (forall n m:nat, R n m -> R (S n) (S m)) -> forall n m:nat, R n m. Proof. induction n; auto. - destruct m as [| n0]; auto. + destruct m; auto. Qed. (** Maximum and minimum : definitions and specifications *) diff --git a/theories/Init/Prelude.v b/theories/Init/Prelude.v index d85f5363..e723cadf 100644 --- a/theories/Init/Prelude.v +++ b/theories/Init/Prelude.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Init/Specif.v b/theories/Init/Specif.v index 5b7afc99..d1610f0a 100644 --- a/theories/Init/Specif.v +++ b/theories/Init/Specif.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -226,16 +226,16 @@ Hint Resolve exist exist2 existT existT2: core. (* Compatibility *) -Notation sigS := sigT (only parsing). -Notation existS := existT (only parsing). -Notation sigS_rect := sigT_rect (only parsing). -Notation sigS_rec := sigT_rec (only parsing). -Notation sigS_ind := sigT_ind (only parsing). -Notation projS1 := projT1 (only parsing). -Notation projS2 := projT2 (only parsing). - -Notation sigS2 := sigT2 (only parsing). -Notation existS2 := existT2 (only parsing). -Notation sigS2_rect := sigT2_rect (only parsing). -Notation sigS2_rec := sigT2_rec (only parsing). -Notation sigS2_ind := sigT2_ind (only parsing). +Notation sigS := sigT (compat "8.2"). +Notation existS := existT (compat "8.2"). +Notation sigS_rect := sigT_rect (compat "8.2"). +Notation sigS_rec := sigT_rec (compat "8.2"). +Notation sigS_ind := sigT_ind (compat "8.2"). +Notation projS1 := projT1 (compat "8.2"). +Notation projS2 := projT2 (compat "8.2"). + +Notation sigS2 := sigT2 (compat "8.2"). +Notation existS2 := existT2 (compat "8.2"). +Notation sigS2_rect := sigT2_rect (compat "8.2"). +Notation sigS2_rec := sigT2_rec (compat "8.2"). +Notation sigS2_ind := sigT2_ind (compat "8.2"). diff --git a/theories/Init/Tactics.v b/theories/Init/Tactics.v index 4d64b823..23d9d10e 100644 --- a/theories/Init/Tactics.v +++ b/theories/Init/Tactics.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -75,7 +75,7 @@ Ltac false_hyp H G := (* A case with no loss of information. *) -Ltac case_eq x := generalize (refl_equal x); pattern x at -1; case x. +Ltac case_eq x := generalize (eq_refl x); pattern x at -1; case x. (* use either discriminate or injection on a hypothesis *) @@ -84,13 +84,13 @@ Ltac destr_eq H := discriminate H || (try (injection H; clear H; intro H)). (* Similar variants of destruct *) Tactic Notation "destruct_with_eqn" constr(x) := - destruct x as []_eqn. + destruct x eqn:?. Tactic Notation "destruct_with_eqn" ident(n) := - try intros until n; destruct n as []_eqn. + try intros until n; destruct n eqn:?. Tactic Notation "destruct_with_eqn" ":" ident(H) constr(x) := - destruct x as []_eqn:H. + destruct x eqn:H. Tactic Notation "destruct_with_eqn" ":" ident(H) ident(n) := - try intros until n; destruct n as []_eqn:H. + try intros until n; destruct n eqn:H. (** Break every hypothesis of a certain type *) diff --git a/theories/Init/Wf.v b/theories/Init/Wf.v index 2bb7eae9..c9fcb570 100644 --- a/theories/Init/Wf.v +++ b/theories/Init/Wf.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -103,7 +103,7 @@ Section Well_founded. Lemma Fix_eq : forall x:A, Fix x = F (fun (y:A) (p:R y x) => Fix y). Proof. - intro x; unfold Fix in |- *. + intro x; unfold Fix. rewrite <- Fix_F_eq. apply F_ext; intros. apply Fix_F_inv. diff --git a/theories/Lists/List.v b/theories/Lists/List.v index ecadddbc..69475a6f 100644 --- a/theories/Lists/List.v +++ b/theories/Lists/List.v @@ -1,12 +1,12 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -Require Import Le Gt Minus Bool. +Require Import Le Gt Minus Bool Setoid. Set Implicit Arguments. @@ -546,30 +546,21 @@ Section Elts. end. (** Compatibility of count_occ with operations on list *) - Theorem count_occ_In : forall (l : list A) (x : A), In x l <-> count_occ l x > 0. + Theorem count_occ_In (l : list A) (x : A) : In x l <-> count_occ l x > 0. Proof. - induction l as [|y l]. - simpl; intros; split; [destruct 1 | apply gt_irrefl]. - simpl. intro x; destruct (eq_dec y x) as [Heq|Hneq]. - rewrite Heq; intuition. - pose (IHl x). intuition. + induction l as [|y l]; simpl. + - split; [destruct 1 | apply gt_irrefl]. + - destruct eq_dec as [->|Hneq]; rewrite IHl; intuition. Qed. - Theorem count_occ_inv_nil : forall (l : list A), (forall x:A, count_occ l x = 0) <-> l = []. + Theorem count_occ_inv_nil (l : list A) : + (forall x:A, count_occ l x = 0) <-> l = []. Proof. split. - (* Case -> *) - induction l as [|x l]. - trivial. - intro H. - elim (O_S (count_occ l x)). - apply sym_eq. - generalize (H x). - simpl. destruct (eq_dec x x) as [|HF]. - trivial. - elim HF; reflexivity. - (* Case <- *) - intro H; rewrite H; simpl; reflexivity. + - induction l as [|x l]; trivial. + intros H. specialize (H x). simpl in H. + destruct eq_dec as [_|NEQ]; [discriminate|now elim NEQ]. + - now intros ->. Qed. Lemma count_occ_nil : forall (x : A), count_occ [] x = 0. @@ -754,22 +745,11 @@ Section ListOps. Hypothesis eq_dec : forall (x y : A), {x = y}+{x <> y}. - Lemma list_eq_dec : - forall l l':list A, {l = l'} + {l <> l'}. - Proof. - induction l as [| x l IHl]; destruct l' as [| y l']. - left; trivial. - right; apply nil_cons. - right; unfold not; intro HF; apply (nil_cons (sym_eq HF)). - destruct (eq_dec x y) as [xeqy|xneqy]; destruct (IHl l') as [leql'|lneql']; - try (right; unfold not; intro HF; injection HF; intros; contradiction). - rewrite xeqy; rewrite leql'; left; trivial. - Qed. - + Lemma list_eq_dec : forall l l':list A, {l = l'} + {l <> l'}. + Proof. decide equality. Defined. End ListOps. - (***************************************************) (** * Applying functions to the elements of a list *) (***************************************************) diff --git a/theories/Lists/ListSet.v b/theories/Lists/ListSet.v index d67baf57..b846c48d 100644 --- a/theories/Lists/ListSet.v +++ b/theories/Lists/ListSet.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -85,15 +85,15 @@ Section first_definitions. Lemma set_In_dec : forall (a:A) (x:set), {set_In a x} + {~ set_In a x}. Proof. - unfold set_In in |- *. + unfold set_In. (*** Realizer set_mem. Program_all. ***) simple induction x. auto. intros a0 x0 Ha0. case (Aeq_dec a a0); intro eq. - rewrite eq; simpl in |- *; auto with datatypes. + rewrite eq; simpl; auto with datatypes. elim Ha0. auto with datatypes. - right; simpl in |- *; unfold not in |- *; intros [Hc1| Hc2]; + right; simpl; unfold not; intros [Hc1| Hc2]; auto with datatypes. Qed. @@ -102,7 +102,7 @@ Section first_definitions. (set_In a x -> P y) -> P z -> P (if set_mem a x then y else z). Proof. - simple induction x; simpl in |- *; intros. + simple induction x; simpl; intros. assumption. elim (Aeq_dec a a0); auto with datatypes. Qed. @@ -113,11 +113,11 @@ Section first_definitions. (~ set_In a x -> P z) -> P (if set_mem a x then y else z). Proof. - simple induction x; simpl in |- *; intros. - apply H0; red in |- *; trivial. + simple induction x; simpl; intros. + apply H0; red; trivial. case (Aeq_dec a a0); auto with datatypes. intro; apply H; intros; auto. - apply H1; red in |- *; intro. + apply H1; red; intro. case H3; auto. Qed. @@ -125,7 +125,7 @@ Section first_definitions. Lemma set_mem_correct1 : forall (a:A) (x:set), set_mem a x = true -> set_In a x. Proof. - simple induction x; simpl in |- *. + simple induction x; simpl. discriminate. intros a0 l; elim (Aeq_dec a a0); auto with datatypes. Qed. @@ -133,7 +133,7 @@ Section first_definitions. Lemma set_mem_correct2 : forall (a:A) (x:set), set_In a x -> set_mem a x = true. Proof. - simple induction x; simpl in |- *. + simple induction x; simpl. intro Ha; elim Ha. intros a0 l; elim (Aeq_dec a a0); auto with datatypes. intros H1 H2 [H3| H4]. @@ -144,17 +144,17 @@ Section first_definitions. Lemma set_mem_complete1 : forall (a:A) (x:set), set_mem a x = false -> ~ set_In a x. Proof. - simple induction x; simpl in |- *. + simple induction x; simpl. tauto. intros a0 l; elim (Aeq_dec a a0). intros; discriminate H0. - unfold not in |- *; intros; elim H1; auto with datatypes. + unfold not; intros; elim H1; auto with datatypes. Qed. Lemma set_mem_complete2 : forall (a:A) (x:set), ~ set_In a x -> set_mem a x = false. Proof. - simple induction x; simpl in |- *. + simple induction x; simpl. tauto. intros a0 l; elim (Aeq_dec a a0). intros; elim H0; auto with datatypes. @@ -165,7 +165,7 @@ Section first_definitions. forall (a b:A) (x:set), set_In a x -> set_In a (set_add b x). Proof. - unfold set_In in |- *; simple induction x; simpl in |- *. + unfold set_In; simple induction x; simpl. auto with datatypes. intros a0 l H [Ha0a| Hal]. elim (Aeq_dec b a0); left; assumption. @@ -176,11 +176,11 @@ Section first_definitions. forall (a b:A) (x:set), a = b -> set_In a (set_add b x). Proof. - unfold set_In in |- *; simple induction x; simpl in |- *. + unfold set_In; simple induction x; simpl. auto with datatypes. intros a0 l H Hab. elim (Aeq_dec b a0); - [ rewrite Hab; intro Hba0; rewrite Hba0; simpl in |- *; + [ rewrite Hab; intro Hba0; rewrite Hba0; simpl; auto with datatypes | auto with datatypes ]. Qed. @@ -198,13 +198,13 @@ Section first_definitions. forall (a b:A) (x:set), set_In a (set_add b x) -> a = b \/ set_In a x. Proof. - unfold set_In in |- *. + unfold set_In. simple induction x. - simpl in |- *; intros [H1| H2]; auto with datatypes. - simpl in |- *; do 3 intro. + simpl; intros [H1| H2]; auto with datatypes. + simpl; do 3 intro. elim (Aeq_dec b a0). - simpl in |- *; tauto. - simpl in |- *; intros; elim H0. + simpl; tauto. + simpl; intros; elim H0. trivial with datatypes. tauto. tauto. @@ -220,7 +220,7 @@ Section first_definitions. Lemma set_add_not_empty : forall (a:A) (x:set), set_add a x <> empty_set. Proof. - simple induction x; simpl in |- *. + simple induction x; simpl. discriminate. intros; elim (Aeq_dec a a0); intros; discriminate. Qed. @@ -229,13 +229,13 @@ Section first_definitions. Lemma set_union_intro1 : forall (a:A) (x y:set), set_In a x -> set_In a (set_union x y). Proof. - simple induction y; simpl in |- *; auto with datatypes. + simple induction y; simpl; auto with datatypes. Qed. Lemma set_union_intro2 : forall (a:A) (x y:set), set_In a y -> set_In a (set_union x y). Proof. - simple induction y; simpl in |- *. + simple induction y; simpl. tauto. intros; elim H0; auto with datatypes. Qed. @@ -253,7 +253,7 @@ Section first_definitions. forall (a:A) (x y:set), set_In a (set_union x y) -> set_In a x \/ set_In a y. Proof. - simple induction y; simpl in |- *. + simple induction y; simpl. auto with datatypes. intros. generalize (set_add_elim _ _ _ H0). @@ -280,11 +280,11 @@ Section first_definitions. Proof. simple induction x. auto with datatypes. - simpl in |- *; intros a0 l Hrec y [Ha0a| Hal] Hy. - simpl in |- *; rewrite Ha0a. + simpl; intros a0 l Hrec y [Ha0a| Hal] Hy. + simpl; rewrite Ha0a. generalize (set_mem_correct1 a y). generalize (set_mem_complete1 a y). - elim (set_mem a y); simpl in |- *; intros. + elim (set_mem a y); simpl; intros. auto with datatypes. absurd (set_In a y); auto with datatypes. elim (set_mem a0 y); [ right; auto with datatypes | auto with datatypes ]. @@ -295,9 +295,9 @@ Section first_definitions. Proof. simple induction x. auto with datatypes. - simpl in |- *; intros a0 l Hrec y. + simpl; intros a0 l Hrec y. generalize (set_mem_correct1 a0 y). - elim (set_mem a0 y); simpl in |- *; intros. + elim (set_mem a0 y); simpl; intros. elim H0; eauto with datatypes. eauto with datatypes. Qed. @@ -306,10 +306,10 @@ Section first_definitions. forall (a:A) (x y:set), set_In a (set_inter x y) -> set_In a y. Proof. simple induction x. - simpl in |- *; tauto. - simpl in |- *; intros a0 l Hrec y. + simpl; tauto. + simpl; intros a0 l Hrec y. generalize (set_mem_correct1 a0 y). - elim (set_mem a0 y); simpl in |- *; intros. + elim (set_mem a0 y); simpl; intros. elim H0; [ intro Hr; rewrite <- Hr; eauto with datatypes | eauto with datatypes ]. eauto with datatypes. @@ -329,8 +329,8 @@ Section first_definitions. set_In a x -> ~ set_In a y -> set_In a (set_diff x y). Proof. simple induction x. - simpl in |- *; tauto. - simpl in |- *; intros a0 l Hrec y [Ha0a| Hal] Hay. + simpl; tauto. + simpl; intros a0 l Hrec y [Ha0a| Hal] Hay. rewrite Ha0a; generalize (set_mem_complete2 _ _ Hay). elim (set_mem a y); [ intro Habs; discriminate Habs | auto with datatypes ]. @@ -341,8 +341,8 @@ Section first_definitions. forall (a:A) (x y:set), set_In a (set_diff x y) -> set_In a x. Proof. simple induction x. - simpl in |- *; tauto. - simpl in |- *; intros a0 l Hrec y; elim (set_mem a0 y). + simpl; tauto. + simpl; intros a0 l Hrec y; elim (set_mem a0 y). eauto with datatypes. intro; generalize (set_add_elim _ _ _ H). intros [H1| H2]; eauto with datatypes. @@ -350,7 +350,7 @@ Section first_definitions. Lemma set_diff_elim2 : forall (a:A) (x y:set), set_In a (set_diff x y) -> ~ set_In a y. - intros a x y; elim x; simpl in |- *. + intros a x y; elim x; simpl. intros; contradiction. intros a0 l Hrec. apply set_mem_ind2; auto. @@ -359,7 +359,7 @@ Section first_definitions. Qed. Lemma set_diff_trivial : forall (a:A) (x:set), ~ set_In a (set_diff x x). - red in |- *; intros a x H. + red; intros a x H. apply (set_diff_elim2 _ _ _ H). apply (set_diff_elim1 _ _ _ H). Qed. diff --git a/theories/Lists/ListTactics.v b/theories/Lists/ListTactics.v index 3343aa6f..74336555 100644 --- a/theories/Lists/ListTactics.v +++ b/theories/Lists/ListTactics.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -60,7 +60,7 @@ Ltac Find_at a l := match l with | nil => fail 100 "anomaly: Find_at" | a :: _ => eval compute in n - | _ :: ?l => find (Psucc n) l + | _ :: ?l => find (Pos.succ n) l end in find 1%positive l. diff --git a/theories/Lists/SetoidList.v b/theories/Lists/SetoidList.v index 97915055..0fd1693e 100644 --- a/theories/Lists/SetoidList.v +++ b/theories/Lists/SetoidList.v @@ -7,7 +7,7 @@ (***********************************************************************) Require Export List. -Require Export Sorting. +Require Export Sorted. Require Export Setoid Basics Morphisms. Set Implicit Arguments. Unset Strict Implicit. @@ -199,7 +199,29 @@ Proof. rewrite <- In_rev; auto. Qed. +(** Some more facts about InA *) +Lemma InA_singleton x y : InA x (y::nil) <-> eqA x y. +Proof. + rewrite InA_cons, InA_nil; tauto. +Qed. + +Lemma InA_double_head x y l : + InA x (y :: y :: l) <-> InA x (y :: l). +Proof. + rewrite !InA_cons; tauto. +Qed. + +Lemma InA_permute_heads x y z l : + InA x (y :: z :: l) <-> InA x (z :: y :: l). +Proof. + rewrite !InA_cons; tauto. +Qed. + +Lemma InA_app_idem x l : InA x (l ++ l) <-> InA x l. +Proof. + rewrite InA_app_iff; tauto. +Qed. Section NoDupA. @@ -270,7 +292,56 @@ Proof. eapply NoDupA_split; eauto. Qed. -Lemma equivlistA_NoDupA_split : forall l l1 l2 x y, eqA x y -> +Lemma NoDupA_singleton x : NoDupA (x::nil). +Proof. + repeat constructor. inversion 1. +Qed. + +End NoDupA. + +Section EquivlistA. + +Global Instance equivlistA_cons_proper: + Proper (eqA ==> equivlistA ==> equivlistA) (@cons A). +Proof. + intros ? ? E1 ? ? E2 ?; now rewrite !InA_cons, E1, E2. +Qed. + +Global Instance equivlistA_app_proper: + Proper (equivlistA ==> equivlistA ==> equivlistA) (@app A). +Proof. + intros ? ? E1 ? ? E2 ?. now rewrite !InA_app_iff, E1, E2. +Qed. + +Lemma equivlistA_cons_nil x l : ~ equivlistA (x :: l) nil. +Proof. + intros E. now eapply InA_nil, E, InA_cons_hd. +Qed. + +Lemma equivlistA_nil_eq l : equivlistA l nil -> l = nil. +Proof. + destruct l. + - trivial. + - intros H. now apply equivlistA_cons_nil in H. +Qed. + +Lemma equivlistA_double_head x l : equivlistA (x :: x :: l) (x :: l). +Proof. + intro. apply InA_double_head. +Qed. + +Lemma equivlistA_permute_heads x y l : + equivlistA (x :: y :: l) (y :: x :: l). +Proof. + intro. apply InA_permute_heads. +Qed. + +Lemma equivlistA_app_idem l : equivlistA (l ++ l) l. +Proof. + intro. apply InA_app_idem. +Qed. + +Lemma equivlistA_NoDupA_split l l1 l2 x y : eqA x y -> NoDupA (x::l) -> NoDupA (l1++y::l2) -> equivlistA (x::l) (l1++y::l2) -> equivlistA l (l1++l2). Proof. @@ -290,9 +361,7 @@ Proof. rewrite <-H,<-EQN; auto. Qed. -End NoDupA. - - +End EquivlistA. Section Fold. @@ -588,10 +657,9 @@ Proof. Qed. (** For compatibility, can be deduced from [InfA_compat] *) -Lemma InfA_eqA : - forall l x y, eqA x y -> InfA y l -> InfA x l. +Lemma InfA_eqA l x y : eqA x y -> InfA y l -> InfA x l. Proof. - intros l x y H; rewrite H; auto. + intros H; now rewrite H. Qed. Hint Immediate InfA_ltA InfA_eqA. @@ -785,9 +853,11 @@ Qed. End Filter. End Type_with_equality. - Hint Constructors InA eqlistA NoDupA sort lelistA. +Arguments equivlistA_cons_nil {A} eqA {eqA_equiv} x l _. +Arguments equivlistA_nil_eq {A} eqA {eqA_equiv} l _. + Section Find. Variable A B : Type. @@ -838,7 +908,6 @@ Qed. End Find. - (** Compatibility aliases. [Proper] is rather to be used directly now.*) Definition compat_bool {A} (eqA:A->A->Prop)(f:A->bool) := @@ -852,4 +921,3 @@ Definition compat_P {A} (eqA:A->A->Prop)(P:A->Prop) := Definition compat_op {A B} (eqA:A->A->Prop)(eqB:B->B->Prop)(f:A->B->B) := Proper (eqA==>eqB==>eqB) f. - diff --git a/theories/Lists/SetoidPermutation.v b/theories/Lists/SetoidPermutation.v new file mode 100644 index 00000000..b0657b63 --- /dev/null +++ b/theories/Lists/SetoidPermutation.v @@ -0,0 +1,125 @@ +(***********************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *) +(* \VV/ *************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(***********************************************************************) + +Require Import SetoidList. + +Set Implicit Arguments. +Unset Strict Implicit. + +(** Permutations of list modulo a setoid equality. *) + +(** Contribution by Robbert Krebbers (Nijmegen University). *) + +Section Permutation. +Context {A : Type} (eqA : relation A) (e : Equivalence eqA). + +Inductive PermutationA : list A -> list A -> Prop := + | permA_nil: PermutationA nil nil + | permA_skip x₁ x₂ l₁ l₂ : + eqA x₁ x₂ -> PermutationA l₁ l₂ -> PermutationA (x₁ :: l₁) (x₂ :: l₂) + | permA_swap x y l : PermutationA (y :: x :: l) (x :: y :: l) + | permA_trans l₁ l₂ l₃ : + PermutationA l₁ l₂ -> PermutationA l₂ l₃ -> PermutationA l₁ l₃. +Local Hint Constructors PermutationA. + +Global Instance: Equivalence PermutationA. +Proof. + constructor. + - intro l. induction l; intuition. + - intros l₁ l₂. induction 1; eauto. apply permA_skip; intuition. + - exact permA_trans. +Qed. + +Global Instance PermutationA_cons : + Proper (eqA ==> PermutationA ==> PermutationA) (@cons A). +Proof. + repeat intro. now apply permA_skip. +Qed. + +Lemma PermutationA_app_head l₁ l₂ l : + PermutationA l₁ l₂ -> PermutationA (l ++ l₁) (l ++ l₂). +Proof. + induction l; trivial; intros. apply permA_skip; intuition. +Qed. + +Global Instance PermutationA_app : + Proper (PermutationA ==> PermutationA ==> PermutationA) (@app A). +Proof. + intros l₁ l₂ Pl k₁ k₂ Pk. + induction Pl. + - easy. + - now apply permA_skip. + - etransitivity. + * rewrite <-!app_comm_cons. now apply permA_swap. + * rewrite !app_comm_cons. now apply PermutationA_app_head. + - do 2 (etransitivity; try eassumption). + apply PermutationA_app_head. now symmetry. +Qed. + +Lemma PermutationA_app_tail l₁ l₂ l : + PermutationA l₁ l₂ -> PermutationA (l₁ ++ l) (l₂ ++ l). +Proof. + intros E. now rewrite E. +Qed. + +Lemma PermutationA_cons_append l x : + PermutationA (x :: l) (l ++ x :: nil). +Proof. + induction l. + - easy. + - simpl. rewrite <-IHl. intuition. +Qed. + +Lemma PermutationA_app_comm l₁ l₂ : + PermutationA (l₁ ++ l₂) (l₂ ++ l₁). +Proof. + induction l₁. + - now rewrite app_nil_r. + - rewrite <-app_comm_cons, IHl₁, app_comm_cons. + now rewrite PermutationA_cons_append, <-app_assoc. +Qed. + +Lemma PermutationA_cons_app l l₁ l₂ x : + PermutationA l (l₁ ++ l₂) -> PermutationA (x :: l) (l₁ ++ x :: l₂). +Proof. + intros E. rewrite E. + now rewrite app_comm_cons, PermutationA_cons_append, <-app_assoc. +Qed. + +Lemma PermutationA_middle l₁ l₂ x : + PermutationA (x :: l₁ ++ l₂) (l₁ ++ x :: l₂). +Proof. + now apply PermutationA_cons_app. +Qed. + +Lemma PermutationA_equivlistA l₁ l₂ : + PermutationA l₁ l₂ -> equivlistA eqA l₁ l₂. +Proof. + induction 1. + - reflexivity. + - now apply equivlistA_cons_proper. + - now apply equivlistA_permute_heads. + - etransitivity; eassumption. +Qed. + +Lemma NoDupA_equivlistA_PermutationA l₁ l₂ : + NoDupA eqA l₁ -> NoDupA eqA l₂ -> + equivlistA eqA l₁ l₂ -> PermutationA l₁ l₂. +Proof. + intros Pl₁. revert l₂. induction Pl₁ as [|x l₁ E1]. + - intros l₂ _ H₂. symmetry in H₂. now rewrite (equivlistA_nil_eq eqA). + - intros l₂ Pl₂ E2. + destruct (@InA_split _ eqA l₂ x) as [l₂h [y [l₂t [E3 ?]]]]. + { rewrite <-E2. intuition. } + subst. transitivity (y :: l₁); [intuition |]. + apply PermutationA_cons_app, IHPl₁. + now apply NoDupA_split with y. + apply equivlistA_NoDupA_split with x y; intuition. +Qed. + +End Permutation. diff --git a/theories/Lists/StreamMemo.v b/theories/Lists/StreamMemo.v index 45490c62..67882cde 100644 --- a/theories/Lists/StreamMemo.v +++ b/theories/Lists/StreamMemo.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -32,10 +32,10 @@ Fixpoint memo_get (n:nat) (l:Stream A) : A := Theorem memo_get_correct: forall n, memo_get n memo_list = f n. Proof. assert (F1: forall n m, memo_get n (memo_make m) = f (n + m)). - induction n as [| n Hrec]; try (intros m; refine (refl_equal _)). +{ induction n as [| n Hrec]; try (intros m; reflexivity). intros m; simpl; rewrite Hrec. - rewrite plus_n_Sm; auto. -intros n; apply trans_equal with (f (n + 0)); try exact (F1 n 0). + rewrite plus_n_Sm; auto. } +intros n; transitivity (f (n + 0)); try exact (F1 n 0). rewrite <- plus_n_O; auto. Qed. @@ -57,11 +57,10 @@ Definition imemo_list := let f0 := f 0 in Theorem imemo_get_correct: forall n, memo_get n imemo_list = f n. Proof. -assert (F1: forall n m, - memo_get n (imemo_make (f m)) = f (S (n + m))). - induction n as [| n Hrec]; try (intros m; exact (sym_equal (Hg_correct m))). - simpl; intros m; rewrite <- Hg_correct; rewrite Hrec; rewrite <- plus_n_Sm; auto. -destruct n as [| n]; try apply refl_equal. +assert (F1: forall n m, memo_get n (imemo_make (f m)) = f (S (n + m))). +{ induction n as [| n Hrec]; try (intros m; exact (eq_sym (Hg_correct m))). + simpl; intros m; rewrite <- Hg_correct, Hrec, <- plus_n_Sm; auto. } +destruct n as [| n]; try reflexivity. unfold imemo_list; simpl; rewrite F1. rewrite <- plus_n_O; auto. Qed. @@ -82,7 +81,7 @@ Inductive memo_val: Type := Fixpoint is_eq (n m : nat) : {n = m} + {True} := match n, m return {n = m} + {True} with - | 0, 0 =>left True (refl_equal 0) + | 0, 0 =>left True (eq_refl 0) | 0, S m1 => right (0 = S m1) I | S n1, 0 => right (S n1 = 0) I | S n1, S m1 => @@ -98,7 +97,7 @@ match v with match is_eq n m with | left H => match H in (eq _ y) return (A y -> A n) with - | refl_equal => fun v1 : A n => v1 + | eq_refl => fun v1 : A n => v1 end | right _ => fun _ : A m => f n end x @@ -115,7 +114,7 @@ Proof. intros n; unfold dmemo_get, dmemo_list. rewrite (memo_get_correct memo_val mf n); simpl. case (is_eq n n); simpl; auto; intros e. -assert (e = refl_equal n). +assert (e = eq_refl n). apply eq_proofs_unicity. induction x as [| x Hx]; destruct y as [| y]. left; auto. @@ -144,7 +143,7 @@ Proof. intros n; unfold dmemo_get, dimemo_list. rewrite (imemo_get_correct memo_val mf mg); simpl. case (is_eq n n); simpl; auto; intros e. -assert (e = refl_equal n). +assert (e = eq_refl n). apply eq_proofs_unicity. induction x as [| x Hx]; destruct y as [| y]. left; auto. @@ -169,11 +168,11 @@ Open Scope Z_scope. Fixpoint tfact (n: nat) := match n with | O => 1 - | S n1 => Z_of_nat n * tfact n1 + | S n1 => Z.of_nat n * tfact n1 end. Definition lfact_list := - dimemo_list _ tfact (fun n z => (Z_of_nat (S n) * z)). + dimemo_list _ tfact (fun n z => (Z.of_nat (S n) * z)). Definition lfact n := dmemo_get _ tfact n lfact_list. diff --git a/theories/Lists/Streams.v b/theories/Lists/Streams.v index 7a6f38fc..e1122cf9 100644 --- a/theories/Lists/Streams.v +++ b/theories/Lists/Streams.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -49,21 +49,21 @@ Qed. Lemma tl_nth_tl : forall (n:nat) (s:Stream), tl (Str_nth_tl n s) = Str_nth_tl n (tl s). Proof. - simple induction n; simpl in |- *; auto. + simple induction n; simpl; auto. Qed. Hint Resolve tl_nth_tl: datatypes v62. Lemma Str_nth_tl_plus : forall (n m:nat) (s:Stream), Str_nth_tl n (Str_nth_tl m s) = Str_nth_tl (n + m) s. -simple induction n; simpl in |- *; intros; auto with datatypes. +simple induction n; simpl; intros; auto with datatypes. rewrite <- H. rewrite tl_nth_tl; trivial with datatypes. Qed. Lemma Str_nth_plus : forall (n m:nat) (s:Stream), Str_nth n (Str_nth_tl m s) = Str_nth (n + m) s. -intros; unfold Str_nth in |- *; rewrite Str_nth_tl_plus; +intros; unfold Str_nth; rewrite Str_nth_tl_plus; trivial with datatypes. Qed. @@ -89,7 +89,7 @@ Qed. Theorem sym_EqSt : forall s1 s2:Stream, EqSt s1 s2 -> EqSt s2 s1. coinduction Eq_sym. -case H; intros; symmetry in |- *; assumption. +case H; intros; symmetry ; assumption. case H; intros; assumption. Qed. @@ -110,10 +110,10 @@ Qed. Theorem eqst_ntheq : forall (n:nat) (s1 s2:Stream), EqSt s1 s2 -> Str_nth n s1 = Str_nth n s2. -unfold Str_nth in |- *; simple induction n. +unfold Str_nth; simple induction n. intros s1 s2 H; case H; trivial with datatypes. intros m hypind. -simpl in |- *. +simpl. intros s1 s2 H. apply hypind. case H; trivial with datatypes. diff --git a/theories/Lists/vo.itarget b/theories/Lists/vo.itarget index adcfba49..04994f59 100644 --- a/theories/Lists/vo.itarget +++ b/theories/Lists/vo.itarget @@ -2,5 +2,6 @@ ListSet.vo ListTactics.vo List.vo SetoidList.vo +SetoidPermutation.vo StreamMemo.vo Streams.vo diff --git a/theories/Logic/Berardi.v b/theories/Logic/Berardi.v index 2b388687..38377573 100644 --- a/theories/Logic/Berardi.v +++ b/theories/Logic/Berardi.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -45,7 +45,7 @@ Lemma AC_IF : (B -> Q e1) -> (~ B -> Q e2) -> Q (IFProp B e1 e2). Proof. intros P B e1 e2 Q p1 p2. -unfold IFProp in |- *. +unfold IFProp. case (EM B); assumption. Qed. @@ -76,7 +76,7 @@ Record retract_cond : Prop := Lemma AC : forall r:retract_cond, retract -> forall a:A, j2 r (i2 r a) = a. Proof. intros r. -case r; simpl in |- *. +case r; simpl. trivial. Qed. @@ -113,7 +113,7 @@ Lemma retract_pow_U_U : retract (pow U) U. Proof. exists g f. intro a. -unfold f, g in |- *; simpl in |- *. +unfold f, g; simpl. apply AC. exists (fun x:pow U => x) (fun x:pow U => x). trivial. @@ -130,8 +130,8 @@ Definition R : U := g (fun u:U => Not_b (u U u)). Lemma not_has_fixpoint : R R = Not_b (R R). Proof. -unfold R at 1 in |- *. -unfold g in |- *. +unfold R at 1. +unfold g. rewrite AC with (r := L1 U U) (a := fun u:U => Not_b (u U u)). trivial. exists (fun x:pow U => x) (fun x:pow U => x); trivial. @@ -141,7 +141,7 @@ Qed. Theorem classical_proof_irrelevence : T = F. Proof. generalize not_has_fixpoint. -unfold Not_b in |- *. +unfold Not_b. apply AC_IF. intros is_true is_false. elim is_true; elim is_false; trivial. diff --git a/theories/Logic/ChoiceFacts.v b/theories/Logic/ChoiceFacts.v index fb7898c6..1a32d518 100644 --- a/theories/Logic/ChoiceFacts.v +++ b/theories/Logic/ChoiceFacts.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -344,7 +344,7 @@ 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. + red; 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). @@ -580,7 +580,7 @@ Lemma classical_denumerable_description_imp_fun_choice : (forall x y, decidable (R x y)) -> FunctionalChoice_on_rel R. Proof. intros A Descr. - red in |- *; intros R Rdec H. + red; 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. diff --git a/theories/Logic/Classical.v b/theories/Logic/Classical.v index 9362a11f..d25e0e21 100644 --- a/theories/Logic/Classical.v +++ b/theories/Logic/Classical.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/ClassicalChoice.v b/theories/Logic/ClassicalChoice.v index 6bc0be1d..479056c9 100644 --- a/theories/Logic/ClassicalChoice.v +++ b/theories/Logic/ClassicalChoice.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/ClassicalDescription.v b/theories/Logic/ClassicalDescription.v index d35ed138..2fd6e68e 100644 --- a/theories/Logic/ClassicalDescription.v +++ b/theories/Logic/ClassicalDescription.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -20,7 +20,7 @@ Require Export Classical. (* Axiomatize classical reasoning *) Require Export Description. (* Axiomatize constructive form of Church's iota *) Require Import ChoiceFacts. -Notation Local inhabited A := A (only parsing). +Local Notation inhabited A := A (only parsing). (** The idea for the following proof comes from [ChicliPottierSimpson02] *) diff --git a/theories/Logic/ClassicalEpsilon.v b/theories/Logic/ClassicalEpsilon.v index ae32b127..7ab991f8 100644 --- a/theories/Logic/ClassicalEpsilon.v +++ b/theories/Logic/ClassicalEpsilon.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/ClassicalFacts.v b/theories/Logic/ClassicalFacts.v index bcec657a..34ae1cd5 100644 --- a/theories/Logic/ClassicalFacts.v +++ b/theories/Logic/ClassicalFacts.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -117,7 +117,7 @@ Qed. *) -Notation Local inhabited A := A (only parsing). +Local Notation inhabited A := A (only parsing). Lemma prop_ext_A_eq_A_imp_A : prop_extensionality -> forall A:Prop, inhabited A -> (A -> A) = A. @@ -148,7 +148,7 @@ Proof. 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 |- *. + pattern (g1 (g2 (fun x:A => f (g1 x x)))) at 1. rewrite (g1_o_g2 (fun x:A => f (g1 x x))). reflexivity. Qed. @@ -191,13 +191,13 @@ Section Proof_irrelevance_gen. 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 |- *. + generalize (eq_refl (G neg)). + pattern (G neg) at 1. apply Ind with (b := G neg); intro Heq. rewrite (bool_elim_redl bool false true). - change (true = neg true) in |- *; rewrite Heq; apply Gfix. + change (true = neg true); rewrite Heq; apply Gfix. rewrite (bool_elim_redr bool false true). - change (neg false = false) in |- *; rewrite Heq; symmetry in |- *; + change (neg false = false); rewrite Heq; symmetry ; apply Gfix. Qed. @@ -207,9 +207,9 @@ Section Proof_irrelevance_gen. 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 |- *. + change (f true = a2). rewrite (bool_elim_redr A a1 a2). - change (f true = f false) in |- *. + change (f true = f false). rewrite (aux Ext Ind). reflexivity. Qed. @@ -228,9 +228,9 @@ Section Proof_irrelevance_Prop_Ext_CC. 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. + c1 = BoolP_elim C c1 c2 TrueP := eq_refl c1. Definition BoolP_elim_redr (C:Prop) (c1 c2:C) : - c2 = BoolP_elim C c1 c2 FalseP := refl_equal c2. + c2 = BoolP_elim C c1 c2 FalseP := eq_refl c2. Definition BoolP_dep_induction := forall P:BoolP -> Prop, P TrueP -> P FalseP -> forall b:BoolP, P b. @@ -263,9 +263,9 @@ Section Proof_irrelevance_CIC. | trueP : boolP | falseP : boolP. Definition boolP_elim_redl (C:Prop) (c1 c2:C) : - c1 = boolP_ind C c1 c2 trueP := refl_equal c1. + c1 = boolP_ind C c1 c2 trueP := eq_refl c1. Definition boolP_elim_redr (C:Prop) (c1 c2:C) : - c2 = boolP_ind C c1 c2 falseP := refl_equal c2. + c2 = boolP_ind C c1 c2 falseP := eq_refl c2. Scheme boolP_indd := Induction for boolP Sort Prop. Lemma ext_prop_dep_proof_irrel_cic : prop_extensionality -> proof_irrelevance. @@ -344,8 +344,8 @@ Section Proof_irrelevance_EM_CC. 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. + unfold p2b; intro A; apply or_dep_elim with (b := em A); + unfold b2p; intros. apply (or_elim_redl A (~ A) B (fun _ => b1) (fun _ => b2)). destruct (b H). Qed. @@ -353,8 +353,8 @@ Section Proof_irrelevance_EM_CC. 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. + unfold p2b; intro A; apply or_dep_elim with (b := em A); + unfold b2p; intros. assumption. destruct not_eq_b1_b2. rewrite <- (or_elim_redr A (~ A) B (fun _ => b1) (fun _ => b2)) in H. @@ -392,9 +392,9 @@ 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). + (a:A) : f a = or_ind f g (or_introl B a) := eq_refl (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). + (b:B) : g b = or_ind f g (or_intror A b) := eq_refl (g b). Scheme or_indd := Induction for or Sort Prop. Theorem proof_irrelevance_cci : forall (B:Prop) (b1 b2:B), b1 = b2. diff --git a/theories/Logic/ClassicalUniqueChoice.v b/theories/Logic/ClassicalUniqueChoice.v index ebb73b19..4a4fc23f 100644 --- a/theories/Logic/ClassicalUniqueChoice.v +++ b/theories/Logic/ClassicalUniqueChoice.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/Classical_Pred_Set.v b/theories/Logic/Classical_Pred_Set.v index 7d8bde71..cda9d22c 100644 --- a/theories/Logic/Classical_Pred_Set.v +++ b/theories/Logic/Classical_Pred_Set.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/Classical_Pred_Type.v b/theories/Logic/Classical_Pred_Type.v index 9d57fe88..7e1a4096 100644 --- a/theories/Logic/Classical_Pred_Type.v +++ b/theories/Logic/Classical_Pred_Type.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -42,7 +42,7 @@ Qed. Lemma not_ex_all_not : forall P:U -> Prop, ~ (exists n : U, P n) -> forall n:U, ~ P n. Proof. (* Intuitionistic *) -unfold not in |- *; intros P notex n abs. +unfold not; intros P notex n abs. apply notex. exists n; trivial. Qed. @@ -52,20 +52,20 @@ Lemma not_ex_not_all : Proof. intros P H n. apply NNPP. -red in |- *; intro K; apply H; exists n; trivial. +red; intro K; apply H; exists n; trivial. Qed. Lemma ex_not_not_all : forall P:U -> Prop, (exists n : U, ~ P n) -> ~ (forall n:U, P n). Proof. (* Intuitionistic *) -unfold not in |- *; intros P exnot allP. +unfold not; intros P exnot allP. elim exnot; auto. Qed. Lemma all_not_not_ex : forall P:U -> Prop, (forall n:U, ~ P n) -> ~ (exists n : U, P n). Proof. (* Intuitionistic *) -unfold not in |- *; intros P allnot exP; elim exP; intros n p. +unfold not; intros P allnot exP; elim exP; intros n p. apply allnot with n; auto. Qed. diff --git a/theories/Logic/Classical_Prop.v b/theories/Logic/Classical_Prop.v index d2b35da2..1f6b05f5 100644 --- a/theories/Logic/Classical_Prop.v +++ b/theories/Logic/Classical_Prop.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -20,7 +20,7 @@ Axiom classic : forall P:Prop, P \/ ~ P. Lemma NNPP : forall p:Prop, ~ ~ p -> p. Proof. -unfold not in |- *; intros; elim (classic p); auto. +unfold not; intros; elim (classic p); auto. intro NP; elim (H NP). Qed. @@ -35,7 +35,7 @@ Qed. Lemma not_imply_elim : forall P Q:Prop, ~ (P -> Q) -> P. Proof. -intros; apply NNPP; red in |- *. +intros; apply NNPP; red. intro; apply H; intro; absurd P; trivial. Qed. @@ -68,7 +68,7 @@ Qed. Lemma or_not_and : forall P Q:Prop, ~ P \/ ~ Q -> ~ (P /\ Q). Proof. -simple induction 1; red in |- *; simple induction 2; auto. +simple induction 1; red; simple induction 2; auto. Qed. Lemma not_or_and : forall P Q:Prop, ~ (P \/ Q) -> ~ P /\ ~ Q. @@ -112,7 +112,7 @@ Module Eq_rect_eq. Lemma 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. Proof. -intros; rewrite proof_irrelevance with (p1:=h) (p2:=refl_equal p); reflexivity. +intros; rewrite proof_irrelevance with (p1:=h) (p2:=eq_refl p); reflexivity. Qed. End Eq_rect_eq. diff --git a/theories/Logic/Classical_Type.v b/theories/Logic/Classical_Type.v index 9b28a6ab..86fdd69f 100644 --- a/theories/Logic/Classical_Type.v +++ b/theories/Logic/Classical_Type.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/ConstructiveEpsilon.v b/theories/Logic/ConstructiveEpsilon.v index 33550389..89d3eebc 100644 --- a/theories/Logic/ConstructiveEpsilon.v +++ b/theories/Logic/ConstructiveEpsilon.v @@ -1,12 +1,12 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(*i $Id: ConstructiveEpsilon.v 14628 2011-11-03 23:22:45Z herbelin $ i*) +(*i $Id: ConstructiveEpsilon.v 15714 2012-08-08 18:54:37Z herbelin $ i*) (** This provides with a proof of the constructive form of definite and indefinite descriptions for Sigma^0_1-formulas (hereafter called @@ -112,7 +112,7 @@ of our searching algorithm. *) Let R (x y : nat) : Prop := x = S y /\ ~ P y. -Notation Local acc x := (Acc R x). +Local Notation acc x := (Acc R x). Lemma P_implies_acc : forall x : nat, P x -> acc x. Proof. diff --git a/theories/Logic/Decidable.v b/theories/Logic/Decidable.v index fec7904e..aaf1813b 100644 --- a/theories/Logic/Decidable.v +++ b/theories/Logic/Decidable.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/Description.v b/theories/Logic/Description.v index b74ebcc8..3e5d4ef0 100644 --- a/theories/Logic/Description.v +++ b/theories/Logic/Description.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/Diaconescu.v b/theories/Logic/Diaconescu.v index 8569e55e..87b27987 100644 --- a/theories/Logic/Diaconescu.v +++ b/theories/Logic/Diaconescu.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -61,7 +61,7 @@ Variable pred_extensionality : PredicateExtensionality. Lemma prop_ext : forall A B:Prop, (A <-> B) -> A = B. Proof. intros A B H. - change ((fun _ => A) true = (fun _ => B) true) in |- *. + change ((fun _ => A) true = (fun _ => B) true). rewrite pred_extensionality with (P := fun _:bool => A) (Q := fun _:bool => B). reflexivity. @@ -134,8 +134,8 @@ right. intro HP. assert (Hequiv : forall b:bool, class_of_true b <-> class_of_false b). intro b; split. -unfold class_of_false in |- *; right; assumption. -unfold class_of_true in |- *; right; assumption. +unfold class_of_false; right; assumption. +unfold class_of_true; right; assumption. assert (Heq : class_of_true = class_of_false). apply pred_extensionality with (1 := Hequiv). apply diff_true_false. @@ -188,8 +188,8 @@ Lemma projT1_injective : a1=a2 -> a1'=a2'. Proof. intro Heq ; unfold a1', a2', A'. rewrite Heq. - replace (or_introl (a2=a2) (refl_equal a2)) - with (or_intror (a2=a2) (refl_equal a2)). + replace (or_introl (a2=a2) (eq_refl a2)) + with (or_intror (a2=a2) (eq_refl a2)). reflexivity. apply proof_irrelevance. Qed. @@ -265,7 +265,7 @@ End ProofIrrel_RelChoice_imp_EqEM. (** Proof sketch from Bell [Bell93] (with thanks to P. Castéran) *) -Notation Local inhabited A := A (only parsing). +Local Notation inhabited A := A (only parsing). Section ExtensionalEpsilon_imp_EM. @@ -279,7 +279,7 @@ Hypothesis epsilon_extensionality : forall (A:Type) (i:inhabited A) (P Q:A->Prop), (forall a, P a <-> Q a) -> epsilon A i P = epsilon A i Q. -Notation Local eps := (epsilon bool true) (only parsing). +Local Notation eps := (epsilon bool true) (only parsing). Theorem extensional_epsilon_imp_EM : forall P:Prop, P \/ ~ P. Proof. diff --git a/theories/Logic/Epsilon.v b/theories/Logic/Epsilon.v index cb8f8a73..da3e5b08 100644 --- a/theories/Logic/Epsilon.v +++ b/theories/Logic/Epsilon.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/Eqdep.v b/theories/Logic/Eqdep.v index b8e99036..6841334f 100644 --- a/theories/Logic/Eqdep.v +++ b/theories/Logic/Eqdep.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/EqdepFacts.v b/theories/Logic/EqdepFacts.v index d84cd824..a22f286e 100644 --- a/theories/Logic/EqdepFacts.v +++ b/theories/Logic/EqdepFacts.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -101,7 +101,7 @@ Section Dependent_Equality. 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). + apply eq_dep1_intro with (eq_refl p). simpl; trivial. Qed. @@ -121,7 +121,7 @@ Proof. apply eq_dep_intro. Qed. -Notation eq_sigS_eq_dep := eq_sigT_eq_dep (only parsing). (* Compatibility *) +Notation eq_sigS_eq_dep := eq_sigT_eq_dep (compat "8.2"). (* Compatibility *) Lemma eq_dep_eq_sigT : forall (U:Type) (P:U -> Type) (p q:U) (x:P p) (y:P q), @@ -250,12 +250,12 @@ Section Equivalences. (** Uniqueness of Reflexive Identity Proofs *) Definition UIP_refl_ := - forall (x:U) (p:x = x), p = refl_equal x. + forall (x:U) (p:x = x), p = eq_refl 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. + forall (x:U) (P:x = x -> Prop), P (eq_refl x) -> forall p:x = x, P p. (** Injectivity of Dependent Equality is a consequence of *) (** Invariance by Substitution of Reflexive Equality Proof *) @@ -389,14 +389,14 @@ Proof (eq_dep_eq__UIP U eq_dep_eq). (** Uniqueness of Reflexive Identity Proofs is a direct instance of UIP *) -Lemma UIP_refl : forall (x:U) (p:x = x), p = refl_equal x. +Lemma UIP_refl : forall (x:U) (p:x = x), p = eq_refl x. Proof (UIP__UIP_refl U UIP). (** Streicher's axiom K is a direct consequence of Uniqueness of Reflexive Identity Proofs *) Lemma Streicher_K : - forall (x:U) (P:x = x -> Prop), P (refl_equal x) -> forall p:x = x, P p. + forall (x:U) (P:x = x -> Prop), P (eq_refl x) -> forall p:x = x, P p. Proof (UIP_refl__Streicher_K U UIP_refl). End Axioms. diff --git a/theories/Logic/Eqdep_dec.v b/theories/Logic/Eqdep_dec.v index 59088aa7..3a6f6a23 100644 --- a/theories/Logic/Eqdep_dec.v +++ b/theories/Logic/Eqdep_dec.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -9,7 +9,7 @@ (* Created by Bruno Barras, Jan 1998 *) (* Made a module instance for EqdepFacts by Hugo Herbelin, Mar 2006 *) -(** We prove that there is only one proof of [x=x], i.e [refl_equal x]. +(** We prove that there is only one proof of [x=x], i.e [eq_refl x]. This holds if the equality upon the set of [x] is decidable. A corollary of this theorem is the equality of the right projections of two equal dependent pairs. @@ -43,7 +43,7 @@ Section EqdepDec. 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. + Remark trans_sym_eq : forall (x y:A) (u:x = y), comp u u = eq_refl y. Proof. intros. case u; trivial. @@ -61,7 +61,7 @@ Section EqdepDec. Let nu_constant : forall (y:A) (u v:x = y), nu u = nu v. intros. - unfold nu in |- *. + unfold nu. case (eq_dec x y); intros. reflexivity. @@ -69,13 +69,13 @@ Section EqdepDec. Qed. - Let nu_inv (y:A) (v:x = y) : x = y := comp (nu (refl_equal x)) v. + Let nu_inv (y:A) (v:x = y) : x = y := comp (nu (eq_refl x)) v. Remark nu_left_inv : forall (y:A) (u:x = y), nu_inv (nu u) = u. Proof. intros. - case u; unfold nu_inv in |- *. + case u; unfold nu_inv. apply trans_sym_eq. Qed. @@ -90,10 +90,10 @@ Section EqdepDec. Qed. Theorem K_dec : - forall P:x = x -> Prop, P (refl_equal x) -> forall p:x = x, P p. + forall P:x = x -> Prop, P (eq_refl x) -> forall p:x = x, P p. Proof. intros. - elim eq_proofs_unicity with x (refl_equal x) p. + elim eq_proofs_unicity with x (eq_refl x) p. trivial. Qed. @@ -115,7 +115,7 @@ Section EqdepDec. Proof. intros. cut (proj (ex_intro P x y) y = proj (ex_intro P x y') y). - simpl in |- *. + simpl. case (eq_dec x x). intro e. elim e using K_dec; trivial. @@ -135,7 +135,7 @@ Require Import EqdepFacts. 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. + forall (x:A) (P:x = x -> Prop), P (eq_refl x) -> forall p:x = x, P p. Proof. intros A eq_dec x P H p. elim p using K_dec; intros. @@ -146,7 +146,7 @@ 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. + forall (x:A) (P:x = x -> Prop), P (eq_refl 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 *) @@ -212,13 +212,13 @@ Module DecidableEqDep (M:DecidableType). (** Uniqueness of Reflexive Identity Proofs *) - Lemma UIP_refl : forall (x:U) (p:x = x), p = refl_equal x. + Lemma UIP_refl : forall (x:U) (p:x = x), p = eq_refl x. Proof (UIP__UIP_refl U UIP). (** Streicher's axiom K *) Lemma Streicher_K : - forall (x:U) (P:x = x -> Prop), P (refl_equal x) -> forall p:x = x, P p. + forall (x:U) (P:x = x -> Prop), P (eq_refl x) -> forall p:x = x, P p. Proof (K_dec_type eq_dec). (** Injectivity of equality on dependent pairs in [Type] *) @@ -281,13 +281,13 @@ Module DecidableEqDepSet (M:DecidableSet). (** Uniqueness of Reflexive Identity Proofs *) - Lemma UIP_refl : forall (x:U) (p:x = x), p = refl_equal x. + Lemma UIP_refl : forall (x:U) (p:x = x), p = eq_refl x. Proof N.UIP_refl. (** Streicher's axiom K *) Lemma Streicher_K : - forall (x:U) (P:x = x -> Prop), P (refl_equal x) -> forall p:x = x, P p. + forall (x:U) (P:x = x -> Prop), P (eq_refl x) -> forall p:x = x, P p. Proof N.Streicher_K. (** Proof-irrelevance on subsets of decidable sets *) @@ -301,7 +301,7 @@ Module DecidableEqDepSet (M:DecidableSet). Lemma inj_pair2 : forall (P:U -> Type) (p:U) (x y:P p), - existS P p x = existS P p y -> x = y. + existT P p x = existT P p y -> x = y. Proof eq_dep_eq__inj_pair2 U N.eq_dep_eq. (** Injectivity of equality on dependent pairs with second component diff --git a/theories/Logic/ExtensionalityFacts.v b/theories/Logic/ExtensionalityFacts.v index f5e71ef4..9cbf756d 100644 --- a/theories/Logic/ExtensionalityFacts.v +++ b/theories/Logic/ExtensionalityFacts.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/FunctionalExtensionality.v b/theories/Logic/FunctionalExtensionality.v index 35db160f..ecb7428e 100644 --- a/theories/Logic/FunctionalExtensionality.v +++ b/theories/Logic/FunctionalExtensionality.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/Hurkens.v b/theories/Logic/Hurkens.v index bb03c666..1dce51b2 100644 --- a/theories/Logic/Hurkens.v +++ b/theories/Logic/Hurkens.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -46,7 +46,7 @@ Lemma Omega : forall i:U -> bool, induct i -> b2p (i WF). Proof. intros i y. apply y. -unfold le, WF, induct in |- *. +unfold le, WF, induct. apply p2p2. intros x H0. apply y. @@ -55,7 +55,7 @@ Qed. Lemma lemma1 : induct (fun u => p2b (I u)). Proof. -unfold induct in |- *. +unfold induct. intros x p. apply (p2p2 (I x)). intro q. diff --git a/theories/Logic/IndefiniteDescription.v b/theories/Logic/IndefiniteDescription.v index 8badc07c..5424eea8 100644 --- a/theories/Logic/IndefiniteDescription.v +++ b/theories/Logic/IndefiniteDescription.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/JMeq.v b/theories/Logic/JMeq.v index 753009e6..530e0555 100644 --- a/theories/Logic/JMeq.v +++ b/theories/Logic/JMeq.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/ProofIrrelevance.v b/theories/Logic/ProofIrrelevance.v index 36508969..7d6d0cf8 100644 --- a/theories/Logic/ProofIrrelevance.v +++ b/theories/Logic/ProofIrrelevance.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/ProofIrrelevanceFacts.v b/theories/Logic/ProofIrrelevanceFacts.v index 6accc480..2e9f0c19 100644 --- a/theories/Logic/ProofIrrelevanceFacts.v +++ b/theories/Logic/ProofIrrelevanceFacts.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -25,7 +25,7 @@ Module ProofIrrelevanceTheory (M:ProofIrrelevance). forall (U:Type) (p:U) (Q:U -> Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h. Proof. - intros; rewrite M.proof_irrelevance with (p1:=h) (p2:=refl_equal p). + intros; rewrite M.proof_irrelevance with (p1:=h) (p2:=eq_refl p). reflexivity. Qed. End Eq_rect_eq. diff --git a/theories/Logic/RelationalChoice.v b/theories/Logic/RelationalChoice.v index d0d58e37..efec03d4 100644 --- a/theories/Logic/RelationalChoice.v +++ b/theories/Logic/RelationalChoice.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/SetIsType.v b/theories/Logic/SetIsType.v index f0876fbc..c0a6f9ed 100644 --- a/theories/Logic/SetIsType.v +++ b/theories/Logic/SetIsType.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/MSets/MSetEqProperties.v b/theories/MSets/MSetEqProperties.v index 2e7da404..4f0d93fb 100644 --- a/theories/MSets/MSetEqProperties.v +++ b/theories/MSets/MSetEqProperties.v @@ -206,7 +206,7 @@ intros. generalize (@choose_1 s) (@choose_2 s). destruct (choose s);intros. exists e;auto with set. -generalize (H1 (refl_equal None)); clear H1. +generalize (H1 (eq_refl None)); clear H1. intros; rewrite (is_empty_1 H1) in H; discriminate. Qed. @@ -631,7 +631,7 @@ destruct (choose (filter f s)). intros H0 _; apply exists_1; auto. exists e; generalize (H0 e); rewrite filter_iff; auto. intros _ H0. -rewrite (is_empty_1 (H0 (refl_equal None))) in H; auto; discriminate. +rewrite (is_empty_1 (H0 (eq_refl None))) in H; auto; discriminate. Qed. Lemma partition_filter_1: @@ -879,8 +879,8 @@ generalize (@add_filter_1 f Hf s0 (add x s0) x) (@add_filter_2 f Hf s0 (add x s0 assert (~ In x (filter f s0)). intro H1; rewrite (mem_1 (filter_1 Hf H1)) in H; discriminate H. case (f x); simpl; intros. -rewrite (MP.cardinal_2 H1 (H2 (refl_equal true) (MP.Add_add s0 x))); auto. -rewrite <- (MP.Equal_cardinal (H3 (refl_equal false) (MP.Add_add s0 x))); auto. +rewrite (MP.cardinal_2 H1 (H2 (eq_refl true) (MP.Add_add s0 x))); auto. +rewrite <- (MP.Equal_cardinal (H3 (eq_refl false) (MP.Add_add s0 x))); auto. intros; rewrite fold_empty;auto. rewrite MP.cardinal_1; auto. unfold Empty; intros. diff --git a/theories/MSets/MSetInterface.v b/theories/MSets/MSetInterface.v index f2b908af..6778deff 100644 --- a/theories/MSets/MSetInterface.v +++ b/theories/MSets/MSetInterface.v @@ -480,7 +480,7 @@ Module WRaw2SetsOn (E:DecidableType)(M:WRawSets E) <: WSetsOn E. Proof. intros (s,Hs) (s',Hs'). change ({M.Equal s s'}+{~M.Equal s s'}). - destruct (M.equal s s') as [ ]_eqn:H; [left|right]; + destruct (M.equal s s') eqn:H; [left|right]; rewrite <- M.equal_spec; congruence. Defined. diff --git a/theories/MSets/MSetList.v b/theories/MSets/MSetList.v index bcf68f1d..d9b1fd9b 100644 --- a/theories/MSets/MSetList.v +++ b/theories/MSets/MSetList.v @@ -662,7 +662,7 @@ Module MakeRaw (X: OrderedType) <: RawSets X. Proof. induction s; simpl; intros. split; intuition; inv. - destruct (f a) as [ ]_eqn:F; rewrite !InA_cons, ?IHs; intuition. + destruct (f a) eqn:F; rewrite !InA_cons, ?IHs; intuition. setoid_replace x with a; auto. setoid_replace a with x in F; auto; congruence. Qed. @@ -674,7 +674,7 @@ Module MakeRaw (X: OrderedType) <: RawSets X. Proof. unfold For_all; induction s; simpl; intros. split; intros; auto. inv. - destruct (f a) as [ ]_eqn:F. + destruct (f a) eqn:F. rewrite IHs; auto. firstorder. inv; auto. setoid_replace x with a; auto. split; intros H'. discriminate. @@ -688,7 +688,7 @@ Module MakeRaw (X: OrderedType) <: RawSets X. Proof. unfold Exists; induction s; simpl; intros. firstorder. discriminate. inv. - destruct (f a) as [ ]_eqn:F. + destruct (f a) eqn:F. firstorder. rewrite IHs; auto. firstorder. diff --git a/theories/MSets/MSetPositive.v b/theories/MSets/MSetPositive.v index e83ac27d..e500602f 100644 --- a/theories/MSets/MSetPositive.v +++ b/theories/MSets/MSetPositive.v @@ -36,8 +36,8 @@ Local Unset Boolean Equality Schemes. Module PositiveOrderedTypeBits <: UsualOrderedType. Definition t:=positive. Include HasUsualEq <+ UsualIsEq. - Definition eqb := Peqb. - Definition eqb_eq := Peqb_eq. + Definition eqb := Pos.eqb. + Definition eqb_eq := Pos.eqb_eq. Include HasEqBool2Dec. Fixpoint bits_lt (p q:positive) : Prop := diff --git a/theories/MSets/MSetProperties.v b/theories/MSets/MSetProperties.v index 0f24d76a..396067b5 100644 --- a/theories/MSets/MSetProperties.v +++ b/theories/MSets/MSetProperties.v @@ -831,7 +831,7 @@ Module WPropertiesOn (Import E : DecidableType)(M : WSetsOn E). rewrite (inter_subset_equal H). generalize (@cardinal_inv_1 (diff s' s)). destruct (cardinal (diff s' s)). - intro H2; destruct (H2 (refl_equal _) x). + intro H2; destruct (H2 (eq_refl _) x). set_iff; auto. intros _. change (0 + cardinal s < S n + cardinal s). diff --git a/theories/MSets/MSetRBT.v b/theories/MSets/MSetRBT.v index b53c0392..b838495f 100644 --- a/theories/MSets/MSetRBT.v +++ b/theories/MSets/MSetRBT.v @@ -31,7 +31,7 @@ Additional suggested reading: *) Require MSetGenTree. -Require Import Bool List BinPos Pnat Setoid SetoidList NPeano Psatz. +Require Import Bool List BinPos Pnat Setoid SetoidList NPeano. Local Open Scope list_scope. (* For nicer extraction, we create induction principles @@ -280,11 +280,13 @@ Fixpoint treeify_aux (pred:bool)(n: positive) : treeify_t := | xI n => treeify_cont (treeify_aux false n) (treeify_aux pred n) end. -Fixpoint plength (l:list elt) := match l with - | nil => 1%positive - | _::l => Psucc (plength l) +Fixpoint plength_aux (l:list elt)(p:positive) := match l with + | nil => p + | _::l => plength_aux l (Pos.succ p) end. +Definition plength l := plength_aux l 1. + Definition treeify (l:list elt) := fst (treeify_aux true (plength l) l). @@ -975,18 +977,18 @@ Proof. specialize (Hf acc). destruct (f acc) as (t1,acc1). destruct Hf as (Hf1,Hf2). - { lia. } + { transitivity size; trivial. subst. auto with arith. } destruct acc1 as [|x acc1]. - { exfalso. subst acc. - rewrite <- app_nil_end, <- elements_cardinal in LE. lia. } + { exfalso. revert LE. apply Nat.lt_nge. subst. + rewrite <- app_nil_end, <- elements_cardinal; auto with arith. } specialize (Hg acc1). destruct (g acc1) as (t2,acc2). destruct Hg as (Hg1,Hg2). - { subst acc. rewrite app_length, <- elements_cardinal in LE. - simpl in LE. unfold elt in *. lia. } - simpl. split. - * lia. - * rewrite elements_node, app_ass. simpl. unfold elt in *; congruence. + { revert LE. subst. + rewrite app_length, <- elements_cardinal. simpl. + rewrite Nat.add_succ_r, <- Nat.succ_le_mono. + apply Nat.add_le_mono_l. } + simpl. rewrite elements_node, app_ass. now subst. Qed. Lemma treeify_aux_spec n (p:bool) : @@ -995,17 +997,29 @@ Proof. revert p. induction n as [n|n|]; intros p; simpl treeify_aux. - eapply treeify_cont_spec; [ apply (IHn false) | apply (IHn p) | ]. - rewrite Pos2Nat.inj_xI. generalize (Pos2Nat.is_pos n). - destruct p; simpl; lia. + rewrite Pos2Nat.inj_xI. + assert (H := Pos2Nat.is_pos n). apply Nat.neq_0_lt_0 in H. + destruct p; simpl; intros; rewrite Nat.add_0_r; trivial. + now rewrite <- Nat.add_succ_r, Nat.succ_pred; trivial. - eapply treeify_cont_spec; [ apply (IHn p) | apply (IHn true) | ]. - rewrite Pos2Nat.inj_xO. generalize (Pos2Nat.is_pos n). - destruct p; simpl; lia. + rewrite Pos2Nat.inj_xO. + assert (H := Pos2Nat.is_pos n). apply Nat.neq_0_lt_0 in H. + rewrite <- Nat.add_succ_r, Nat.succ_pred by trivial. + destruct p; simpl; intros; rewrite Nat.add_0_r; trivial. + symmetry. now apply Nat.add_pred_l. - destruct p; [ apply treeify_zero_spec | apply treeify_one_spec ]. Qed. +Lemma plength_aux_spec l p : + Pos.to_nat (plength_aux l p) = length l + Pos.to_nat p. +Proof. + revert p. induction l; simpl; trivial. + intros. now rewrite IHl, Pos2Nat.inj_succ, Nat.add_succ_r. +Qed. + Lemma plength_spec l : Pos.to_nat (plength l) = S (length l). Proof. - induction l; simpl; now rewrite ?Pos2Nat.inj_succ, ?IHl. + unfold plength. rewrite plength_aux_spec. apply Nat.add_1_r. Qed. Lemma treeify_elements l : elements (treeify l) = l. @@ -1016,7 +1030,9 @@ Proof. subst l. rewrite plength_spec, app_length, <- elements_cardinal in *. destruct acc. * now rewrite app_nil_r. - * simpl in H. lia. + * exfalso. revert H. simpl. + rewrite Nat.add_succ_r, Nat.add_comm. + apply Nat.succ_add_discr. Qed. Lemma treeify_spec x l : InT x (treeify l) <-> InA X.eq x l. @@ -1531,10 +1547,10 @@ Proof. simpl maxdepth. simpl redcarac. rewrite Nat.add_succ_r, <- Nat.succ_le_mono. now apply Nat.max_lub. - - simpl. Nat.nzsimpl. rewrite <- Nat.succ_le_mono. - apply Nat.max_lub; eapply Nat.le_trans; eauto. - destree l; simpl; lia. - destree r; simpl; lia. + - simpl. rewrite <- Nat.succ_le_mono. + apply Nat.max_lub; eapply Nat.le_trans; eauto; + [destree l | destree r]; simpl; + rewrite !Nat.add_0_r, ?Nat.add_1_r; auto with arith. Qed. Lemma rb_mindepth s n : rbt n s -> n + redcarac s <= mindepth s. @@ -1546,7 +1562,8 @@ Proof. replace (redcarac l) with 0 in * by now destree l. replace (redcarac r) with 0 in * by now destree r. now apply Nat.min_glb. - - apply -> Nat.succ_le_mono. apply Nat.min_glb; lia. + - apply -> Nat.succ_le_mono. rewrite Nat.add_0_r. + apply Nat.min_glb; eauto with arith. Qed. Lemma maxdepth_upperbound s : Rbt s -> @@ -1554,8 +1571,14 @@ Lemma maxdepth_upperbound s : Rbt s -> Proof. intros (n,H). eapply Nat.le_trans; [eapply rb_maxdepth; eauto|]. - generalize (rb_mindepth s n H). - generalize (mindepth_log_cardinal s). lia. + transitivity (2*(n+redcarac s)). + - rewrite Nat.mul_add_distr_l. apply Nat.add_le_mono_l. + rewrite <- Nat.mul_1_l at 1. apply Nat.mul_le_mono_r. + auto with arith. + - apply Nat.mul_le_mono_l. + transitivity (mindepth s). + + now apply rb_mindepth. + + apply mindepth_log_cardinal. Qed. Lemma maxdepth_lowerbound s : s<>Leaf -> @@ -1792,12 +1815,18 @@ Proof. unfold treeify_cont. specialize (Hf acc). destruct (f acc) as (l, acc1). simpl in *. - destruct Hf as (Hf1, Hf2). { lia. } - destruct acc1 as [|x acc2]; simpl in *. { lia. } - specialize (Hg acc2). - destruct (g acc2) as (r, acc3). simpl in *. - destruct Hg as (Hg1, Hg2). { lia. } - split; [auto | lia]. + destruct Hf as (Hf1, Hf2). { subst. eauto with arith. } + destruct acc1 as [|x acc2]; simpl in *. + - exfalso. revert Hacc. apply Nat.lt_nge. rewrite H, <- Hf2. + auto with arith. + - specialize (Hg acc2). + destruct (g acc2) as (r, acc3). simpl in *. + destruct Hg as (Hg1, Hg2). + { revert Hacc. + rewrite H, <- Hf2, Nat.add_succ_r, <- Nat.succ_le_mono. + apply Nat.add_le_mono_l. } + split; auto. + now rewrite H, <- Hf2, <- Hg2, Nat.add_succ_r, Nat.add_assoc. Qed. Lemma treeify_aux_rb n : @@ -1807,12 +1836,17 @@ Proof. induction n as [n (d,IHn)|n (d,IHn)| ]. - exists (S d). intros b. eapply treeify_cont_rb; [ apply (IHn false) | apply (IHn b) | ]. - rewrite Pos2Nat.inj_xI. generalize (Pos2Nat.is_pos n). - destruct b; simpl; lia. + rewrite Pos2Nat.inj_xI. + assert (H := Pos2Nat.is_pos n). apply Nat.neq_0_lt_0 in H. + destruct b; simpl; intros; rewrite Nat.add_0_r; trivial. + now rewrite <- Nat.add_succ_r, Nat.succ_pred; trivial. - exists (S d). intros b. eapply treeify_cont_rb; [ apply (IHn b) | apply (IHn true) | ]. - rewrite Pos2Nat.inj_xO. generalize (Pos2Nat.is_pos n). - destruct b; simpl; lia. + rewrite Pos2Nat.inj_xO. + assert (H := Pos2Nat.is_pos n). apply Nat.neq_0_lt_0 in H. + rewrite <- Nat.add_succ_r, Nat.succ_pred by trivial. + destruct b; simpl; intros; rewrite Nat.add_0_r; trivial. + symmetry. now apply Nat.add_pred_l. - exists 0; destruct b; [ apply treeify_zero_rb | apply treeify_one_rb ]. Qed. diff --git a/theories/MSets/MSetWeakList.v b/theories/MSets/MSetWeakList.v index 76f09c76..fd4114cd 100644 --- a/theories/MSets/MSetWeakList.v +++ b/theories/MSets/MSetWeakList.v @@ -396,7 +396,7 @@ Module MakeRaw (X:DecidableType) <: WRawSets X. induction s; simpl. intuition; inv. intros. - destruct (f a) as [ ]_eqn:E; rewrite ?InA_cons, IHs; intuition. + destruct (f a) eqn:E; rewrite ?InA_cons, IHs; intuition. setoid_replace x with a; auto. setoid_replace a with x in E; auto. congruence. Qed. @@ -420,7 +420,7 @@ Module MakeRaw (X:DecidableType) <: WRawSets X. unfold For_all; induction s; simpl. intuition. inv. intros; inv. - destruct (f a) as [ ]_eqn:F. + destruct (f a) eqn:F. rewrite IHs; intuition. inv; auto. setoid_replace x with a; auto. split; intros H'; try discriminate. @@ -436,7 +436,7 @@ Module MakeRaw (X:DecidableType) <: WRawSets X. unfold Exists; induction s; simpl. split; [discriminate| intros (x & Hx & _); inv]. intros. - destruct (f a) as [ ]_eqn:F. + destruct (f a) eqn:F. split; auto. exists a; auto. rewrite IHs; firstorder. diff --git a/theories/NArith/BinNat.v b/theories/NArith/BinNat.v index 30e35f50..5b1e83e6 100644 --- a/theories/NArith/BinNat.v +++ b/theories/NArith/BinNat.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -76,7 +76,7 @@ Defined. (** Discrimination principle *) -Definition discr n : { p:positive | n = Npos p } + { n = N0 }. +Definition discr n : { p:positive | n = pos p } + { n = 0 }. Proof. destruct n; auto. left; exists p; auto. @@ -87,12 +87,12 @@ Defined. Definition binary_rect (P:N -> Type) (f0 : P 0) (f2 : forall n, P n -> P (double n)) (fS2 : forall n, P n -> P (succ_double n)) (n : N) : P n := - let P' p := P (Npos p) in - let f2' p := f2 (Npos p) in - let fS2' p := fS2 (Npos p) in + let P' p := P (pos p) in + let f2' p := f2 (pos p) in + let fS2' p := fS2 (pos p) in match n with | 0 => f0 - | Npos p => positive_rect P' fS2' f2' (fS2 0 f0) p + | pos p => positive_rect P' fS2' f2' (fS2 0 f0) p end. Definition binary_rec (P:N -> Set) := binary_rect P. @@ -103,11 +103,11 @@ Definition binary_ind (P:N -> Prop) := binary_rect P. Definition peano_rect (P : N -> Type) (f0 : P 0) (f : forall n : N, P n -> P (succ n)) (n : N) : P n := -let P' p := P (Npos p) in -let f' p := f (Npos p) in +let P' p := P (pos p) in +let f' p := f (pos p) in match n with | 0 => f0 -| Npos p => Pos.peano_rect P' (f 0 f0) f' p +| pos p => Pos.peano_rect P' (f 0 f0) f' p end. Theorem peano_rect_base P a f : peano_rect P a f 0 = a. @@ -140,12 +140,12 @@ Qed. (** Properties of mixed successor and predecessor. *) -Lemma pos_pred_spec p : Pos.pred_N p = pred (Npos p). +Lemma pos_pred_spec p : Pos.pred_N p = pred (pos p). Proof. now destruct p. Qed. -Lemma succ_pos_spec n : Npos (succ_pos n) = succ n. +Lemma succ_pos_spec n : pos (succ_pos n) = succ n. Proof. now destruct n. Qed. @@ -155,7 +155,7 @@ Proof. destruct n. trivial. apply Pos.pred_N_succ. Qed. -Lemma succ_pos_pred p : succ (Pos.pred_N p) = Npos p. +Lemma succ_pos_pred p : succ (Pos.pred_N p) = pos p. Proof. destruct p; simpl; trivial. f_equal. apply Pos.succ_pred_double. Qed. @@ -472,7 +472,7 @@ Lemma log2_spec n : 0 < n -> 2^(log2 n) <= n < 2^(succ (log2 n)). Proof. destruct n as [|[p|p|]]; discriminate || intros _; simpl; split. - apply (size_le (Npos p)). + apply (size_le (pos p)). apply Pos.size_gt. apply Pos.size_le. apply Pos.size_gt. @@ -494,7 +494,7 @@ Proof. trivial. destruct p; simpl; split; try easy. intros (m,H). now destruct m. - now exists (Npos p). + now exists (pos p). intros (m,H). now destruct m. Qed. @@ -504,7 +504,7 @@ Proof. split. discriminate. intros (m,H). now destruct m. destruct p; simpl; split; try easy. - now exists (Npos p). + now exists (pos p). intros (m,H). now destruct m. now exists 0. Qed. @@ -512,19 +512,19 @@ Qed. (** Specification of the euclidean division *) Theorem pos_div_eucl_spec (a:positive)(b:N) : - let (q,r) := pos_div_eucl a b in Npos a = q * b + r. + let (q,r) := pos_div_eucl a b in pos a = q * b + r. Proof. induction a; cbv beta iota delta [pos_div_eucl]; fold pos_div_eucl; cbv zeta. (* a~1 *) destruct pos_div_eucl as (q,r). - change (Npos a~1) with (succ_double (Npos a)). + change (pos a~1) with (succ_double (pos a)). rewrite IHa, succ_double_add, double_mul. case leb_spec; intros H; trivial. rewrite succ_double_mul, <- add_assoc. f_equal. now rewrite (add_comm b), sub_add. (* a~0 *) destruct pos_div_eucl as (q,r). - change (Npos a~0) with (double (Npos a)). + change (pos a~0) with (double (pos a)). rewrite IHa, double_add, double_mul. case leb_spec; intros H; trivial. rewrite succ_double_mul, <- add_assoc. f_equal. @@ -537,7 +537,7 @@ Theorem div_eucl_spec a b : let (q,r) := div_eucl a b in a = b * q + r. Proof. destruct a as [|a], b as [|b]; unfold div_eucl; trivial. - generalize (pos_div_eucl_spec a (Npos b)). + generalize (pos_div_eucl_spec a (pos b)). destruct pos_div_eucl. now rewrite mul_comm. Qed. @@ -664,7 +664,7 @@ Proof. destruct (Pos.gcd_greatest p q r) as (u,H). exists s. now inversion Hs. exists t. now inversion Ht. - exists (Npos u). simpl; now f_equal. + exists (pos u). simpl; now f_equal. Qed. Lemma gcd_nonneg a b : 0 <= gcd a b. @@ -862,7 +862,7 @@ Program Definition testbit_wd : Proper (eq==>eq==>Logic.eq) testbit := _. Theorem bi_induction : forall A : N -> Prop, Proper (Logic.eq==>iff) A -> - A N0 -> (forall n, A n <-> A (succ n)) -> forall n : N, A n. + A 0 -> (forall n, A n <-> A (succ n)) -> forall n : N, A n. Proof. intros A A_wd A0 AS. apply peano_rect. assumption. intros; now apply -> AS. Qed. @@ -893,11 +893,11 @@ Qed. (** Instantiation of generic properties of natural numbers *) -Include NProp - <+ UsualMinMaxLogicalProperties <+ UsualMinMaxDecProperties. +(** The Bind Scope prevents N to stay associated with abstract_scope. + (TODO FIX) *) -(** Otherwise N stays associated with abstract_scope : (TODO FIX) *) -Bind Scope N_scope with N. +Include NProp. Bind Scope N_scope with N. +Include UsualMinMaxLogicalProperties <+ UsualMinMaxDecProperties. (** In generic statements, the predicates [lt] and [le] have been favored, whereas [gt] and [ge] don't even exist in the abstract @@ -1013,95 +1013,95 @@ Notation "( p | q )" := (N.divide p q) (at level 0) : N_scope. (** Compatibility notations *) -(*Notation N := N (only parsing).*) (*hidden by module N above *) +(*Notation N := N (compat "8.3").*) (*hidden by module N above *) Notation N_rect := N_rect (only parsing). Notation N_rec := N_rec (only parsing). Notation N_ind := N_ind (only parsing). Notation N0 := N0 (only parsing). -Notation Npos := Npos (only parsing). - -Notation Ndiscr := N.discr (only parsing). -Notation Ndouble_plus_one := N.succ_double. -Notation Ndouble := N.double (only parsing). -Notation Nsucc := N.succ (only parsing). -Notation Npred := N.pred (only parsing). -Notation Nsucc_pos := N.succ_pos (only parsing). -Notation Ppred_N := Pos.pred_N (only parsing). -Notation Nplus := N.add (only parsing). -Notation Nminus := N.sub (only parsing). -Notation Nmult := N.mul (only parsing). -Notation Neqb := N.eqb (only parsing). -Notation Ncompare := N.compare (only parsing). -Notation Nlt := N.lt (only parsing). -Notation Ngt := N.gt (only parsing). -Notation Nle := N.le (only parsing). -Notation Nge := N.ge (only parsing). -Notation Nmin := N.min (only parsing). -Notation Nmax := N.max (only parsing). -Notation Ndiv2 := N.div2 (only parsing). -Notation Neven := N.even (only parsing). -Notation Nodd := N.odd (only parsing). -Notation Npow := N.pow (only parsing). -Notation Nlog2 := N.log2 (only parsing). - -Notation nat_of_N := N.to_nat (only parsing). -Notation N_of_nat := N.of_nat (only parsing). -Notation N_eq_dec := N.eq_dec (only parsing). -Notation Nrect := N.peano_rect (only parsing). -Notation Nrect_base := N.peano_rect_base (only parsing). -Notation Nrect_step := N.peano_rect_succ (only parsing). -Notation Nind := N.peano_ind (only parsing). -Notation Nrec := N.peano_rec (only parsing). -Notation Nrec_base := N.peano_rec_base (only parsing). -Notation Nrec_succ := N.peano_rec_succ (only parsing). - -Notation Npred_succ := N.pred_succ (only parsing). -Notation Npred_minus := N.pred_sub (only parsing). -Notation Nsucc_pred := N.succ_pred (only parsing). -Notation Ppred_N_spec := N.pos_pred_spec (only parsing). -Notation Nsucc_pos_spec := N.succ_pos_spec (only parsing). -Notation Ppred_Nsucc := N.pos_pred_succ (only parsing). -Notation Nplus_0_l := N.add_0_l (only parsing). -Notation Nplus_0_r := N.add_0_r (only parsing). -Notation Nplus_comm := N.add_comm (only parsing). -Notation Nplus_assoc := N.add_assoc (only parsing). -Notation Nplus_succ := N.add_succ_l (only parsing). -Notation Nsucc_0 := N.succ_0_discr (only parsing). -Notation Nsucc_inj := N.succ_inj (only parsing). -Notation Nminus_N0_Nle := N.sub_0_le (only parsing). -Notation Nminus_0_r := N.sub_0_r (only parsing). -Notation Nminus_succ_r:= N.sub_succ_r (only parsing). -Notation Nmult_0_l := N.mul_0_l (only parsing). -Notation Nmult_1_l := N.mul_1_l (only parsing). -Notation Nmult_1_r := N.mul_1_r (only parsing). -Notation Nmult_comm := N.mul_comm (only parsing). -Notation Nmult_assoc := N.mul_assoc (only parsing). -Notation Nmult_plus_distr_r := N.mul_add_distr_r (only parsing). -Notation Neqb_eq := N.eqb_eq (only parsing). -Notation Nle_0 := N.le_0_l (only parsing). -Notation Ncompare_refl := N.compare_refl (only parsing). -Notation Ncompare_Eq_eq := N.compare_eq (only parsing). -Notation Ncompare_eq_correct := N.compare_eq_iff (only parsing). -Notation Nlt_irrefl := N.lt_irrefl (only parsing). -Notation Nlt_trans := N.lt_trans (only parsing). -Notation Nle_lteq := N.lt_eq_cases (only parsing). -Notation Nlt_succ_r := N.lt_succ_r (only parsing). -Notation Nle_trans := N.le_trans (only parsing). -Notation Nle_succ_l := N.le_succ_l (only parsing). -Notation Ncompare_spec := N.compare_spec (only parsing). -Notation Ncompare_0 := N.compare_0_r (only parsing). -Notation Ndouble_div2 := N.div2_double (only parsing). -Notation Ndouble_plus_one_div2 := N.div2_succ_double (only parsing). -Notation Ndouble_inj := N.double_inj (only parsing). -Notation Ndouble_plus_one_inj := N.succ_double_inj (only parsing). -Notation Npow_0_r := N.pow_0_r (only parsing). -Notation Npow_succ_r := N.pow_succ_r (only parsing). -Notation Nlog2_spec := N.log2_spec (only parsing). -Notation Nlog2_nonpos := N.log2_nonpos (only parsing). -Notation Neven_spec := N.even_spec (only parsing). -Notation Nodd_spec := N.odd_spec (only parsing). -Notation Nlt_not_eq := N.lt_neq (only parsing). -Notation Ngt_Nlt := N.gt_lt (only parsing). +Notation Npos := N.pos (only parsing). + +Notation Ndiscr := N.discr (compat "8.3"). +Notation Ndouble_plus_one := N.succ_double (compat "8.3"). +Notation Ndouble := N.double (compat "8.3"). +Notation Nsucc := N.succ (compat "8.3"). +Notation Npred := N.pred (compat "8.3"). +Notation Nsucc_pos := N.succ_pos (compat "8.3"). +Notation Ppred_N := Pos.pred_N (compat "8.3"). +Notation Nplus := N.add (compat "8.3"). +Notation Nminus := N.sub (compat "8.3"). +Notation Nmult := N.mul (compat "8.3"). +Notation Neqb := N.eqb (compat "8.3"). +Notation Ncompare := N.compare (compat "8.3"). +Notation Nlt := N.lt (compat "8.3"). +Notation Ngt := N.gt (compat "8.3"). +Notation Nle := N.le (compat "8.3"). +Notation Nge := N.ge (compat "8.3"). +Notation Nmin := N.min (compat "8.3"). +Notation Nmax := N.max (compat "8.3"). +Notation Ndiv2 := N.div2 (compat "8.3"). +Notation Neven := N.even (compat "8.3"). +Notation Nodd := N.odd (compat "8.3"). +Notation Npow := N.pow (compat "8.3"). +Notation Nlog2 := N.log2 (compat "8.3"). + +Notation nat_of_N := N.to_nat (compat "8.3"). +Notation N_of_nat := N.of_nat (compat "8.3"). +Notation N_eq_dec := N.eq_dec (compat "8.3"). +Notation Nrect := N.peano_rect (compat "8.3"). +Notation Nrect_base := N.peano_rect_base (compat "8.3"). +Notation Nrect_step := N.peano_rect_succ (compat "8.3"). +Notation Nind := N.peano_ind (compat "8.3"). +Notation Nrec := N.peano_rec (compat "8.3"). +Notation Nrec_base := N.peano_rec_base (compat "8.3"). +Notation Nrec_succ := N.peano_rec_succ (compat "8.3"). + +Notation Npred_succ := N.pred_succ (compat "8.3"). +Notation Npred_minus := N.pred_sub (compat "8.3"). +Notation Nsucc_pred := N.succ_pred (compat "8.3"). +Notation Ppred_N_spec := N.pos_pred_spec (compat "8.3"). +Notation Nsucc_pos_spec := N.succ_pos_spec (compat "8.3"). +Notation Ppred_Nsucc := N.pos_pred_succ (compat "8.3"). +Notation Nplus_0_l := N.add_0_l (compat "8.3"). +Notation Nplus_0_r := N.add_0_r (compat "8.3"). +Notation Nplus_comm := N.add_comm (compat "8.3"). +Notation Nplus_assoc := N.add_assoc (compat "8.3"). +Notation Nplus_succ := N.add_succ_l (compat "8.3"). +Notation Nsucc_0 := N.succ_0_discr (compat "8.3"). +Notation Nsucc_inj := N.succ_inj (compat "8.3"). +Notation Nminus_N0_Nle := N.sub_0_le (compat "8.3"). +Notation Nminus_0_r := N.sub_0_r (compat "8.3"). +Notation Nminus_succ_r:= N.sub_succ_r (compat "8.3"). +Notation Nmult_0_l := N.mul_0_l (compat "8.3"). +Notation Nmult_1_l := N.mul_1_l (compat "8.3"). +Notation Nmult_1_r := N.mul_1_r (compat "8.3"). +Notation Nmult_comm := N.mul_comm (compat "8.3"). +Notation Nmult_assoc := N.mul_assoc (compat "8.3"). +Notation Nmult_plus_distr_r := N.mul_add_distr_r (compat "8.3"). +Notation Neqb_eq := N.eqb_eq (compat "8.3"). +Notation Nle_0 := N.le_0_l (compat "8.3"). +Notation Ncompare_refl := N.compare_refl (compat "8.3"). +Notation Ncompare_Eq_eq := N.compare_eq (compat "8.3"). +Notation Ncompare_eq_correct := N.compare_eq_iff (compat "8.3"). +Notation Nlt_irrefl := N.lt_irrefl (compat "8.3"). +Notation Nlt_trans := N.lt_trans (compat "8.3"). +Notation Nle_lteq := N.lt_eq_cases (compat "8.3"). +Notation Nlt_succ_r := N.lt_succ_r (compat "8.3"). +Notation Nle_trans := N.le_trans (compat "8.3"). +Notation Nle_succ_l := N.le_succ_l (compat "8.3"). +Notation Ncompare_spec := N.compare_spec (compat "8.3"). +Notation Ncompare_0 := N.compare_0_r (compat "8.3"). +Notation Ndouble_div2 := N.div2_double (compat "8.3"). +Notation Ndouble_plus_one_div2 := N.div2_succ_double (compat "8.3"). +Notation Ndouble_inj := N.double_inj (compat "8.3"). +Notation Ndouble_plus_one_inj := N.succ_double_inj (compat "8.3"). +Notation Npow_0_r := N.pow_0_r (compat "8.3"). +Notation Npow_succ_r := N.pow_succ_r (compat "8.3"). +Notation Nlog2_spec := N.log2_spec (compat "8.3"). +Notation Nlog2_nonpos := N.log2_nonpos (compat "8.3"). +Notation Neven_spec := N.even_spec (compat "8.3"). +Notation Nodd_spec := N.odd_spec (compat "8.3"). +Notation Nlt_not_eq := N.lt_neq (compat "8.3"). +Notation Ngt_Nlt := N.gt_lt (compat "8.3"). (** More complex compatibility facts, expressed as lemmas (to preserve scopes for instance) *) diff --git a/theories/NArith/BinNatDef.v b/theories/NArith/BinNatDef.v index d7660422..08e1138f 100644 --- a/theories/NArith/BinNatDef.v +++ b/theories/NArith/BinNatDef.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -19,6 +19,10 @@ Module N. Definition t := N. +(** ** Nicer name [N.pos] for contructor [Npos] *) + +Notation pos := Npos. + (** ** Constants *) Definition zero := 0. @@ -30,7 +34,7 @@ Definition two := 2. Definition succ_double x := match x with | 0 => 1 - | Npos p => Npos p~1 + | pos p => pos p~1 end. (** ** Operation [x -> 2*x] *) @@ -38,7 +42,7 @@ Definition succ_double x := Definition double n := match n with | 0 => 0 - | Npos p => Npos p~0 + | pos p => pos p~0 end. (** ** Successor *) @@ -46,7 +50,7 @@ Definition double n := Definition succ n := match n with | 0 => 1 - | Npos p => Npos (Pos.succ p) + | pos p => pos (Pos.succ p) end. (** ** Predecessor *) @@ -54,15 +58,15 @@ Definition succ n := Definition pred n := match n with | 0 => 0 - | Npos p => Pos.pred_N p + | pos p => Pos.pred_N p end. (** ** The successor of a [N] can be seen as a [positive] *) Definition succ_pos (n : N) : positive := match n with - | N0 => 1%positive - | Npos p => Pos.succ p + | 0 => 1%positive + | pos p => Pos.succ p end. (** ** Addition *) @@ -71,7 +75,7 @@ Definition add n m := match n, m with | 0, _ => m | _, 0 => n - | Npos p, Npos q => Npos (p + q) + | pos p, pos q => pos (p + q) end. Infix "+" := add : N_scope. @@ -82,9 +86,9 @@ Definition sub n m := match n, m with | 0, _ => 0 | n, 0 => n -| Npos n', Npos m' => +| pos n', pos m' => match Pos.sub_mask n' m' with - | IsPos p => Npos p + | IsPos p => pos p | _ => 0 end end. @@ -97,7 +101,7 @@ Definition mul n m := match n, m with | 0, _ => 0 | _, 0 => 0 - | Npos p, Npos q => Npos (p * q) + | pos p, pos q => pos (p * q) end. Infix "*" := mul : N_scope. @@ -107,23 +111,19 @@ Infix "*" := mul : N_scope. Definition compare n m := match n, m with | 0, 0 => Eq - | 0, Npos m' => Lt - | Npos n', 0 => Gt - | Npos n', Npos m' => (n' ?= m')%positive + | 0, pos m' => Lt + | pos n', 0 => Gt + | pos n', pos m' => (n' ?= m')%positive end. Infix "?=" := compare (at level 70, no associativity) : N_scope. (** Boolean equality and comparison *) -(** Nota: this [eqb] is not convertible with the generated [N_beq], - since the underlying [Pos.eqb] differs from [positive_beq] - (cf BinIntDef). *) - Fixpoint eqb n m := match n, m with | 0, 0 => true - | Npos p, Npos q => Pos.eqb p q + | pos p, pos q => Pos.eqb p q | _, _ => false end. @@ -155,8 +155,8 @@ Definition div2 n := match n with | 0 => 0 | 1 => 0 - | Npos (p~0) => Npos p - | Npos (p~1) => Npos p + | pos (p~0) => pos p + | pos (p~1) => pos p end. (** Parity *) @@ -164,7 +164,7 @@ Definition div2 n := Definition even n := match n with | 0 => true - | Npos (xO _) => true + | pos (xO _) => true | _ => false end. @@ -176,7 +176,7 @@ Definition pow n p := match p, n with | 0, _ => 1 | _, 0 => 0 - | Npos p, Npos q => Npos (q^p) + | pos p, pos q => pos (q^p) end. Infix "^" := pow : N_scope. @@ -186,7 +186,7 @@ Infix "^" := pow : N_scope. Definition square n := match n with | 0 => 0 - | Npos p => Npos (Pos.square p) + | pos p => pos (Pos.square p) end. (** Base-2 logarithm *) @@ -195,8 +195,8 @@ Definition log2 n := match n with | 0 => 0 | 1 => 0 - | Npos (p~0) => Npos (Pos.size p) - | Npos (p~1) => Npos (Pos.size p) + | pos (p~0) => pos (Pos.size p) + | pos (p~1) => pos (Pos.size p) end. (** How many digits in a number ? @@ -206,13 +206,13 @@ Definition log2 n := Definition size n := match n with | 0 => 0 - | Npos p => Npos (Pos.size p) + | pos p => pos (Pos.size p) end. Definition size_nat n := match n with | 0 => O - | Npos p => Pos.size_nat p + | pos p => Pos.size_nat p end. (** Euclidean division *) @@ -237,7 +237,7 @@ Definition div_eucl (a b:N) : N * N := match a, b with | 0, _ => (0, 0) | _, 0 => (0, a) - | Npos na, _ => pos_div_eucl na b + | pos na, _ => pos_div_eucl na b end. Definition div a b := fst (div_eucl a b). @@ -252,7 +252,7 @@ Definition gcd a b := match a, b with | 0, _ => b | _, 0 => a - | Npos p, Npos q => Npos (Pos.gcd p q) + | pos p, pos q => pos (Pos.gcd p q) end. (** Generalized Gcd, also computing rests of [a] and [b] after @@ -262,9 +262,9 @@ Definition ggcd a b := match a, b with | 0, _ => (b,(0,1)) | _, 0 => (a,(1,0)) - | Npos p, Npos q => + | pos p, pos q => let '(g,(aa,bb)) := Pos.ggcd p q in - (Npos g, (Npos aa, Npos bb)) + (pos g, (pos aa, pos bb)) end. (** Square root *) @@ -272,17 +272,17 @@ Definition ggcd a b := Definition sqrtrem n := match n with | 0 => (0, 0) - | Npos p => + | pos p => match Pos.sqrtrem p with - | (s, IsPos r) => (Npos s, Npos r) - | (s, _) => (Npos s, 0) + | (s, IsPos r) => (pos s, pos r) + | (s, _) => (pos s, 0) end end. Definition sqrt n := match n with | 0 => 0 - | Npos p => Npos (Pos.sqrt p) + | pos p => pos (Pos.sqrt p) end. (** Operation over bits of a [N] number. *) @@ -293,7 +293,7 @@ Definition lor n m := match n, m with | 0, _ => m | _, 0 => n - | Npos p, Npos q => Npos (Pos.lor p q) + | pos p, pos q => pos (Pos.lor p q) end. (** Logical [and] *) @@ -302,7 +302,7 @@ Definition land n m := match n, m with | 0, _ => 0 | _, 0 => 0 - | Npos p, Npos q => Pos.land p q + | pos p, pos q => Pos.land p q end. (** Logical [diff] *) @@ -311,7 +311,7 @@ Fixpoint ldiff n m := match n, m with | 0, _ => 0 | _, 0 => n - | Npos p, Npos q => Pos.ldiff p q + | pos p, pos q => Pos.ldiff p q end. (** [xor] *) @@ -320,7 +320,7 @@ Definition lxor n m := match n, m with | 0, _ => m | _, 0 => n - | Npos p, Npos q => Pos.lxor p q + | pos p, pos q => Pos.lxor p q end. (** Shifts *) @@ -331,13 +331,13 @@ Definition shiftr_nat (a:N)(n:nat) := nat_iter n div2 a. Definition shiftl a n := match a with | 0 => 0 - | Npos a => Npos (Pos.shiftl a n) + | pos a => pos (Pos.shiftl a n) end. Definition shiftr a n := match n with | 0 => a - | Npos p => Pos.iter p div2 a + | pos p => Pos.iter p div2 a end. (** Checking whether a particular bit is set or not *) @@ -345,7 +345,7 @@ Definition shiftr a n := Definition testbit_nat (a:N) := match a with | 0 => fun _ => false - | Npos p => Pos.testbit_nat p + | pos p => Pos.testbit_nat p end. (** Same, but with index in N *) @@ -353,7 +353,7 @@ Definition testbit_nat (a:N) := Definition testbit a n := match a with | 0 => false - | Npos p => Pos.testbit p n + | pos p => Pos.testbit p n end. (** Translation from [N] to [nat] and back. *) @@ -361,13 +361,13 @@ Definition testbit a n := Definition to_nat (a:N) := match a with | 0 => O - | Npos p => Pos.to_nat p + | pos p => Pos.to_nat p end. Definition of_nat (n:nat) := match n with | O => 0 - | S n' => Npos (Pos.of_succ_nat n') + | S n' => pos (Pos.of_succ_nat n') end. (** Iteration of a function *) @@ -375,7 +375,7 @@ Definition of_nat (n:nat) := Definition iter (n:N) {A} (f:A->A) (x:A) : A := match n with | 0 => x - | Npos p => Pos.iter p f x + | pos p => Pos.iter p f x end. End N.
\ No newline at end of file diff --git a/theories/NArith/NArith.v b/theories/NArith/NArith.v index 4a5f4ee1..d0664d37 100644 --- a/theories/NArith/NArith.v +++ b/theories/NArith/NArith.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/NArith/Ndec.v b/theories/NArith/Ndec.v index f2ee29cc..f8db7548 100644 --- a/theories/NArith/Ndec.v +++ b/theories/NArith/Ndec.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -15,315 +15,238 @@ Require Import Pnat. Require Import Nnat. Require Import Ndigits. -(** A boolean equality over [N] *) +Local Open Scope N_scope. -Notation Peqb := Peqb (only parsing). (* Now in [BinPos] *) -Notation Neqb := Neqb (only parsing). (* Now in [BinNat] *) +(** Obsolete results about boolean comparisons over [N], + kept for compatibility with IntMap and SMC. *) -Notation Peqb_correct := Peqb_refl (only parsing). +Notation Peqb := Pos.eqb (compat "8.3"). +Notation Neqb := N.eqb (compat "8.3"). +Notation Peqb_correct := Pos.eqb_refl (compat "8.3"). +Notation Neqb_correct := N.eqb_refl (compat "8.3"). +Notation Neqb_comm := N.eqb_sym (compat "8.3"). -Lemma Peqb_complete : forall p p', Peqb p p' = true -> p = p'. -Proof. - intros. now apply (Peqb_eq p p'). -Qed. +Lemma Peqb_complete p p' : Pos.eqb p p' = true -> p = p'. +Proof. now apply Pos.eqb_eq. Qed. -Lemma Peqb_Pcompare : forall p p', Peqb p p' = true -> Pos.compare p p' = Eq. -Proof. - intros. now rewrite Pos.compare_eq_iff, <- Peqb_eq. -Qed. - -Lemma Pcompare_Peqb : forall p p', Pos.compare p p' = Eq -> Peqb p p' = true. -Proof. - intros; now rewrite Peqb_eq, <- Pos.compare_eq_iff. -Qed. +Lemma Peqb_Pcompare p p' : Pos.eqb p p' = true -> Pos.compare p p' = Eq. +Proof. now rewrite Pos.compare_eq_iff, <- Pos.eqb_eq. Qed. -Lemma Neqb_correct : forall n, Neqb n n = true. -Proof. - intros; now rewrite Neqb_eq. -Qed. +Lemma Pcompare_Peqb p p' : Pos.compare p p' = Eq -> Pos.eqb p p' = true. +Proof. now rewrite Pos.eqb_eq, <- Pos.compare_eq_iff. Qed. -Lemma Neqb_Ncompare : forall n n', Neqb n n' = true -> Ncompare n n' = Eq. -Proof. - intros; now rewrite Ncompare_eq_correct, <- Neqb_eq. -Qed. +Lemma Neqb_Ncompare n n' : N.eqb n n' = true -> N.compare n n' = Eq. +Proof. now rewrite N.compare_eq_iff, <- N.eqb_eq. Qed. -Lemma Ncompare_Neqb : forall n n', Ncompare n n' = Eq -> Neqb n n' = true. -Proof. - intros; now rewrite Neqb_eq, <- Ncompare_eq_correct. -Qed. +Lemma Ncompare_Neqb n n' : N.compare n n' = Eq -> N.eqb n n' = true. +Proof. now rewrite N.eqb_eq, <- N.compare_eq_iff. Qed. -Lemma Neqb_complete : forall a a', Neqb a a' = true -> a = a'. -Proof. - intros; now rewrite <- Neqb_eq. -Qed. +Lemma Neqb_complete n n' : N.eqb n n' = true -> n = n'. +Proof. now apply N.eqb_eq. Qed. -Lemma Neqb_comm : forall a a', Neqb a a' = Neqb a' a. +Lemma Nxor_eq_true n n' : N.lxor n n' = 0 -> N.eqb n n' = true. Proof. - intros; apply eq_true_iff_eq. rewrite 2 Neqb_eq; auto with *. + intro H. apply N.lxor_eq in H. subst. apply N.eqb_refl. Qed. -Lemma Nxor_eq_true : - forall a a', Nxor a a' = N0 -> Neqb a a' = true. -Proof. - intros. rewrite (Nxor_eq a a' H). apply Neqb_correct. -Qed. +Ltac eqb2eq := rewrite <- ?not_true_iff_false in *; rewrite ?N.eqb_eq in *. -Lemma Nxor_eq_false : - forall a a' p, Nxor a a' = Npos p -> Neqb a a' = false. +Lemma Nxor_eq_false n n' p : + N.lxor n n' = N.pos p -> N.eqb n n' = false. Proof. - intros. elim (sumbool_of_bool (Neqb a a')). intro H0. - rewrite (Neqb_complete a a' H0) in H. - rewrite (Nxor_nilpotent a') in H. discriminate H. - trivial. + intros. eqb2eq. intro. subst. now rewrite N.lxor_nilpotent in *. Qed. -Lemma Nodd_not_double : - forall a, - Nodd a -> forall a0, Neqb (Ndouble a0) a = false. +Lemma Nodd_not_double a : + Nodd a -> forall a0, N.eqb (N.double a0) a = false. Proof. - intros. elim (sumbool_of_bool (Neqb (Ndouble a0) a)). intro H0. - rewrite <- (Neqb_complete _ _ H0) in H. - unfold Nodd in H. - rewrite (Ndouble_bit0 a0) in H. discriminate H. - trivial. + intros. eqb2eq. intros <-. + unfold Nodd in *. now rewrite Ndouble_bit0 in *. Qed. -Lemma Nnot_div2_not_double : - forall a a0, - Neqb (Ndiv2 a) a0 = false -> Neqb a (Ndouble a0) = false. +Lemma Nnot_div2_not_double a a0 : + N.eqb (N.div2 a) a0 = false -> N.eqb a (N.double a0) = false. Proof. - intros. elim (sumbool_of_bool (Neqb (Ndouble a0) a)). intro H0. - rewrite <- (Neqb_complete _ _ H0) in H. rewrite (Ndouble_div2 a0) in H. - rewrite (Neqb_correct a0) in H. discriminate H. - intro. rewrite Neqb_comm. assumption. + intros H. eqb2eq. contradict H. subst. apply N.div2_double. Qed. -Lemma Neven_not_double_plus_one : - forall a, - Neven a -> forall a0, Neqb (Ndouble_plus_one a0) a = false. +Lemma Neven_not_double_plus_one a : + Neven a -> forall a0, N.eqb (N.succ_double a0) a = false. Proof. - intros. elim (sumbool_of_bool (Neqb (Ndouble_plus_one a0) a)). intro H0. - rewrite <- (Neqb_complete _ _ H0) in H. - unfold Neven in H. - rewrite (Ndouble_plus_one_bit0 a0) in H. - discriminate H. - trivial. + intros. eqb2eq. intros <-. + unfold Neven in *. now rewrite Ndouble_plus_one_bit0 in *. Qed. -Lemma Nnot_div2_not_double_plus_one : - forall a a0, - Neqb (Ndiv2 a) a0 = false -> Neqb (Ndouble_plus_one a0) a = false. +Lemma Nnot_div2_not_double_plus_one a a0 : + N.eqb (N.div2 a) a0 = false -> N.eqb (N.succ_double a0) a = false. Proof. - intros. elim (sumbool_of_bool (Neqb a (Ndouble_plus_one a0))). intro H0. - rewrite (Neqb_complete _ _ H0) in H. rewrite (Ndouble_plus_one_div2 a0) in H. - rewrite (Neqb_correct a0) in H. discriminate H. - intro H0. rewrite Neqb_comm. assumption. + intros H. eqb2eq. contradict H. subst. apply N.div2_succ_double. Qed. -Lemma Nbit0_neq : - forall a a', - Nbit0 a = false -> Nbit0 a' = true -> Neqb a a' = false. +Lemma Nbit0_neq a a' : + N.odd a = false -> N.odd a' = true -> N.eqb a a' = false. Proof. - intros. elim (sumbool_of_bool (Neqb a a')). intro H1. - rewrite (Neqb_complete _ _ H1) in H. - rewrite H in H0. discriminate H0. - trivial. + intros. eqb2eq. now intros <-. Qed. -Lemma Ndiv2_eq : - forall a a', Neqb a a' = true -> Neqb (Ndiv2 a) (Ndiv2 a') = true. +Lemma Ndiv2_eq a a' : + N.eqb a a' = true -> N.eqb (N.div2 a) (N.div2 a') = true. Proof. - intros. cut (a = a'). intros. rewrite H0. apply Neqb_correct. - apply Neqb_complete. exact H. + intros. eqb2eq. now subst. Qed. -Lemma Ndiv2_neq : - forall a a', - Neqb (Ndiv2 a) (Ndiv2 a') = false -> Neqb a a' = false. +Lemma Ndiv2_neq a a' : + N.eqb (N.div2 a) (N.div2 a') = false -> N.eqb a a' = false. Proof. - intros. elim (sumbool_of_bool (Neqb a a')). intro H0. - rewrite (Neqb_complete _ _ H0) in H. - rewrite (Neqb_correct (Ndiv2 a')) in H. discriminate H. - trivial. + intros H. eqb2eq. contradict H. now subst. Qed. -Lemma Ndiv2_bit_eq : - forall a a', - Nbit0 a = Nbit0 a' -> Ndiv2 a = Ndiv2 a' -> a = a'. +Lemma Ndiv2_bit_eq a a' : + N.odd a = N.odd a' -> N.div2 a = N.div2 a' -> a = a'. Proof. - intros. apply Nbit_faithful. unfold eqf in |- *. destruct n. - rewrite Nbit0_correct. rewrite Nbit0_correct. assumption. - rewrite <- Ndiv2_correct. rewrite <- Ndiv2_correct. - rewrite H0. reflexivity. + intros H H'; now rewrite (N.div2_odd a), (N.div2_odd a'), H, H'. Qed. -Lemma Ndiv2_bit_neq : - forall a a', - Neqb a a' = false -> - Nbit0 a = Nbit0 a' -> Neqb (Ndiv2 a) (Ndiv2 a') = false. +Lemma Ndiv2_bit_neq a a' : + N.eqb a a' = false -> + N.odd a = N.odd a' -> N.eqb (N.div2 a) (N.div2 a') = false. Proof. - intros. elim (sumbool_of_bool (Neqb (Ndiv2 a) (Ndiv2 a'))). intro H1. - rewrite (Ndiv2_bit_eq _ _ H0 (Neqb_complete _ _ H1)) in H. - rewrite (Neqb_correct a') in H. discriminate H. - trivial. + intros H H'. eqb2eq. contradict H. now apply Ndiv2_bit_eq. Qed. -Lemma Nneq_elim : - forall a a', - Neqb a a' = false -> - Nbit0 a = negb (Nbit0 a') \/ - Neqb (Ndiv2 a) (Ndiv2 a') = false. +Lemma Nneq_elim a a' : + N.eqb a a' = false -> + N.odd a = negb (N.odd a') \/ + N.eqb (N.div2 a) (N.div2 a') = false. Proof. - intros. cut (Nbit0 a = Nbit0 a' \/ Nbit0 a = negb (Nbit0 a')). + intros. cut (N.odd a = N.odd a' \/ N.odd a = negb (N.odd a')). intros. elim H0. intro. right. apply Ndiv2_bit_neq. assumption. assumption. intro. left. assumption. - case (Nbit0 a); case (Nbit0 a'); auto. + case (N.odd a), (N.odd a'); auto. Qed. -Lemma Ndouble_or_double_plus_un : - forall a, - {a0 : N | a = Ndouble a0} + {a1 : N | a = Ndouble_plus_one a1}. +Lemma Ndouble_or_double_plus_un a : + {a0 : N | a = N.double a0} + {a1 : N | a = N.succ_double a1}. Proof. - intro. elim (sumbool_of_bool (Nbit0 a)). intro H. right. split with (Ndiv2 a). - rewrite (Ndiv2_double_plus_one a H). reflexivity. - intro H. left. split with (Ndiv2 a). rewrite (Ndiv2_double a H). reflexivity. + elim (sumbool_of_bool (N.odd a)); intros H; [right|left]; + exists (N.div2 a); symmetry; + apply Ndiv2_double_plus_one || apply Ndiv2_double; auto. Qed. -(** A boolean order on [N] *) +(** An inefficient boolean order on [N]. Please use [N.leb] instead now. *) -Definition Nleb (a b:N) := leb (nat_of_N a) (nat_of_N b). +Definition Nleb (a b:N) := leb (N.to_nat a) (N.to_nat b). -Lemma Nleb_Nle : forall a b, Nleb a b = true <-> Nle a b. +Lemma Nleb_alt a b : Nleb a b = N.leb a b. Proof. - intros; unfold Nle; rewrite nat_of_Ncompare. - unfold Nleb; apply leb_compare. + unfold Nleb. + now rewrite eq_iff_eq_true, N.leb_le, leb_compare, <- N2Nat.inj_compare. Qed. -Lemma Nleb_refl : forall a, Nleb a a = true. -Proof. - intro. unfold Nleb in |- *. apply leb_correct. apply le_n. -Qed. +Lemma Nleb_Nle a b : Nleb a b = true <-> a <= b. +Proof. now rewrite Nleb_alt, N.leb_le. Qed. -Lemma Nleb_antisym : - forall a b, Nleb a b = true -> Nleb b a = true -> a = b. -Proof. - unfold Nleb in |- *. intros. rewrite <- (N_of_nat_of_N a). rewrite <- (N_of_nat_of_N b). - rewrite (le_antisym _ _ (leb_complete _ _ H) (leb_complete _ _ H0)). reflexivity. -Qed. +Lemma Nleb_refl a : Nleb a a = true. +Proof. rewrite Nleb_Nle; apply N.le_refl. Qed. -Lemma Nleb_trans : - forall a b c, Nleb a b = true -> Nleb b c = true -> Nleb a c = true. -Proof. - unfold Nleb in |- *. intros. apply leb_correct. apply le_trans with (m := nat_of_N b). - apply leb_complete. assumption. - apply leb_complete. assumption. -Qed. +Lemma Nleb_antisym a b : Nleb a b = true -> Nleb b a = true -> a = b. +Proof. rewrite !Nleb_Nle. apply N.le_antisymm. Qed. + +Lemma Nleb_trans a b c : Nleb a b = true -> Nleb b c = true -> Nleb a c = true. +Proof. rewrite !Nleb_Nle. apply N.le_trans. Qed. -Lemma Nleb_ltb_trans : - forall a b c, - Nleb a b = true -> Nleb c b = false -> Nleb c a = false. +Lemma Nleb_ltb_trans a b c : + Nleb a b = true -> Nleb c b = false -> Nleb c a = false. Proof. - unfold Nleb in |- *. intros. apply leb_correct_conv. apply le_lt_trans with (m := nat_of_N b). + unfold Nleb. intros. apply leb_correct_conv. + apply le_lt_trans with (m := N.to_nat b). apply leb_complete. assumption. apply leb_complete_conv. assumption. Qed. -Lemma Nltb_leb_trans : - forall a b c, - Nleb b a = false -> Nleb b c = true -> Nleb c a = false. +Lemma Nltb_leb_trans a b c : + Nleb b a = false -> Nleb b c = true -> Nleb c a = false. Proof. - unfold Nleb in |- *. intros. apply leb_correct_conv. apply lt_le_trans with (m := nat_of_N b). + unfold Nleb. intros. apply leb_correct_conv. + apply lt_le_trans with (m := N.to_nat b). apply leb_complete_conv. assumption. apply leb_complete. assumption. Qed. -Lemma Nltb_trans : - forall a b c, - Nleb b a = false -> Nleb c b = false -> Nleb c a = false. +Lemma Nltb_trans a b c : + Nleb b a = false -> Nleb c b = false -> Nleb c a = false. Proof. - unfold Nleb in |- *. intros. apply leb_correct_conv. apply lt_trans with (m := nat_of_N b). + unfold Nleb. intros. apply leb_correct_conv. + apply lt_trans with (m := N.to_nat b). apply leb_complete_conv. assumption. apply leb_complete_conv. assumption. Qed. -Lemma Nltb_leb_weak : forall a b:N, Nleb b a = false -> Nleb a b = true. +Lemma Nltb_leb_weak a b : Nleb b a = false -> Nleb a b = true. Proof. - unfold Nleb in |- *. intros. apply leb_correct. apply lt_le_weak. + unfold Nleb. intros. apply leb_correct. apply lt_le_weak. apply leb_complete_conv. assumption. Qed. -Lemma Nleb_double_mono : - forall a b, - Nleb a b = true -> Nleb (Ndouble a) (Ndouble b) = true. +Lemma Nleb_double_mono a b : + Nleb a b = true -> Nleb (N.double a) (N.double b) = true. Proof. - unfold Nleb in |- *. intros. rewrite nat_of_Ndouble. rewrite nat_of_Ndouble. apply leb_correct. - simpl in |- *. apply plus_le_compat. apply leb_complete. assumption. - apply plus_le_compat. apply leb_complete. assumption. - apply le_n. + unfold Nleb. intros. rewrite !N2Nat.inj_double. apply leb_correct. + apply mult_le_compat_l. now apply leb_complete. Qed. -Lemma Nleb_double_plus_one_mono : - forall a b, - Nleb a b = true -> - Nleb (Ndouble_plus_one a) (Ndouble_plus_one b) = true. +Lemma Nleb_double_plus_one_mono a b : + Nleb a b = true -> + Nleb (N.succ_double a) (N.succ_double b) = true. Proof. - unfold Nleb in |- *. intros. rewrite nat_of_Ndouble_plus_one. rewrite nat_of_Ndouble_plus_one. - apply leb_correct. apply le_n_S. simpl in |- *. apply plus_le_compat. apply leb_complete. - assumption. - apply plus_le_compat. apply leb_complete. assumption. - apply le_n. + unfold Nleb. intros. rewrite !N2Nat.inj_succ_double. apply leb_correct. + apply le_n_S, mult_le_compat_l. now apply leb_complete. Qed. -Lemma Nleb_double_mono_conv : - forall a b, - Nleb (Ndouble a) (Ndouble b) = true -> Nleb a b = true. +Lemma Nleb_double_mono_conv a b : + Nleb (N.double a) (N.double b) = true -> Nleb a b = true. Proof. - unfold Nleb in |- *. intros a b. rewrite nat_of_Ndouble. rewrite nat_of_Ndouble. intro. - apply leb_correct. apply (mult_S_le_reg_l 1). apply leb_complete. assumption. + unfold Nleb. rewrite !N2Nat.inj_double. intro. apply leb_correct. + apply (mult_S_le_reg_l 1). now apply leb_complete. Qed. -Lemma Nleb_double_plus_one_mono_conv : - forall a b, - Nleb (Ndouble_plus_one a) (Ndouble_plus_one b) = true -> +Lemma Nleb_double_plus_one_mono_conv a b : + Nleb (N.succ_double a) (N.succ_double b) = true -> Nleb a b = true. Proof. - unfold Nleb in |- *. intros a b. rewrite nat_of_Ndouble_plus_one. rewrite nat_of_Ndouble_plus_one. - intro. apply leb_correct. apply (mult_S_le_reg_l 1). apply le_S_n. apply leb_complete. - assumption. + unfold Nleb. rewrite !N2Nat.inj_succ_double. intro. apply leb_correct. + apply (mult_S_le_reg_l 1). apply le_S_n. now apply leb_complete. Qed. -Lemma Nltb_double_mono : - forall a b, - Nleb a b = false -> Nleb (Ndouble a) (Ndouble b) = false. +Lemma Nltb_double_mono a b : + Nleb a b = false -> Nleb (N.double a) (N.double b) = false. Proof. - intros. elim (sumbool_of_bool (Nleb (Ndouble a) (Ndouble b))). intro H0. + intros. elim (sumbool_of_bool (Nleb (N.double a) (N.double b))). intro H0. rewrite (Nleb_double_mono_conv _ _ H0) in H. discriminate H. trivial. Qed. -Lemma Nltb_double_plus_one_mono : - forall a b, - Nleb a b = false -> - Nleb (Ndouble_plus_one a) (Ndouble_plus_one b) = false. +Lemma Nltb_double_plus_one_mono a b : + Nleb a b = false -> + Nleb (N.succ_double a) (N.succ_double b) = false. Proof. - intros. elim (sumbool_of_bool (Nleb (Ndouble_plus_one a) (Ndouble_plus_one b))). intro H0. + intros. elim (sumbool_of_bool (Nleb (N.succ_double a) (N.succ_double b))). + intro H0. rewrite (Nleb_double_plus_one_mono_conv _ _ H0) in H. discriminate H. trivial. Qed. -Lemma Nltb_double_mono_conv : - forall a b, - Nleb (Ndouble a) (Ndouble b) = false -> Nleb a b = false. +Lemma Nltb_double_mono_conv a b : + Nleb (N.double a) (N.double b) = false -> Nleb a b = false. Proof. - intros. elim (sumbool_of_bool (Nleb a b)). intro H0. rewrite (Nleb_double_mono _ _ H0) in H. - discriminate H. + intros. elim (sumbool_of_bool (Nleb a b)). intro H0. + rewrite (Nleb_double_mono _ _ H0) in H. discriminate H. trivial. Qed. -Lemma Nltb_double_plus_one_mono_conv : - forall a b, - Nleb (Ndouble_plus_one a) (Ndouble_plus_one b) = false -> +Lemma Nltb_double_plus_one_mono_conv a b : + Nleb (N.succ_double a) (N.succ_double b) = false -> Nleb a b = false. Proof. intros. elim (sumbool_of_bool (Nleb a b)). intro H0. @@ -331,110 +254,52 @@ Proof. trivial. Qed. -(* Nleb and Ncompare *) +(* Nleb and N.compare *) -(* NB: No need to prove that Nleb a b = true <-> Ncompare a b <> Gt, +(* NB: No need to prove that Nleb a b = true <-> N.compare a b <> Gt, this statement is in fact Nleb_Nle! *) -Lemma Nltb_Ncompare : forall a b, - Nleb a b = false <-> Ncompare a b = Gt. +Lemma Nltb_Ncompare a b : Nleb a b = false <-> N.compare a b = Gt. Proof. - intros. - assert (IFF : forall x:bool, x = false <-> ~ x = true) - by (destruct x; intuition). - rewrite IFF, Nleb_Nle; unfold Nle. - destruct (Ncompare a b); split; intro H; auto; - elim H; discriminate. + now rewrite N.compare_nle_iff, <- Nleb_Nle, not_true_iff_false. Qed. -Lemma Ncompare_Gt_Nltb : forall a b, - Ncompare a b = Gt -> Nleb a b = false. -Proof. - intros; apply <- Nltb_Ncompare; auto. -Qed. +Lemma Ncompare_Gt_Nltb a b : N.compare a b = Gt -> Nleb a b = false. +Proof. apply <- Nltb_Ncompare; auto. Qed. -Lemma Ncompare_Lt_Nltb : forall a b, - Ncompare a b = Lt -> Nleb b a = false. +Lemma Ncompare_Lt_Nltb a b : N.compare a b = Lt -> Nleb b a = false. Proof. - intros a b H. - rewrite Nltb_Ncompare, <- Ncompare_antisym, H; auto. + intros H. rewrite Nltb_Ncompare, N.compare_antisym, H; auto. Qed. -(* An alternate [min] function over [N] *) +(* Old results about [N.min] *) -Definition Nmin' (a b:N) := if Nleb a b then a else b. +Notation Nmin_choice := N.min_dec (compat "8.3"). -Lemma Nmin_Nmin' : forall a b, Nmin a b = Nmin' a b. -Proof. - unfold Nmin, Nmin', Nleb; intros. - rewrite nat_of_Ncompare. - generalize (leb_compare (nat_of_N a) (nat_of_N b)); - destruct (nat_compare (nat_of_N a) (nat_of_N b)); - destruct (leb (nat_of_N a) (nat_of_N b)); intuition. - lapply H1; intros; discriminate. - lapply H1; intros; discriminate. -Qed. +Lemma Nmin_le_1 a b : Nleb (N.min a b) a = true. +Proof. rewrite Nleb_Nle. apply N.le_min_l. Qed. -Lemma Nmin_choice : forall a b, {Nmin a b = a} + {Nmin a b = b}. -Proof. - unfold Nmin in *; intros; destruct (Ncompare a b); auto. -Qed. +Lemma Nmin_le_2 a b : Nleb (N.min a b) b = true. +Proof. rewrite Nleb_Nle. apply N.le_min_r. Qed. -Lemma Nmin_le_1 : forall a b, Nleb (Nmin a b) a = true. -Proof. - intros; rewrite Nmin_Nmin'. - unfold Nmin'; elim (sumbool_of_bool (Nleb a b)). intro H. rewrite H. - apply Nleb_refl. - intro H. rewrite H. apply Nltb_leb_weak. assumption. -Qed. +Lemma Nmin_le_3 a b c : Nleb a (N.min b c) = true -> Nleb a b = true. +Proof. rewrite !Nleb_Nle. apply N.min_glb_l. Qed. -Lemma Nmin_le_2 : forall a b, Nleb (Nmin a b) b = true. -Proof. - intros; rewrite Nmin_Nmin'. - unfold Nmin'; elim (sumbool_of_bool (Nleb a b)). intro H. rewrite H. assumption. - intro H. rewrite H. apply Nleb_refl. -Qed. +Lemma Nmin_le_4 a b c : Nleb a (N.min b c) = true -> Nleb a c = true. +Proof. rewrite !Nleb_Nle. apply N.min_glb_r. Qed. -Lemma Nmin_le_3 : - forall a b c, Nleb a (Nmin b c) = true -> Nleb a b = true. -Proof. - intros; rewrite Nmin_Nmin' in *. - unfold Nmin' in *; elim (sumbool_of_bool (Nleb b c)). intro H0. rewrite H0 in H. - assumption. - intro H0. rewrite H0 in H. apply Nltb_leb_weak. apply Nleb_ltb_trans with (b := c); assumption. -Qed. +Lemma Nmin_le_5 a b c : + Nleb a b = true -> Nleb a c = true -> Nleb a (N.min b c) = true. +Proof. rewrite !Nleb_Nle. apply N.min_glb. Qed. -Lemma Nmin_le_4 : - forall a b c, Nleb a (Nmin b c) = true -> Nleb a c = true. +Lemma Nmin_lt_3 a b c : Nleb (N.min b c) a = false -> Nleb b a = false. Proof. - intros; rewrite Nmin_Nmin' in *. - unfold Nmin' in *; elim (sumbool_of_bool (Nleb b c)). intro H0. rewrite H0 in H. - apply Nleb_trans with (b := b); assumption. - intro H0. rewrite H0 in H. assumption. -Qed. - -Lemma Nmin_le_5 : - forall a b c, - Nleb a b = true -> Nleb a c = true -> Nleb a (Nmin b c) = true. -Proof. - intros. elim (Nmin_choice b c). intro H1. rewrite H1. assumption. - intro H1. rewrite H1. assumption. -Qed. - -Lemma Nmin_lt_3 : - forall a b c, Nleb (Nmin b c) a = false -> Nleb b a = false. -Proof. - intros; rewrite Nmin_Nmin' in *. - unfold Nmin' in *. intros. elim (sumbool_of_bool (Nleb b c)). intro H0. rewrite H0 in H. - assumption. - intro H0. rewrite H0 in H. apply Nltb_trans with (b := c); assumption. + rewrite <- !not_true_iff_false, !Nleb_Nle. + rewrite N.min_le_iff; auto. Qed. -Lemma Nmin_lt_4 : - forall a b c, Nleb (Nmin b c) a = false -> Nleb c a = false. +Lemma Nmin_lt_4 a b c : Nleb (N.min b c) a = false -> Nleb c a = false. Proof. - intros; rewrite Nmin_Nmin' in *. - unfold Nmin' in *. elim (sumbool_of_bool (Nleb b c)). intro H0. rewrite H0 in H. - apply Nltb_leb_trans with (b := b); assumption. - intro H0. rewrite H0 in H. assumption. + rewrite <- !not_true_iff_false, !Nleb_Nle. + rewrite N.min_le_iff; auto. Qed. diff --git a/theories/NArith/Ndigits.v b/theories/NArith/Ndigits.v index b0c33595..4ea8e1d4 100644 --- a/theories/NArith/Ndigits.v +++ b/theories/NArith/Ndigits.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -15,41 +15,41 @@ Local Open Scope N_scope. (** Compatibility names for some bitwise operations *) -Notation Pxor := Pos.lxor (only parsing). -Notation Nxor := N.lxor (only parsing). -Notation Pbit := Pos.testbit_nat (only parsing). -Notation Nbit := N.testbit_nat (only parsing). +Notation Pxor := Pos.lxor (compat "8.3"). +Notation Nxor := N.lxor (compat "8.3"). +Notation Pbit := Pos.testbit_nat (compat "8.3"). +Notation Nbit := N.testbit_nat (compat "8.3"). -Notation Nxor_eq := N.lxor_eq (only parsing). -Notation Nxor_comm := N.lxor_comm (only parsing). -Notation Nxor_assoc := N.lxor_assoc (only parsing). -Notation Nxor_neutral_left := N.lxor_0_l (only parsing). -Notation Nxor_neutral_right := N.lxor_0_r (only parsing). -Notation Nxor_nilpotent := N.lxor_nilpotent (only parsing). +Notation Nxor_eq := N.lxor_eq (compat "8.3"). +Notation Nxor_comm := N.lxor_comm (compat "8.3"). +Notation Nxor_assoc := N.lxor_assoc (compat "8.3"). +Notation Nxor_neutral_left := N.lxor_0_l (compat "8.3"). +Notation Nxor_neutral_right := N.lxor_0_r (compat "8.3"). +Notation Nxor_nilpotent := N.lxor_nilpotent (compat "8.3"). (** Equivalence of bit-testing functions, either with index in [N] or in [nat]. *) Lemma Ptestbit_Pbit : - forall p n, Pos.testbit p (N.of_nat n) = Pbit p n. + forall p n, Pos.testbit p (N.of_nat n) = Pos.testbit_nat p n. Proof. induction p as [p IH|p IH| ]; intros [|n]; simpl; trivial; - rewrite <- IH; f_equal; rewrite (pred_Sn n) at 2; now rewrite N_of_pred. + rewrite <- IH; f_equal; rewrite (pred_Sn n) at 2; now rewrite Nat2N.inj_pred. Qed. -Lemma Ntestbit_Nbit : forall a n, N.testbit a (N.of_nat n) = Nbit a n. +Lemma Ntestbit_Nbit : forall a n, N.testbit a (N.of_nat n) = N.testbit_nat a n. Proof. destruct a. trivial. apply Ptestbit_Pbit. Qed. Lemma Pbit_Ptestbit : - forall p n, Pbit p (N.to_nat n) = Pos.testbit p n. + forall p n, Pos.testbit_nat p (N.to_nat n) = Pos.testbit p n. Proof. intros; now rewrite <- Ptestbit_Pbit, N2Nat.id. Qed. Lemma Nbit_Ntestbit : - forall a n, Nbit a (N.to_nat n) = N.testbit a n. + forall a n, N.testbit_nat a (N.to_nat n) = N.testbit a n. Proof. destruct a. trivial. apply Pbit_Ptestbit. Qed. @@ -73,7 +73,7 @@ Lemma Nshiftr_nat_equiv : Proof. intros a [|n]; simpl. unfold N.shiftr_nat. trivial. - symmetry. apply iter_nat_of_P. + symmetry. apply Pos2Nat.inj_iter. Qed. Lemma Nshiftr_equiv_nat : @@ -99,7 +99,7 @@ Qed. (** Correctness proofs for shifts, nat version *) Lemma Nshiftr_nat_spec : forall a n m, - Nbit (N.shiftr_nat a n) m = Nbit a (m+n). + N.testbit_nat (N.shiftr_nat a n) m = N.testbit_nat a (m+n). Proof. induction n; intros m. now rewrite <- plus_n_O. @@ -108,7 +108,7 @@ Proof. Qed. Lemma Nshiftl_nat_spec_high : forall a n m, (n<=m)%nat -> - Nbit (N.shiftl_nat a n) m = Nbit a (m-n). + N.testbit_nat (N.shiftl_nat a n) m = N.testbit_nat a (m-n). Proof. induction n; intros m H. now rewrite <- minus_n_O. @@ -118,7 +118,7 @@ Proof. Qed. Lemma Nshiftl_nat_spec_low : forall a n m, (m<n)%nat -> - Nbit (N.shiftl_nat a n) m = false. + N.testbit_nat (N.shiftl_nat a n) m = false. Proof. induction n; intros m H. inversion H. rewrite Nshiftl_nat_S. @@ -151,52 +151,52 @@ Proof. rewrite 2 Pshiftl_nat_S. now f_equal. Qed. -(** Semantics of bitwise operations with respect to [Nbit] *) +(** Semantics of bitwise operations with respect to [N.testbit_nat] *) Lemma Pxor_semantics p p' n : - Nbit (Pos.lxor p p') n = xorb (Pbit p n) (Pbit p' n). + N.testbit_nat (Pos.lxor p p') n = xorb (Pos.testbit_nat p n) (Pos.testbit_nat p' n). Proof. rewrite <- Ntestbit_Nbit, <- !Ptestbit_Pbit. apply N.pos_lxor_spec. Qed. Lemma Nxor_semantics a a' n : - Nbit (N.lxor a a') n = xorb (Nbit a n) (Nbit a' n). + N.testbit_nat (N.lxor a a') n = xorb (N.testbit_nat a n) (N.testbit_nat a' n). Proof. rewrite <- !Ntestbit_Nbit. apply N.lxor_spec. Qed. Lemma Por_semantics p p' n : - Pbit (Pos.lor p p') n = (Pbit p n) || (Pbit p' n). + Pos.testbit_nat (Pos.lor p p') n = (Pos.testbit_nat p n) || (Pos.testbit_nat p' n). Proof. rewrite <- !Ptestbit_Pbit. apply N.pos_lor_spec. Qed. Lemma Nor_semantics a a' n : - Nbit (N.lor a a') n = (Nbit a n) || (Nbit a' n). + N.testbit_nat (N.lor a a') n = (N.testbit_nat a n) || (N.testbit_nat a' n). Proof. rewrite <- !Ntestbit_Nbit. apply N.lor_spec. Qed. Lemma Pand_semantics p p' n : - Nbit (Pos.land p p') n = (Pbit p n) && (Pbit p' n). + N.testbit_nat (Pos.land p p') n = (Pos.testbit_nat p n) && (Pos.testbit_nat p' n). Proof. rewrite <- Ntestbit_Nbit, <- !Ptestbit_Pbit. apply N.pos_land_spec. Qed. Lemma Nand_semantics a a' n : - Nbit (N.land a a') n = (Nbit a n) && (Nbit a' n). + N.testbit_nat (N.land a a') n = (N.testbit_nat a n) && (N.testbit_nat a' n). Proof. rewrite <- !Ntestbit_Nbit. apply N.land_spec. Qed. Lemma Pdiff_semantics p p' n : - Nbit (Pos.ldiff p p') n = (Pbit p n) && negb (Pbit p' n). + N.testbit_nat (Pos.ldiff p p') n = (Pos.testbit_nat p n) && negb (Pos.testbit_nat p' n). Proof. rewrite <- Ntestbit_Nbit, <- !Ptestbit_Pbit. apply N.pos_ldiff_spec. Qed. Lemma Ndiff_semantics a a' n : - Nbit (N.ldiff a a') n = (Nbit a n) && negb (Nbit a' n). + N.testbit_nat (N.ldiff a a') n = (N.testbit_nat a n) && negb (N.testbit_nat a' n). Proof. rewrite <- !Ntestbit_Nbit. apply N.ldiff_spec. Qed. @@ -213,13 +213,13 @@ Local Infix "==" := eqf (at level 70, no associativity). Local Notation Step H := (fun n => H (S n)). -Lemma Pbit_faithful_0 : forall p, ~(Pbit p == (fun _ => false)). +Lemma Pbit_faithful_0 : forall p, ~(Pos.testbit_nat p == (fun _ => false)). Proof. induction p as [p IHp|p IHp| ]; intros H; try discriminate (H O). apply (IHp (Step H)). Qed. -Lemma Pbit_faithful : forall p p', Pbit p == Pbit p' -> p = p'. +Lemma Pbit_faithful : forall p p', Pos.testbit_nat p == Pos.testbit_nat p' -> p = p'. Proof. induction p as [p IHp|p IHp| ]; intros [p'|p'|] H; trivial; try discriminate (H O). @@ -229,7 +229,7 @@ Proof. symmetry in H. destruct (Pbit_faithful_0 _ (Step H)). Qed. -Lemma Nbit_faithful : forall n n', Nbit n == Nbit n' -> n = n'. +Lemma Nbit_faithful : forall n n', N.testbit_nat n == N.testbit_nat n' -> n = n'. Proof. intros [|p] [|p'] H; trivial. symmetry in H. destruct (Pbit_faithful_0 _ H). @@ -237,7 +237,7 @@ Proof. f_equal. apply Pbit_faithful, H. Qed. -Lemma Nbit_faithful_iff : forall n n', Nbit n == Nbit n' <-> n = n'. +Lemma Nbit_faithful_iff : forall n n', N.testbit_nat n == N.testbit_nat n' <-> n = n'. Proof. split. apply Nbit_faithful. intros; now subst. Qed. @@ -247,30 +247,30 @@ Local Close Scope N_scope. (** Checking whether a number is odd, i.e. if its lower bit is set. *) -Notation Nbit0 := N.odd (only parsing). +Notation Nbit0 := N.odd (compat "8.3"). -Definition Nodd (n:N) := Nbit0 n = true. -Definition Neven (n:N) := Nbit0 n = false. +Definition Nodd (n:N) := N.odd n = true. +Definition Neven (n:N) := N.odd n = false. -Lemma Nbit0_correct : forall n:N, Nbit n 0 = Nbit0 n. +Lemma Nbit0_correct : forall n:N, N.testbit_nat n 0 = N.odd n. Proof. destruct n; trivial. destruct p; trivial. Qed. -Lemma Ndouble_bit0 : forall n:N, Nbit0 (Ndouble n) = false. +Lemma Ndouble_bit0 : forall n:N, N.odd (N.double n) = false. Proof. destruct n; trivial. Qed. Lemma Ndouble_plus_one_bit0 : - forall n:N, Nbit0 (Ndouble_plus_one n) = true. + forall n:N, N.odd (N.succ_double n) = true. Proof. destruct n; trivial. Qed. Lemma Ndiv2_double : - forall n:N, Neven n -> Ndouble (Ndiv2 n) = n. + forall n:N, Neven n -> N.double (N.div2 n) = n. Proof. destruct n. trivial. destruct p. intro H. discriminate H. intros. reflexivity. @@ -278,7 +278,7 @@ Proof. Qed. Lemma Ndiv2_double_plus_one : - forall n:N, Nodd n -> Ndouble_plus_one (Ndiv2 n) = n. + forall n:N, Nodd n -> N.succ_double (N.div2 n) = n. Proof. destruct n. intro. discriminate H. destruct p. intros. reflexivity. @@ -287,31 +287,31 @@ Proof. Qed. Lemma Ndiv2_correct : - forall (a:N) (n:nat), Nbit (Ndiv2 a) n = Nbit a (S n). + forall (a:N) (n:nat), N.testbit_nat (N.div2 a) n = N.testbit_nat a (S n). Proof. destruct a; trivial. destruct p; trivial. Qed. Lemma Nxor_bit0 : - forall a a':N, Nbit0 (Nxor a a') = xorb (Nbit0 a) (Nbit0 a'). + forall a a':N, N.odd (N.lxor a a') = xorb (N.odd a) (N.odd a'). Proof. intros. rewrite <- Nbit0_correct, (Nxor_semantics a a' O). rewrite Nbit0_correct, Nbit0_correct. reflexivity. Qed. Lemma Nxor_div2 : - forall a a':N, Ndiv2 (Nxor a a') = Nxor (Ndiv2 a) (Ndiv2 a'). + forall a a':N, N.div2 (N.lxor a a') = N.lxor (N.div2 a) (N.div2 a'). Proof. intros. apply Nbit_faithful. unfold eqf. intro. - rewrite (Nxor_semantics (Ndiv2 a) (Ndiv2 a') n), Ndiv2_correct, (Nxor_semantics a a' (S n)). + rewrite (Nxor_semantics (N.div2 a) (N.div2 a') n), Ndiv2_correct, (Nxor_semantics a a' (S n)). rewrite 2! Ndiv2_correct. reflexivity. Qed. Lemma Nneg_bit0 : forall a a':N, - Nbit0 (Nxor a a') = true -> Nbit0 a = negb (Nbit0 a'). + N.odd (N.lxor a a') = true -> N.odd a = negb (N.odd a'). Proof. intros. rewrite <- true_xorb, <- H, Nxor_bit0, xorb_assoc, @@ -320,24 +320,24 @@ Proof. Qed. Lemma Nneg_bit0_1 : - forall a a':N, Nxor a a' = Npos 1 -> Nbit0 a = negb (Nbit0 a'). + forall a a':N, N.lxor a a' = Npos 1 -> N.odd a = negb (N.odd a'). Proof. intros. apply Nneg_bit0. rewrite H. reflexivity. Qed. Lemma Nneg_bit0_2 : forall (a a':N) (p:positive), - Nxor a a' = Npos (xI p) -> Nbit0 a = negb (Nbit0 a'). + N.lxor a a' = Npos (xI p) -> N.odd a = negb (N.odd a'). Proof. intros. apply Nneg_bit0. rewrite H. reflexivity. Qed. Lemma Nsame_bit0 : forall (a a':N) (p:positive), - Nxor a a' = Npos (xO p) -> Nbit0 a = Nbit0 a'. + N.lxor a a' = Npos (xO p) -> N.odd a = N.odd a'. Proof. - intros. rewrite <- (xorb_false (Nbit0 a)). - assert (H0: Nbit0 (Npos (xO p)) = false) by reflexivity. + intros. rewrite <- (xorb_false (N.odd a)). + assert (H0: N.odd (Npos (xO p)) = false) by reflexivity. rewrite <- H0, <- H, Nxor_bit0, <- xorb_assoc, xorb_nilpotent, false_xorb. reflexivity. Qed. @@ -346,77 +346,77 @@ Qed. Fixpoint Nless_aux (a a':N) (p:positive) : bool := match p with - | xO p' => Nless_aux (Ndiv2 a) (Ndiv2 a') p' - | _ => andb (negb (Nbit0 a)) (Nbit0 a') + | xO p' => Nless_aux (N.div2 a) (N.div2 a') p' + | _ => andb (negb (N.odd a)) (N.odd a') end. Definition Nless (a a':N) := - match Nxor a a' with + match N.lxor a a' with | N0 => false | Npos p => Nless_aux a a' p end. Lemma Nbit0_less : forall a a', - Nbit0 a = false -> Nbit0 a' = true -> Nless a a' = true. + N.odd a = false -> N.odd a' = true -> Nless a a' = true. Proof. - intros. destruct (Ndiscr (Nxor a a')) as [(p,H2)|H1]. unfold Nless. + intros. destruct (N.discr (N.lxor a a')) as [(p,H2)|H1]. unfold Nless. rewrite H2. destruct p. simpl. rewrite H, H0. reflexivity. - assert (H1: Nbit0 (Nxor a a') = false) by (rewrite H2; reflexivity). + assert (H1: N.odd (N.lxor a a') = false) by (rewrite H2; reflexivity). rewrite (Nxor_bit0 a a'), H, H0 in H1. discriminate H1. simpl. rewrite H, H0. reflexivity. - assert (H2: Nbit0 (Nxor a a') = false) by (rewrite H1; reflexivity). + assert (H2: N.odd (N.lxor a a') = false) by (rewrite H1; reflexivity). rewrite (Nxor_bit0 a a'), H, H0 in H2. discriminate H2. Qed. Lemma Nbit0_gt : forall a a', - Nbit0 a = true -> Nbit0 a' = false -> Nless a a' = false. + N.odd a = true -> N.odd a' = false -> Nless a a' = false. Proof. - intros. destruct (Ndiscr (Nxor a a')) as [(p,H2)|H1]. unfold Nless. + intros. destruct (N.discr (N.lxor a a')) as [(p,H2)|H1]. unfold Nless. rewrite H2. destruct p. simpl. rewrite H, H0. reflexivity. - assert (H1: Nbit0 (Nxor a a') = false) by (rewrite H2; reflexivity). + assert (H1: N.odd (N.lxor a a') = false) by (rewrite H2; reflexivity). rewrite (Nxor_bit0 a a'), H, H0 in H1. discriminate H1. simpl. rewrite H, H0. reflexivity. - assert (H2: Nbit0 (Nxor a a') = false) by (rewrite H1; reflexivity). + assert (H2: N.odd (N.lxor a a') = false) by (rewrite H1; reflexivity). rewrite (Nxor_bit0 a a'), H, H0 in H2. discriminate H2. Qed. Lemma Nless_not_refl : forall a, Nless a a = false. Proof. - intro. unfold Nless. rewrite (Nxor_nilpotent a). reflexivity. + intro. unfold Nless. rewrite (N.lxor_nilpotent a). reflexivity. Qed. Lemma Nless_def_1 : - forall a a', Nless (Ndouble a) (Ndouble a') = Nless a a'. + forall a a', Nless (N.double a) (N.double a') = Nless a a'. Proof. destruct a; destruct a'. reflexivity. trivial. unfold Nless. simpl. destruct p; trivial. - unfold Nless. simpl. destruct (Pxor p p0). reflexivity. + unfold Nless. simpl. destruct (Pos.lxor p p0). reflexivity. trivial. Qed. Lemma Nless_def_2 : forall a a', - Nless (Ndouble_plus_one a) (Ndouble_plus_one a') = Nless a a'. + Nless (N.succ_double a) (N.succ_double a') = Nless a a'. Proof. destruct a; destruct a'. reflexivity. trivial. unfold Nless. simpl. destruct p; trivial. - unfold Nless. simpl. destruct (Pxor p p0). reflexivity. + unfold Nless. simpl. destruct (Pos.lxor p p0). reflexivity. trivial. Qed. Lemma Nless_def_3 : - forall a a', Nless (Ndouble a) (Ndouble_plus_one a') = true. + forall a a', Nless (N.double a) (N.succ_double a') = true. Proof. intros. apply Nbit0_less. apply Ndouble_bit0. apply Ndouble_plus_one_bit0. Qed. Lemma Nless_def_4 : - forall a a', Nless (Ndouble_plus_one a) (Ndouble a') = false. + forall a a', Nless (N.succ_double a) (N.double a') = false. Proof. intros. apply Nbit0_gt. apply Ndouble_plus_one_bit0. apply Ndouble_bit0. @@ -425,7 +425,7 @@ Qed. Lemma Nless_z : forall a, Nless a N0 = false. Proof. induction a. reflexivity. - unfold Nless. rewrite (Nxor_neutral_right (Npos p)). induction p; trivial. + unfold Nless. rewrite (N.lxor_0_r (Npos p)). induction p; trivial. Qed. Lemma N0_less_1 : @@ -445,26 +445,26 @@ Lemma Nless_trans : forall a a' a'', Nless a a' = true -> Nless a' a'' = true -> Nless a a'' = true. Proof. - induction a as [|a IHa|a IHa] using N_ind_double; intros a' a'' H H0. + induction a as [|a IHa|a IHa] using N.binary_ind; intros a' a'' H H0. case_eq (Nless N0 a'') ; intros Heqn. trivial. rewrite (N0_less_2 a'' Heqn), (Nless_z a') in H0. discriminate H0. - induction a' as [|a' _|a' _] using N_ind_double. - rewrite (Nless_z (Ndouble a)) in H. discriminate H. + induction a' as [|a' _|a' _] using N.binary_ind. + rewrite (Nless_z (N.double a)) in H. discriminate H. rewrite (Nless_def_1 a a') in H. - induction a'' using N_ind_double. - rewrite (Nless_z (Ndouble a')) in H0. discriminate H0. + induction a'' using N.binary_ind. + rewrite (Nless_z (N.double a')) in H0. discriminate H0. rewrite (Nless_def_1 a' a'') in H0. rewrite (Nless_def_1 a a''). exact (IHa _ _ H H0). apply Nless_def_3. - induction a'' as [|a'' _|a'' _] using N_ind_double. - rewrite (Nless_z (Ndouble_plus_one a')) in H0. discriminate H0. + induction a'' as [|a'' _|a'' _] using N.binary_ind. + rewrite (Nless_z (N.succ_double a')) in H0. discriminate H0. rewrite (Nless_def_4 a' a'') in H0. discriminate H0. apply Nless_def_3. - induction a' as [|a' _|a' _] using N_ind_double. - rewrite (Nless_z (Ndouble_plus_one a)) in H. discriminate H. + induction a' as [|a' _|a' _] using N.binary_ind. + rewrite (Nless_z (N.succ_double a)) in H. discriminate H. rewrite (Nless_def_4 a a') in H. discriminate H. - induction a'' using N_ind_double. - rewrite (Nless_z (Ndouble_plus_one a')) in H0. discriminate H0. + induction a'' using N.binary_ind. + rewrite (Nless_z (N.succ_double a')) in H0. discriminate H0. rewrite (Nless_def_4 a' a'') in H0. discriminate H0. rewrite (Nless_def_2 a' a'') in H0. rewrite (Nless_def_2 a a') in H. rewrite (Nless_def_2 a a''). exact (IHa _ _ H H0). @@ -473,17 +473,17 @@ Qed. Lemma Nless_total : forall a a', {Nless a a' = true} + {Nless a' a = true} + {a = a'}. Proof. - induction a using N_rec_double; intro a'. + induction a using N.binary_rec; intro a'. case_eq (Nless N0 a') ; intros Heqb. left. left. auto. right. rewrite (N0_less_2 a' Heqb). reflexivity. - induction a' as [|a' _|a' _] using N_rec_double. - case_eq (Nless N0 (Ndouble a)) ; intros Heqb. left. right. auto. + induction a' as [|a' _|a' _] using N.binary_rec. + case_eq (Nless N0 (N.double a)) ; intros Heqb. left. right. auto. right. exact (N0_less_2 _ Heqb). rewrite 2!Nless_def_1. destruct (IHa a') as [ | ->]. left. assumption. right. reflexivity. left. left. apply Nless_def_3. - induction a' as [|a' _|a' _] using N_rec_double. + induction a' as [|a' _|a' _] using N.binary_rec. left. right. destruct a; reflexivity. left. right. apply Nless_def_3. rewrite 2!Nless_def_2. destruct (IHa a') as [ | ->]. @@ -493,19 +493,19 @@ Qed. (** Number of digits in a number *) -Notation Nsize := N.size_nat (only parsing). +Notation Nsize := N.size_nat (compat "8.3"). (** conversions between N and bit vectors. *) -Fixpoint P2Bv (p:positive) : Bvector (Psize p) := - match p return Bvector (Psize p) with +Fixpoint P2Bv (p:positive) : Bvector (Pos.size_nat p) := + match p return Bvector (Pos.size_nat p) with | xH => Bvect_true 1%nat - | xO p => Bcons false (Psize p) (P2Bv p) - | xI p => Bcons true (Psize p) (P2Bv p) + | xO p => Bcons false (Pos.size_nat p) (P2Bv p) + | xI p => Bcons true (Pos.size_nat p) (P2Bv p) end. -Definition N2Bv (n:N) : Bvector (Nsize n) := - match n as n0 return Bvector (Nsize n0) with +Definition N2Bv (n:N) : Bvector (N.size_nat n) := + match n as n0 return Bvector (N.size_nat n0) with | N0 => Bnil | Npos p => P2Bv p end. @@ -513,8 +513,8 @@ Definition N2Bv (n:N) : Bvector (Nsize n) := Fixpoint Bv2N (n:nat)(bv:Bvector n) : N := match bv with | Vector.nil => N0 - | Vector.cons false n bv => Ndouble (Bv2N n bv) - | Vector.cons true n bv => Ndouble_plus_one (Bv2N n bv) + | Vector.cons false n bv => N.double (Bv2N n bv) + | Vector.cons true n bv => N.succ_double (Bv2N n bv) end. Lemma Bv2N_N2Bv : forall n, Bv2N _ (N2Bv n) = n. @@ -528,7 +528,7 @@ Qed. bit vector has some zeros on its right, they will disappear during the return [Bv2N] translation: *) -Lemma Bv2N_Nsize : forall n (bv:Bvector n), Nsize (Bv2N n bv) <= n. +Lemma Bv2N_Nsize : forall n (bv:Bvector n), N.size_nat (Bv2N n bv) <= n. Proof. induction bv; intros. auto. @@ -543,7 +543,7 @@ Qed. Lemma Bv2N_Nsize_1 : forall n (bv:Bvector (S n)), Bsign _ bv = true <-> - Nsize (Bv2N _ bv) = (S n). + N.size_nat (Bv2N _ bv) = (S n). Proof. apply Vector.rectS ; intros ; simpl. destruct a ; compute ; split ; intros x ; now inversion x. @@ -567,7 +567,7 @@ Fixpoint N2Bv_gen (n:nat)(a:N) : Bvector n := (** The first [N2Bv] is then a special case of [N2Bv_gen] *) -Lemma N2Bv_N2Bv_gen : forall (a:N), N2Bv a = N2Bv_gen (Nsize a) a. +Lemma N2Bv_N2Bv_gen : forall (a:N), N2Bv a = N2Bv_gen (N.size_nat a) a. Proof. destruct a; simpl. auto. @@ -578,7 +578,7 @@ Qed. [a] plus some zeros. *) Lemma N2Bv_N2Bv_gen_above : forall (a:N)(k:nat), - N2Bv_gen (Nsize a + k) a = Vector.append (N2Bv a) (Bvect_false k). + N2Bv_gen (N.size_nat a + k) a = Vector.append (N2Bv a) (Bvect_false k). Proof. destruct a; simpl. destruct k; simpl; auto. @@ -603,7 +603,7 @@ Qed. (** accessing some precise bits. *) Lemma Nbit0_Blow : forall n, forall (bv:Bvector (S n)), - Nbit0 (Bv2N _ bv) = Blow _ bv. + N.odd (Bv2N _ bv) = Blow _ bv. Proof. apply Vector.caseS. intros. @@ -616,7 +616,7 @@ Qed. Notation Bnth := (@Vector.nth_order bool). Lemma Bnth_Nbit : forall n (bv:Bvector n) p (H:p<n), - Bnth bv H = Nbit (Bv2N _ bv) p. + Bnth bv H = N.testbit_nat (Bv2N _ bv) p. Proof. induction bv; intros. inversion H. @@ -626,7 +626,7 @@ destruct p ; simpl. simpl in * ; destruct (Bv2N n bv); destruct h; simpl in *; auto. Qed. -Lemma Nbit_Nsize : forall n p, Nsize n <= p -> Nbit n p = false. +Lemma Nbit_Nsize : forall n p, N.size_nat n <= p -> N.testbit_nat n p = false. Proof. destruct n as [|n]. simpl; auto. @@ -635,7 +635,8 @@ inversion H. inversion H. Qed. -Lemma Nbit_Bth: forall n p (H:p < Nsize n), Nbit n p = Bnth (N2Bv n) H. +Lemma Nbit_Bth: forall n p (H:p < N.size_nat n), + N.testbit_nat n p = Bnth (N2Bv n) H. Proof. destruct n as [|n]. inversion H. @@ -646,7 +647,7 @@ Qed. (** Binary bitwise operations are the same in the two worlds. *) Lemma Nxor_BVxor : forall n (bv bv' : Bvector n), - Bv2N _ (BVxor _ bv bv') = Nxor (Bv2N _ bv) (Bv2N _ bv'). + Bv2N _ (BVxor _ bv bv') = N.lxor (Bv2N _ bv) (Bv2N _ bv'). Proof. apply Vector.rect2 ; intros. now simpl. diff --git a/theories/NArith/Ndist.v b/theories/NArith/Ndist.v index 22adc505..ce4f7663 100644 --- a/theories/NArith/Ndist.v +++ b/theories/NArith/Ndist.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -33,12 +33,12 @@ Definition Nplength (a:N) := Lemma Nplength_infty : forall a:N, Nplength a = infty -> a = N0. Proof. simple induction a; trivial. - unfold Nplength in |- *; intros; discriminate H. + unfold Nplength; intros; discriminate H. Qed. Lemma Nplength_zeros : forall (a:N) (n:nat), - Nplength a = ni n -> forall k:nat, k < n -> Nbit a k = false. + Nplength a = ni n -> forall k:nat, k < n -> N.testbit_nat a k = false. Proof. simple induction a; trivial. simple induction p. simple induction n. intros. inversion H1. @@ -46,33 +46,33 @@ Proof. intros. simpl in H1. discriminate H1. simple induction k. trivial. generalize H0. case n. intros. inversion H3. - intros. simpl in |- *. unfold Nbit in H. apply (H n0). simpl in H1. inversion H1. reflexivity. + intros. simpl. unfold N.testbit_nat in H. apply (H n0). simpl in H1. inversion H1. reflexivity. exact (lt_S_n n1 n0 H3). - simpl in |- *. intros n H. inversion H. intros. inversion H0. + simpl. intros n H. inversion H. intros. inversion H0. Qed. Lemma Nplength_one : - forall (a:N) (n:nat), Nplength a = ni n -> Nbit a n = true. + forall (a:N) (n:nat), Nplength a = ni n -> N.testbit_nat a n = true. Proof. simple induction a. intros. inversion H. simple induction p. intros. simpl in H0. inversion H0. reflexivity. - intros. simpl in H0. inversion H0. simpl in |- *. unfold Nbit in H. apply H. reflexivity. + intros. simpl in H0. inversion H0. simpl. unfold N.testbit_nat in H. apply H. reflexivity. intros. simpl in H. inversion H. reflexivity. Qed. Lemma Nplength_first_one : forall (a:N) (n:nat), - (forall k:nat, k < n -> Nbit a k = false) -> - Nbit a n = true -> Nplength a = ni n. + (forall k:nat, k < n -> N.testbit_nat a k = false) -> + N.testbit_nat a n = true -> Nplength a = ni n. Proof. simple induction a. intros. simpl in H0. discriminate H0. simple induction p. intros. generalize H0. case n. intros. reflexivity. - intros. absurd (Nbit (Npos (xI p0)) 0 = false). trivial with bool. + intros. absurd (N.testbit_nat (Npos (xI p0)) 0 = false). trivial with bool. auto with bool arith. intros. generalize H0 H1. case n. intros. simpl in H3. discriminate H3. - intros. simpl in |- *. unfold Nplength in H. + intros. simpl. unfold Nplength in H. cut (ni (Pplength p0) = ni n0). intro. inversion H4. reflexivity. - apply H. intros. change (Nbit (Npos (xO p0)) (S k) = false) in |- *. apply H2. apply lt_n_S. exact H4. + apply H. intros. change (N.testbit_nat (Npos (xO p0)) (S k) = false). apply H2. apply lt_n_S. exact H4. exact H3. intro. case n. trivial. intros. simpl in H0. discriminate H0. @@ -90,10 +90,10 @@ Definition ni_min (d d':natinf) := Lemma ni_min_idemp : forall d:natinf, ni_min d d = d. Proof. simple induction d; trivial. - unfold ni_min in |- *. + unfold ni_min. simple induction n; trivial. intros. - simpl in |- *. + simpl. inversion H. rewrite H1. rewrite H1. @@ -105,7 +105,7 @@ Proof. simple induction d. simple induction d'; trivial. simple induction d'; trivial. elim n. simple induction n0; trivial. intros. elim n1; trivial. intros. unfold ni_min in H. cut (min n0 n2 = min n2 n0). - intro. unfold ni_min in |- *. simpl in |- *. rewrite H1. reflexivity. + intro. unfold ni_min. simpl. rewrite H1. reflexivity. cut (ni (min n0 n2) = ni (min n2 n0)). intros. inversion H1; trivial. exact (H n2). @@ -116,11 +116,11 @@ Lemma ni_min_assoc : Proof. simple induction d; trivial. simple induction d'; trivial. simple induction d''; trivial. - unfold ni_min in |- *. intro. cut (min (min n n0) n1 = min n (min n0 n1)). + unfold ni_min. intro. cut (min (min n n0) n1 = min n (min n0 n1)). intro. rewrite H. reflexivity. generalize n0 n1. elim n; trivial. simple induction n3; trivial. simple induction n5; trivial. - intros. simpl in |- *. auto. + intros. simpl. auto. Qed. Lemma ni_min_O_l : forall d:natinf, ni_min (ni 0) d = ni 0. @@ -152,42 +152,42 @@ Qed. Lemma ni_le_antisym : forall d d':natinf, ni_le d d' -> ni_le d' d -> d = d'. Proof. - unfold ni_le in |- *. intros d d'. rewrite ni_min_comm. intro H. rewrite H. trivial. + unfold ni_le. intros d d'. rewrite ni_min_comm. intro H. rewrite H. trivial. Qed. Lemma ni_le_trans : forall d d' d'':natinf, ni_le d d' -> ni_le d' d'' -> ni_le d d''. Proof. - unfold ni_le in |- *. intros. rewrite <- H. rewrite ni_min_assoc. rewrite H0. reflexivity. + unfold ni_le. intros. rewrite <- H. rewrite ni_min_assoc. rewrite H0. reflexivity. Qed. Lemma ni_le_min_1 : forall d d':natinf, ni_le (ni_min d d') d. Proof. - unfold ni_le in |- *. intros. rewrite (ni_min_comm d d'). rewrite ni_min_assoc. + unfold ni_le. intros. rewrite (ni_min_comm d d'). rewrite ni_min_assoc. rewrite ni_min_idemp. reflexivity. Qed. Lemma ni_le_min_2 : forall d d':natinf, ni_le (ni_min d d') d'. Proof. - unfold ni_le in |- *. intros. rewrite ni_min_assoc. rewrite ni_min_idemp. reflexivity. + unfold ni_le. intros. rewrite ni_min_assoc. rewrite ni_min_idemp. reflexivity. Qed. Lemma ni_min_case : forall d d':natinf, ni_min d d' = d \/ ni_min d d' = d'. Proof. simple induction d. intro. right. exact (ni_min_inf_l d'). simple induction d'. left. exact (ni_min_inf_r (ni n)). - unfold ni_min in |- *. cut (forall n0:nat, min n n0 = n \/ min n n0 = n0). + unfold ni_min. cut (forall n0:nat, min n n0 = n \/ min n n0 = n0). intros. case (H n0). intro. left. rewrite H0. reflexivity. intro. right. rewrite H0. reflexivity. elim n. intro. left. reflexivity. simple induction n1. right. reflexivity. - intros. case (H n2). intro. left. simpl in |- *. rewrite H1. reflexivity. - intro. right. simpl in |- *. rewrite H1. reflexivity. + intros. case (H n2). intro. left. simpl. rewrite H1. reflexivity. + intro. right. simpl. rewrite H1. reflexivity. Qed. Lemma ni_le_total : forall d d':natinf, ni_le d d' \/ ni_le d' d. Proof. - unfold ni_le in |- *. intros. rewrite (ni_min_comm d' d). apply ni_min_case. + unfold ni_le. intros. rewrite (ni_min_comm d' d). apply ni_min_case. Qed. Lemma ni_le_min_induc : @@ -201,7 +201,7 @@ Proof. apply ni_le_antisym. apply H1. apply ni_le_refl. exact H2. exact H. - intro. rewrite H2. apply ni_le_antisym. apply H1. unfold ni_le in |- *. rewrite ni_min_comm. exact H2. + intro. rewrite H2. apply ni_le_antisym. apply H1. unfold ni_le. rewrite ni_min_comm. exact H2. apply ni_le_refl. exact H0. Qed. @@ -209,40 +209,40 @@ Qed. Lemma le_ni_le : forall m n:nat, m <= n -> ni_le (ni m) (ni n). Proof. cut (forall m n:nat, m <= n -> min m n = m). - intros. unfold ni_le, ni_min in |- *. rewrite (H m n H0). reflexivity. + intros. unfold ni_le, ni_min. rewrite (H m n H0). reflexivity. simple induction m. trivial. simple induction n0. intro. inversion H0. - intros. simpl in |- *. rewrite (H n1 (le_S_n n n1 H1)). reflexivity. + intros. simpl. rewrite (H n1 (le_S_n n n1 H1)). reflexivity. Qed. Lemma ni_le_le : forall m n:nat, ni_le (ni m) (ni n) -> m <= n. Proof. - unfold ni_le in |- *. unfold ni_min in |- *. intros. inversion H. apply le_min_r. + unfold ni_le. unfold ni_min. intros. inversion H. apply le_min_r. Qed. Lemma Nplength_lb : forall (a:N) (n:nat), - (forall k:nat, k < n -> Nbit a k = false) -> ni_le (ni n) (Nplength a). + (forall k:nat, k < n -> N.testbit_nat a k = false) -> ni_le (ni n) (Nplength a). Proof. simple induction a. intros. exact (ni_min_inf_r (ni n)). - intros. unfold Nplength in |- *. apply le_ni_le. case (le_or_lt n (Pplength p)). trivial. - intro. absurd (Nbit (Npos p) (Pplength p) = false). + intros. unfold Nplength. apply le_ni_le. case (le_or_lt n (Pplength p)). trivial. + intro. absurd (N.testbit_nat (Npos p) (Pplength p) = false). rewrite (Nplength_one (Npos p) (Pplength p) - (refl_equal (Nplength (Npos p)))). + (eq_refl (Nplength (Npos p)))). discriminate. apply H. exact H0. Qed. Lemma Nplength_ub : - forall (a:N) (n:nat), Nbit a n = true -> ni_le (Nplength a) (ni n). + forall (a:N) (n:nat), N.testbit_nat a n = true -> ni_le (Nplength a) (ni n). Proof. simple induction a. intros. discriminate H. - intros. unfold Nplength in |- *. apply le_ni_le. case (le_or_lt (Pplength p) n). trivial. - intro. absurd (Nbit (Npos p) n = true). + intros. unfold Nplength. apply le_ni_le. case (le_or_lt (Pplength p) n). trivial. + intro. absurd (N.testbit_nat (Npos p) n = true). rewrite (Nplength_zeros (Npos p) (Pplength p) - (refl_equal (Nplength (Npos p))) n H0). + (eq_refl (Nplength (Npos p))) n H0). discriminate. exact H. Qed. @@ -255,26 +255,26 @@ Qed. Instead of working with $d$, we work with $pd$, namely [Npdist]: *) -Definition Npdist (a a':N) := Nplength (Nxor a a'). +Definition Npdist (a a':N) := Nplength (N.lxor a a'). (** d is a distance, so $d(a,a')=0$ iff $a=a'$; this means that $pd(a,a')=infty$ iff $a=a'$: *) Lemma Npdist_eq_1 : forall a:N, Npdist a a = infty. Proof. - intros. unfold Npdist in |- *. rewrite Nxor_nilpotent. reflexivity. + intros. unfold Npdist. rewrite N.lxor_nilpotent. reflexivity. Qed. Lemma Npdist_eq_2 : forall a a':N, Npdist a a' = infty -> a = a'. Proof. - intros. apply Nxor_eq. apply Nplength_infty. exact H. + intros. apply N.lxor_eq. apply Nplength_infty. exact H. Qed. (** $d$ is a distance, so $d(a,a')=d(a',a)$: *) Lemma Npdist_comm : forall a a':N, Npdist a a' = Npdist a' a. Proof. - unfold Npdist in |- *. intros. rewrite Nxor_comm. reflexivity. + unfold Npdist. intros. rewrite N.lxor_comm. reflexivity. Qed. (** $d$ is an ultrametric distance, that is, not only $d(a,a')\leq @@ -292,21 +292,21 @@ Qed. Lemma Nplength_ultra_1 : forall a a':N, ni_le (Nplength a) (Nplength a') -> - ni_le (Nplength a) (Nplength (Nxor a a')). + ni_le (Nplength a) (Nplength (N.lxor a a')). Proof. simple induction a. intros. unfold ni_le in H. unfold Nplength at 1 3 in H. rewrite (ni_min_inf_l (Nplength a')) in H. - rewrite (Nplength_infty a' H). simpl in |- *. apply ni_le_refl. - intros. unfold Nplength at 1 in |- *. apply Nplength_lb. intros. - cut (forall a'':N, Nxor (Npos p) a' = a'' -> Nbit a'' k = false). + rewrite (Nplength_infty a' H). simpl. apply ni_le_refl. + intros. unfold Nplength at 1. apply Nplength_lb. intros. + cut (forall a'':N, N.lxor (Npos p) a' = a'' -> N.testbit_nat a'' k = false). intros. apply H1. reflexivity. intro a''. case a''. intro. reflexivity. intros. rewrite <- H1. rewrite (Nxor_semantics (Npos p) a' k). rewrite (Nplength_zeros (Npos p) (Pplength p) - (refl_equal (Nplength (Npos p))) k H0). + (eq_refl (Nplength (Npos p))) k H0). generalize H. case a'. trivial. - intros. cut (Nbit (Npos p1) k = false). intros. rewrite H3. reflexivity. + intros. cut (N.testbit_nat (Npos p1) k = false). intros. rewrite H3. reflexivity. apply Nplength_zeros with (n := Pplength p1). reflexivity. apply (lt_le_trans k (Pplength p) (Pplength p1)). exact H0. apply ni_le_le. exact H2. @@ -314,14 +314,14 @@ Qed. Lemma Nplength_ultra : forall a a':N, - ni_le (ni_min (Nplength a) (Nplength a')) (Nplength (Nxor a a')). + ni_le (ni_min (Nplength a) (Nplength a')) (Nplength (N.lxor a a')). Proof. intros. case (ni_le_total (Nplength a) (Nplength a')). intro. cut (ni_min (Nplength a) (Nplength a') = Nplength a). intro. rewrite H0. apply Nplength_ultra_1. exact H. exact H. intro. cut (ni_min (Nplength a) (Nplength a') = Nplength a'). - intro. rewrite H0. rewrite Nxor_comm. apply Nplength_ultra_1. exact H. + intro. rewrite H0. rewrite N.lxor_comm. apply Nplength_ultra_1. exact H. rewrite ni_min_comm. exact H. Qed. @@ -329,8 +329,8 @@ Lemma Npdist_ultra : forall a a' a'':N, ni_le (ni_min (Npdist a a'') (Npdist a'' a')) (Npdist a a'). Proof. - intros. unfold Npdist in |- *. cut (Nxor (Nxor a a'') (Nxor a'' a') = Nxor a a'). + intros. unfold Npdist. cut (N.lxor (N.lxor a a'') (N.lxor a'' a') = N.lxor a a'). intro. rewrite <- H. apply Nplength_ultra. - rewrite Nxor_assoc. rewrite <- (Nxor_assoc a'' a'' a'). rewrite Nxor_nilpotent. - rewrite Nxor_neutral_left. reflexivity. + rewrite N.lxor_assoc. rewrite <- (N.lxor_assoc a'' a'' a'). rewrite N.lxor_nilpotent. + rewrite N.lxor_0_l. reflexivity. Qed. diff --git a/theories/NArith/Ndiv_def.v b/theories/NArith/Ndiv_def.v index 559f01f1..0b220f5d 100644 --- a/theories/NArith/Ndiv_def.v +++ b/theories/NArith/Ndiv_def.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -22,10 +22,10 @@ Lemma Pdiv_eucl_remainder a b : snd (Pdiv_eucl a b) < Npos b. Proof. now apply (N.pos_div_eucl_remainder a (Npos b)). Qed. -Notation Ndiv_eucl := N.div_eucl (only parsing). -Notation Ndiv := N.div (only parsing). -Notation Nmod := N.modulo (only parsing). +Notation Ndiv_eucl := N.div_eucl (compat "8.3"). +Notation Ndiv := N.div (compat "8.3"). +Notation Nmod := N.modulo (compat "8.3"). -Notation Ndiv_eucl_correct := N.div_eucl_spec (only parsing). -Notation Ndiv_mod_eq := N.div_mod' (only parsing). -Notation Nmod_lt := N.mod_lt (only parsing). +Notation Ndiv_eucl_correct := N.div_eucl_spec (compat "8.3"). +Notation Ndiv_mod_eq := N.div_mod' (compat "8.3"). +Notation Nmod_lt := N.mod_lt (compat "8.3"). diff --git a/theories/NArith/Ngcd_def.v b/theories/NArith/Ngcd_def.v index 13211f46..737cd450 100644 --- a/theories/NArith/Ngcd_def.v +++ b/theories/NArith/Ngcd_def.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/NArith/Nnat.v b/theories/NArith/Nnat.v index 133d4c23..1b7e2f24 100644 --- a/theories/NArith/Nnat.v +++ b/theories/NArith/Nnat.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -203,30 +203,30 @@ Hint Rewrite Nat2N.id : Nnat. (** Compatibility notations *) -Notation nat_of_N_inj := N2Nat.inj (only parsing). -Notation N_of_nat_of_N := N2Nat.id (only parsing). -Notation nat_of_Ndouble := N2Nat.inj_double (only parsing). -Notation nat_of_Ndouble_plus_one := N2Nat.inj_succ_double (only parsing). -Notation nat_of_Nsucc := N2Nat.inj_succ (only parsing). -Notation nat_of_Nplus := N2Nat.inj_add (only parsing). -Notation nat_of_Nmult := N2Nat.inj_mul (only parsing). -Notation nat_of_Nminus := N2Nat.inj_sub (only parsing). -Notation nat_of_Npred := N2Nat.inj_pred (only parsing). -Notation nat_of_Ndiv2 := N2Nat.inj_div2 (only parsing). -Notation nat_of_Ncompare := N2Nat.inj_compare (only parsing). -Notation nat_of_Nmax := N2Nat.inj_max (only parsing). -Notation nat_of_Nmin := N2Nat.inj_min (only parsing). - -Notation nat_of_N_of_nat := Nat2N.id (only parsing). -Notation N_of_nat_inj := Nat2N.inj (only parsing). -Notation N_of_double := Nat2N.inj_double (only parsing). -Notation N_of_double_plus_one := Nat2N.inj_succ_double (only parsing). -Notation N_of_S := Nat2N.inj_succ (only parsing). -Notation N_of_pred := Nat2N.inj_pred (only parsing). -Notation N_of_plus := Nat2N.inj_add (only parsing). -Notation N_of_minus := Nat2N.inj_sub (only parsing). -Notation N_of_mult := Nat2N.inj_mul (only parsing). -Notation N_of_div2 := Nat2N.inj_div2 (only parsing). -Notation N_of_nat_compare := Nat2N.inj_compare (only parsing). -Notation N_of_min := Nat2N.inj_min (only parsing). -Notation N_of_max := Nat2N.inj_max (only parsing). +Notation nat_of_N_inj := N2Nat.inj (compat "8.3"). +Notation N_of_nat_of_N := N2Nat.id (compat "8.3"). +Notation nat_of_Ndouble := N2Nat.inj_double (compat "8.3"). +Notation nat_of_Ndouble_plus_one := N2Nat.inj_succ_double (compat "8.3"). +Notation nat_of_Nsucc := N2Nat.inj_succ (compat "8.3"). +Notation nat_of_Nplus := N2Nat.inj_add (compat "8.3"). +Notation nat_of_Nmult := N2Nat.inj_mul (compat "8.3"). +Notation nat_of_Nminus := N2Nat.inj_sub (compat "8.3"). +Notation nat_of_Npred := N2Nat.inj_pred (compat "8.3"). +Notation nat_of_Ndiv2 := N2Nat.inj_div2 (compat "8.3"). +Notation nat_of_Ncompare := N2Nat.inj_compare (compat "8.3"). +Notation nat_of_Nmax := N2Nat.inj_max (compat "8.3"). +Notation nat_of_Nmin := N2Nat.inj_min (compat "8.3"). + +Notation nat_of_N_of_nat := Nat2N.id (compat "8.3"). +Notation N_of_nat_inj := Nat2N.inj (compat "8.3"). +Notation N_of_double := Nat2N.inj_double (compat "8.3"). +Notation N_of_double_plus_one := Nat2N.inj_succ_double (compat "8.3"). +Notation N_of_S := Nat2N.inj_succ (compat "8.3"). +Notation N_of_pred := Nat2N.inj_pred (compat "8.3"). +Notation N_of_plus := Nat2N.inj_add (compat "8.3"). +Notation N_of_minus := Nat2N.inj_sub (compat "8.3"). +Notation N_of_mult := Nat2N.inj_mul (compat "8.3"). +Notation N_of_div2 := Nat2N.inj_div2 (compat "8.3"). +Notation N_of_nat_compare := Nat2N.inj_compare (compat "8.3"). +Notation N_of_min := Nat2N.inj_min (compat "8.3"). +Notation N_of_max := Nat2N.inj_max (compat "8.3"). diff --git a/theories/NArith/Nsqrt_def.v b/theories/NArith/Nsqrt_def.v index edb6b289..240d7469 100644 --- a/theories/NArith/Nsqrt_def.v +++ b/theories/NArith/Nsqrt_def.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -11,8 +11,8 @@ Require Import BinNat. (** Obsolete file, see [BinNat] now, only compatibility notations remain here. *) -Notation Nsqrtrem := N.sqrtrem (only parsing). -Notation Nsqrt := N.sqrt (only parsing). -Notation Nsqrtrem_spec := N.sqrtrem_spec (only parsing). -Notation Nsqrt_spec := (fun n => N.sqrt_spec n (N.le_0_l n)) (only parsing). -Notation Nsqrtrem_sqrt := N.sqrtrem_sqrt (only parsing). +Notation Nsqrtrem := N.sqrtrem (compat "8.3"). +Notation Nsqrt := N.sqrt (compat "8.3"). +Notation Nsqrtrem_spec := N.sqrtrem_spec (compat "8.3"). +Notation Nsqrt_spec := (fun n => N.sqrt_spec n (N.le_0_l n)) (compat "8.3"). +Notation Nsqrtrem_sqrt := N.sqrtrem_sqrt (compat "8.3"). diff --git a/theories/Numbers/BigNumPrelude.v b/theories/Numbers/BigNumPrelude.v index 26850688..56d48eb5 100644 --- a/theories/Numbers/BigNumPrelude.v +++ b/theories/Numbers/BigNumPrelude.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -30,7 +30,7 @@ Declare ML Module "numbers_syntax_plugin". Local Open Scope Z_scope. -(* For compatibility of scripts, weaker version of some lemmas of Zdiv *) +(* For compatibility of scripts, weaker version of some lemmas of Z.div *) Lemma Zlt0_not_eq : forall n, 0<n -> n<>0. Proof. @@ -43,22 +43,22 @@ Definition Z_div_plus_l a b c H := Zdiv.Z_div_plus_full_l a b c (Zlt0_not_eq _ H (* Automation *) -Hint Extern 2 (Zle _ _) => +Hint Extern 2 (Z.le _ _) => (match goal with - |- Zpos _ <= Zpos _ => exact (refl_equal _) -| H: _ <= ?p |- _ <= ?p => apply Zle_trans with (2 := H) -| H: _ < ?p |- _ <= ?p => apply Zlt_le_weak; apply Zle_lt_trans with (2 := H) + |- Zpos _ <= Zpos _ => exact (eq_refl _) +| H: _ <= ?p |- _ <= ?p => apply Z.le_trans with (2 := H) +| H: _ < ?p |- _ <= ?p => apply Z.lt_le_incl; apply Z.le_lt_trans with (2 := H) end). -Hint Extern 2 (Zlt _ _) => +Hint Extern 2 (Z.lt _ _) => (match goal with - |- Zpos _ < Zpos _ => exact (refl_equal _) -| H: _ <= ?p |- _ <= ?p => apply Zlt_le_trans with (2 := H) -| H: _ < ?p |- _ <= ?p => apply Zle_lt_trans with (2 := H) + |- Zpos _ < Zpos _ => exact (eq_refl _) +| H: _ <= ?p |- _ <= ?p => apply Z.lt_le_trans with (2 := H) +| H: _ < ?p |- _ <= ?p => apply Z.le_lt_trans with (2 := H) end). -Hint Resolve Zlt_gt Zle_ge Z_div_pos: zarith. +Hint Resolve Z.lt_gt Z.le_ge Z_div_pos: zarith. (************************************** Properties of order and product @@ -71,9 +71,9 @@ Hint Resolve Zlt_gt Zle_ge Z_div_pos: zarith. Proof. intros a b c d beta H1 (H3, H4) (H5, H6). assert (a - c < 1); auto with zarith. - apply Zmult_lt_reg_r with beta; auto with zarith. - apply Zle_lt_trans with (d - b); auto with zarith. - rewrite Zmult_minus_distr_r; auto with zarith. + apply Z.mul_lt_mono_pos_r with beta; auto with zarith. + apply Z.le_lt_trans with (d - b); auto with zarith. + rewrite Z.mul_sub_distr_r; auto with zarith. Qed. Theorem beta_lex_inv: forall a b c d beta, @@ -82,15 +82,15 @@ Hint Resolve Zlt_gt Zle_ge Z_div_pos: zarith. a * beta + b < c * beta + d. Proof. intros a b c d beta H1 (H3, H4) (H5, H6). - case (Zle_or_lt (c * beta + d) (a * beta + b)); auto with zarith. - intros H7; contradict H1;apply Zle_not_lt;apply beta_lex with (1 := H7);auto. + case (Z.le_gt_cases (c * beta + d) (a * beta + b)); auto with zarith. + intros H7. contradict H1. apply Z.le_ngt. apply beta_lex with (1 := H7); auto. Qed. Lemma beta_mult : forall h l beta, 0 <= h < beta -> 0 <= l < beta -> 0 <= h*beta+l < beta^2. Proof. intros h l beta H1 H2;split. auto with zarith. - rewrite <- (Zplus_0_r (beta^2)); rewrite Zpower_2; + rewrite <- (Z.add_0_r (beta^2)); rewrite Z.pow_2_r; apply beta_lex_inv;auto with zarith. Qed. @@ -98,9 +98,9 @@ Hint Resolve Zlt_gt Zle_ge Z_div_pos: zarith. forall b x y, 0 <= x < b -> 0 <= y < b -> 0 <= x * y <= b^2 - 2*b + 1. Proof. intros b x y (Hx1,Hx2) (Hy1,Hy2);split;auto with zarith. - apply Zle_trans with ((b-1)*(b-1)). - apply Zmult_le_compat;auto with zarith. - apply Zeq_le; ring. + apply Z.le_trans with ((b-1)*(b-1)). + apply Z.mul_le_mono_nonneg;auto with zarith. + apply Z.eq_le_incl; ring. Qed. Lemma sum_mul_carry : forall xh xl yh yl wc cc beta, @@ -129,11 +129,10 @@ Hint Resolve Zlt_gt Zle_ge Z_div_pos: zarith. Proof. intros x y cross beta HH HH1 HH2. split; auto with zarith. - apply Zle_lt_trans with ((beta-1)*(beta-1)+(beta-1)); auto with zarith. - apply Zplus_le_compat; auto with zarith. - apply Zmult_le_compat; auto with zarith. - repeat (rewrite Zmult_minus_distr_l || rewrite Zmult_minus_distr_r); - rewrite Zpower_2; auto with zarith. + apply Z.le_lt_trans with ((beta-1)*(beta-1)+(beta-1)); auto with zarith. + apply Z.add_le_mono; auto with zarith. + apply Z.mul_le_mono_nonneg; auto with zarith. + rewrite ?Z.mul_sub_distr_l, ?Z.mul_sub_distr_r, Z.pow_2_r; auto with zarith. Qed. Theorem mult_add_ineq2: forall x y c cross beta, @@ -144,11 +143,10 @@ Hint Resolve Zlt_gt Zle_ge Z_div_pos: zarith. Proof. intros x y c cross beta HH HH1 HH2. split; auto with zarith. - apply Zle_lt_trans with ((beta-1)*(beta-1)+(2*beta-2));auto with zarith. - apply Zplus_le_compat; auto with zarith. - apply Zmult_le_compat; auto with zarith. - repeat (rewrite Zmult_minus_distr_l || rewrite Zmult_minus_distr_r); - rewrite Zpower_2; auto with zarith. + apply Z.le_lt_trans with ((beta-1)*(beta-1)+(2*beta-2));auto with zarith. + apply Z.add_le_mono; auto with zarith. + apply Z.mul_le_mono_nonneg; auto with zarith. + rewrite ?Z.mul_sub_distr_l, ?Z.mul_sub_distr_r, Z.pow_2_r; auto with zarith. Qed. Theorem mult_add_ineq3: forall x y c cross beta, @@ -161,20 +159,20 @@ Theorem mult_add_ineq3: forall x y c cross beta, intros x y c cross beta HH HH1 HH2 HH3. apply mult_add_ineq2;auto with zarith. split;auto with zarith. - apply Zle_trans with (1*beta+cross);auto with zarith. + apply Z.le_trans with (1*beta+cross);auto with zarith. Qed. -Hint Rewrite Zmult_1_r Zmult_0_r Zmult_1_l Zmult_0_l Zplus_0_l Zplus_0_r Zminus_0_r: rm10. +Hint Rewrite Z.mul_1_r Z.mul_0_r Z.mul_1_l Z.mul_0_l Z.add_0_l Z.add_0_r Z.sub_0_r: rm10. (************************************** - Properties of Zdiv and Zmod + Properties of Z.div and Z.modulo **************************************) Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. Proof. intros a b H H1;case (Z_mod_lt a b);auto with zarith;intros H2 H3;split;auto. - case (Zle_or_lt b a); intros H4; auto with zarith. + case (Z.le_gt_cases b a); intros H4; auto with zarith. rewrite Zmod_small; auto with zarith. Qed. @@ -184,26 +182,26 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. Proof. intros a b r t (H1, H2) H3 (H4, H5). assert (t < 2 ^ b). - apply Zlt_le_trans with (1:= H5); auto with zarith. + apply Z.lt_le_trans with (1:= H5); auto with zarith. apply Zpower_le_monotone; auto with zarith. rewrite Zplus_mod; auto with zarith. rewrite Zmod_small with (a := t); auto with zarith. apply Zmod_small; auto with zarith. split; auto with zarith. assert (0 <= 2 ^a * r); auto with zarith. - apply Zplus_le_0_compat; auto with zarith. + apply Z.add_nonneg_nonneg; auto with zarith. match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end; auto with zarith. pattern (2 ^ b) at 2; replace (2 ^ b) with ((2 ^ b - 2 ^a) + 2 ^ a); try ring. - apply Zplus_le_lt_compat; auto with zarith. + apply Z.add_le_lt_mono; auto with zarith. replace b with ((b - a) + a); try ring. rewrite Zpower_exp; auto with zarith. - pattern (2 ^a) at 4; rewrite <- (Zmult_1_l (2 ^a)); - try rewrite <- Zmult_minus_distr_r. - rewrite (Zmult_comm (2 ^(b - a))); rewrite Zmult_mod_distr_l; + pattern (2 ^a) at 4; rewrite <- (Z.mul_1_l (2 ^a)); + try rewrite <- Z.mul_sub_distr_r. + rewrite (Z.mul_comm (2 ^(b - a))); rewrite Zmult_mod_distr_l; auto with zarith. - rewrite (Zmult_comm (2 ^a)); apply Zmult_le_compat_r; auto with zarith. + rewrite (Z.mul_comm (2 ^a)); apply Z.mul_le_mono_nonneg_r; auto with zarith. match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end; auto with zarith. Qed. @@ -214,25 +212,25 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. Proof. intros a b r t (H1, H2) H3 (H4, H5). assert (t < 2 ^ b). - apply Zlt_le_trans with (1:= H5); auto with zarith. + apply Z.lt_le_trans with (1:= H5); auto with zarith. apply Zpower_le_monotone; auto with zarith. rewrite Zplus_mod; auto with zarith. rewrite Zmod_small with (a := t); auto with zarith. apply Zmod_small; auto with zarith. split; auto with zarith. assert (0 <= 2 ^a * r); auto with zarith. - apply Zplus_le_0_compat; auto with zarith. + apply Z.add_nonneg_nonneg; auto with zarith. match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end; auto with zarith. pattern (2 ^ b) at 2;replace (2 ^ b) with ((2 ^ b - 2 ^a) + 2 ^ a); try ring. - apply Zplus_le_lt_compat; auto with zarith. + apply Z.add_le_lt_mono; auto with zarith. replace b with ((b - a) + a); try ring. rewrite Zpower_exp; auto with zarith. - pattern (2 ^a) at 4; rewrite <- (Zmult_1_l (2 ^a)); - try rewrite <- Zmult_minus_distr_r. - repeat rewrite (fun x => Zmult_comm x (2 ^ a)); rewrite Zmult_mod_distr_l; + pattern (2 ^a) at 4; rewrite <- (Z.mul_1_l (2 ^a)); + try rewrite <- Z.mul_sub_distr_r. + repeat rewrite (fun x => Z.mul_comm x (2 ^ a)); rewrite Zmult_mod_distr_l; auto with zarith. - apply Zmult_le_compat_l; auto with zarith. + apply Z.mul_le_mono_nonneg_l; auto with zarith. match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end; auto with zarith. Qed. @@ -243,13 +241,13 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. Proof. intros a b r t (H1, H2) H3 (H4, H5). assert (Eq: t < 2 ^ b); auto with zarith. - apply Zlt_le_trans with (1 := H5); auto with zarith. + apply Z.lt_le_trans with (1 := H5); auto with zarith. apply Zpower_le_monotone; auto with zarith. pattern (r * 2 ^ a) at 1; rewrite Z_div_mod_eq with (b := 2 ^ b); auto with zarith. - rewrite <- Zplus_assoc. + rewrite <- Z.add_assoc. rewrite <- Zmod_shift_r; auto with zarith. - rewrite (Zmult_comm (2 ^ b)); rewrite Z_div_plus_full_l; auto with zarith. + rewrite (Z.mul_comm (2 ^ b)); rewrite Z_div_plus_full_l; auto with zarith. rewrite (fun x y => @Zdiv_small (x mod y)); auto with zarith. match goal with |- context [?X mod ?Y] => case (Z_mod_lt X Y) end; auto with zarith. @@ -264,7 +262,7 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. intros n p a H1 H2. pattern (a*2^p) at 1;replace (a*2^p) with (a*2^p/2^n * 2^n + a*2^p mod 2^n). - 2:symmetry;rewrite (Zmult_comm (a*2^p/2^n));apply Z_div_mod_eq. + 2:symmetry;rewrite (Z.mul_comm (a*2^p/2^n));apply Z_div_mod_eq. replace (a * 2 ^ p / 2 ^ n) with (a / 2 ^ (n - p));trivial. replace (2^n) with (2^(n-p)*2^p). symmetry;apply Zdiv_mult_cancel_r. @@ -273,7 +271,7 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. rewrite <- Zpower_exp. replace (n-p+p) with n;trivial. ring. omega. omega. - apply Zlt_gt. apply Zpower_gt_0;auto with zarith. + apply Z.lt_gt. apply Z.pow_pos_nonneg;auto with zarith. Qed. @@ -284,15 +282,15 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. intros. rewrite Zmod_small. rewrite Zmod_eq by (auto with zarith). - unfold Zminus at 1. + unfold Z.sub at 1. rewrite Z_div_plus_l by (auto with zarith). assert (2^n = 2^(n-p)*2^p). rewrite <- Zpower_exp by (auto with zarith). replace (n-p+p) with n; auto with zarith. rewrite H0. rewrite <- Zdiv_Zdiv, Z_div_mult by (auto with zarith). - rewrite (Zmult_comm (2^(n-p))), Zmult_assoc. - rewrite Zopp_mult_distr_l. + rewrite (Z.mul_comm (2^(n-p))), Z.mul_assoc. + rewrite <- Z.mul_opp_l. rewrite Z_div_mult by (auto with zarith). symmetry; apply Zmod_eq; auto with zarith. @@ -301,9 +299,9 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. split. apply Z_div_pos; auto with zarith. apply Zdiv_lt_upper_bound; auto with zarith. - apply Zlt_le_trans with (2^n); auto with zarith. - rewrite <- (Zmult_1_r (2^n)) at 1. - apply Zmult_le_compat; auto with zarith. + apply Z.lt_le_trans with (2^n); auto with zarith. + rewrite <- (Z.mul_1_r (2^n)) at 1. + apply Z.mul_le_mono_nonneg; auto with zarith. cut (0 < 2 ^ (n-p)); auto with zarith. Qed. @@ -320,8 +318,8 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. Proof. intros p x y H;destruct (Z_le_gt_dec 0 p). apply Zdiv_lt_upper_bound;auto with zarith. - apply Zlt_le_trans with y;auto with zarith. - rewrite <- (Zmult_1_r y);apply Zmult_le_compat;auto with zarith. + apply Z.lt_le_trans with y;auto with zarith. + rewrite <- (Z.mul_1_r y);apply Z.mul_le_mono_nonneg;auto with zarith. assert (0 < 2^p);auto with zarith. replace (2^p) with 0. destruct x;change (0<y);auto with zarith. @@ -329,15 +327,13 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. Qed. Theorem Zgcd_div_pos a b: - 0 < b -> 0 < Zgcd a b -> 0 < b / Zgcd a b. + 0 < b -> 0 < Z.gcd a b -> 0 < b / Z.gcd a b. Proof. - intros Ha Hg. - case (Zle_lt_or_eq 0 (b/Zgcd a b)); auto. - apply Z_div_pos; auto with zarith. - intros H; generalize Ha. - pattern b at 1; rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto. - rewrite <- H; auto with zarith. - assert (F := (Zgcd_is_gcd a b)); inversion F; auto. + intros Hb Hg. + assert (H : 0 <= b / Z.gcd a b) by (apply Z.div_pos; auto with zarith). + Z.le_elim H; trivial. + rewrite (Zdivide_Zdiv_eq (Z.gcd a b) b), <- H, Z.mul_0_r in Hb; + auto using Z.gcd_divide_r with zarith. Qed. Theorem Zdiv_neg a b: @@ -347,7 +343,7 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. assert (b > 0) by omega. generalize (Z_mult_div_ge a _ H); intros. assert (b * (a / b) < 0)%Z. - apply Zle_lt_trans with a; auto with zarith. + apply Z.le_lt_trans with a; auto with zarith. destruct b; try (compute in Hb; discriminate). destruct (a/Zpos p)%Z. compute in H1; discriminate. @@ -355,20 +351,20 @@ Theorem Zmod_le_first: forall a b, 0 <= a -> 0 < b -> 0 <= a mod b <= a. compute; auto. Qed. - Lemma Zdiv_gcd_zero : forall a b, b / Zgcd a b = 0 -> b <> 0 -> - Zgcd a b = 0. + Lemma Zdiv_gcd_zero : forall a b, b / Z.gcd a b = 0 -> b <> 0 -> + Z.gcd a b = 0. Proof. intros. generalize (Zgcd_is_gcd a b); destruct 1. destruct H2 as (k,Hk). generalize H; rewrite Hk at 1. - destruct (Z_eq_dec (Zgcd a b) 0) as [H'|H']; auto. + destruct (Z.eq_dec (Z.gcd a b) 0) as [H'|H']; auto. rewrite Z_div_mult_full; auto. intros; subst k; simpl in *; subst b; elim H0; auto. Qed. Lemma Zgcd_mult_rel_prime : forall a b c, - Zgcd a c = 1 -> Zgcd b c = 1 -> Zgcd (a*b) c = 1. + Z.gcd a c = 1 -> Z.gcd b c = 1 -> Z.gcd (a*b) c = 1. Proof. intros. rewrite Zgcd_1_rel_prime in *. @@ -396,23 +392,20 @@ intros Q b Q0 QS. set (Q' := fun n => (n < b /\ Q n) \/ (b <= n)). assert (H : forall n, 0 <= n -> Q' n). apply natlike_rec2; unfold Q'. -destruct (Zle_or_lt b 0) as [H | H]. now right. left; now split. +destruct (Z.le_gt_cases b 0) as [H | H]. now right. left; now split. intros n H IH. destruct IH as [[IH1 IH2] | IH]. -destruct (Zle_or_lt (b - 1) n) as [H1 | H1]. +destruct (Z.le_gt_cases (b - 1) n) as [H1 | H1]. right; auto with zarith. left. split; [auto with zarith | now apply (QS n)]. right; auto with zarith. unfold Q' in *; intros n H1 H2. destruct (H n H1) as [[H3 H4] | H3]. -assumption. apply Zle_not_lt in H3. false_hyp H2 H3. +assumption. now apply Z.le_ngt in H3. Qed. -Lemma Zsquare_le : forall x, x <= x*x. +Lemma Zsquare_le x : x <= x*x. Proof. -intros. -destruct (Z_lt_le_dec 0 x). -pattern x at 1; rewrite <- (Zmult_1_l x). -apply Zmult_le_compat; auto with zarith. -apply Zle_trans with 0; auto with zarith. -rewrite <- Zmult_opp_opp. -apply Zmult_le_0_compat; auto with zarith. +destruct (Z.lt_ge_cases 0 x). +- rewrite <- Z.mul_1_l at 1. + rewrite <- Z.mul_le_mono_pos_r; auto with zarith. +- pose proof (Z.square_nonneg x); auto with zarith. Qed. diff --git a/theories/Numbers/BinNums.v b/theories/Numbers/BinNums.v index dfb2c502..aab2c14f 100644 --- a/theories/Numbers/BinNums.v +++ b/theories/Numbers/BinNums.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v b/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v index 59656eed..9a8a7691 100644 --- a/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v +++ b/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -111,7 +111,7 @@ Module ZnZ. (* Conversion functions with Z *) spec_to_Z : forall x, 0 <= [| x |] < wB; spec_of_pos : forall p, - Zpos p = (Z_of_N (fst (of_pos p)))*wB + [|(snd (of_pos p))|]; + Zpos p = (Z.of_N (fst (of_pos p)))*wB + [|(snd (of_pos p))|]; spec_zdigits : [| zdigits |] = Zpos digits; spec_more_than_1_digit: 1 < Zpos digits; @@ -284,11 +284,11 @@ Module ZnZ. generalize (spec_of_pos p). case (of_pos p); intros n w1; simpl. case n; simpl Npos; auto with zarith. - intros p1 Hp1; contradict Hp; apply Zle_not_lt. + intros p1 Hp1; contradict Hp; apply Z.le_ngt. replace (base digits) with (1 * base digits + 0) by ring. rewrite Hp1. - apply Zplus_le_compat. - apply Zmult_le_compat; auto with zarith. + apply Z.add_le_mono. + apply Z.mul_le_mono_nonneg; auto with zarith. case p1; simpl; intros; red; simpl; intros; discriminate. unfold base; auto with zarith. case (spec_to_Z w1); auto with zarith. @@ -305,7 +305,7 @@ Module ZnZ. Proof. intros p; case p; simpl; try rewrite spec_0; auto. intros; rewrite of_pos_correct; auto with zarith. - intros p1 (H1, _); contradict H1; apply Zlt_not_le; red; simpl; auto. + intros p1 (H1, _); contradict H1; apply Z.lt_nge; red; simpl; auto. Qed. End Of_Z. @@ -346,46 +346,46 @@ Ltac zify := unfold eq in *; autorewrite with cyclic. Lemma add_0_l : forall x, 0 + x == x. Proof. -intros. zify. rewrite Zplus_0_l. +intros. zify. rewrite Z.add_0_l. apply Zmod_small. apply ZnZ.spec_to_Z. Qed. Lemma add_comm : forall x y, x + y == y + x. Proof. -intros. zify. now rewrite Zplus_comm. +intros. zify. now rewrite Z.add_comm. Qed. Lemma add_assoc : forall x y z, x + (y + z) == x + y + z. Proof. -intros. zify. now rewrite Zplus_mod_idemp_r, Zplus_mod_idemp_l, Zplus_assoc. +intros. zify. now rewrite Zplus_mod_idemp_r, Zplus_mod_idemp_l, Z.add_assoc. Qed. Lemma mul_1_l : forall x, 1 * x == x. Proof. -intros. zify. rewrite Zmult_1_l. +intros. zify. rewrite Z.mul_1_l. apply Zmod_small. apply ZnZ.spec_to_Z. Qed. Lemma mul_comm : forall x y, x * y == y * x. Proof. -intros. zify. now rewrite Zmult_comm. +intros. zify. now rewrite Z.mul_comm. Qed. Lemma mul_assoc : forall x y z, x * (y * z) == x * y * z. Proof. -intros. zify. now rewrite Zmult_mod_idemp_r, Zmult_mod_idemp_l, Zmult_assoc. +intros. zify. now rewrite Zmult_mod_idemp_r, Zmult_mod_idemp_l, Z.mul_assoc. Qed. Lemma mul_add_distr_r : forall x y z, (x+y)*z == x*z + y*z. Proof. -intros. zify. now rewrite <- Zplus_mod, Zmult_mod_idemp_l, Zmult_plus_distr_l. +intros. zify. now rewrite <- Zplus_mod, Zmult_mod_idemp_l, Z.mul_add_distr_r. Qed. Lemma add_opp_r : forall x y, x + - y == x-y. Proof. -intros. zify. rewrite <- Zminus_mod_idemp_r. unfold Zminus. -destruct (Z_eq_dec ([|y|] mod wB) 0) as [EQ|NEQ]. -rewrite Z_mod_zero_opp_full, EQ, 2 Zplus_0_r; auto. +intros. zify. rewrite <- Zminus_mod_idemp_r. unfold Z.sub. +destruct (Z.eq_dec ([|y|] mod wB) 0) as [EQ|NEQ]. +rewrite Z_mod_zero_opp_full, EQ, 2 Z.add_0_r; auto. rewrite Z_mod_nz_opp_full by auto. rewrite <- Zplus_mod_idemp_r, <- Zminus_mod_idemp_l. rewrite Z_mod_same_full. simpl. now rewrite Zplus_mod_idemp_r. @@ -393,7 +393,7 @@ Qed. Lemma add_opp_diag_r : forall x, x + - x == 0. Proof. -intros. red. rewrite add_opp_r. zify. now rewrite Zminus_diag, Zmod_0_l. +intros. red. rewrite add_opp_r. zify. now rewrite Z.sub_diag, Zmod_0_l. Qed. Lemma CyclicRing : ring_theory 0 1 ZnZ.add ZnZ.mul ZnZ.sub ZnZ.opp eq. @@ -413,19 +413,9 @@ Lemma eqb_eq : forall x y, eqb x y = true <-> x == y. Proof. intros. unfold eqb, eq. rewrite ZnZ.spec_compare. - case Zcompare_spec; intuition; try discriminate. + case Z.compare_spec; intuition; try discriminate. Qed. -(* POUR HUGO: -Lemma eqb_eq : forall x y, eqb x y = true <-> x == y. -Proof. - intros. unfold eqb, eq. generalize (ZnZ.spec_compare x y). - case (ZnZ.compare x y); intuition; try discriminate. - (* BUG ?! using destruct instead of case won't work: - it gives 3 subcases, but ZnZ.compare x y is still there in them! *) -Qed. -*) - Lemma eqb_correct : forall x y, eqb x y = true -> x==y. Proof. now apply eqb_eq. Qed. diff --git a/theories/Numbers/Cyclic/Abstract/NZCyclic.v b/theories/Numbers/Cyclic/Abstract/NZCyclic.v index c52cbe10..1d5b78ec 100644 --- a/theories/Numbers/Cyclic/Abstract/NZCyclic.v +++ b/theories/Numbers/Cyclic/Abstract/NZCyclic.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -69,7 +69,7 @@ Program Instance mul_wd : Proper (eq ==> eq ==> eq) mul. Theorem gt_wB_1 : 1 < wB. Proof. -unfold base. apply Zpower_gt_1; unfold Zlt; auto with zarith. +unfold base. apply Zpower_gt_1; unfold Z.lt; auto with zarith. Qed. Theorem gt_wB_0 : 0 < wB. @@ -161,20 +161,20 @@ End Induction. Theorem add_0_l : forall n, 0 + n == n. Proof. intro n. zify. -rewrite Zplus_0_l. apply Zmod_small. apply ZnZ.spec_to_Z. +rewrite Z.add_0_l. apply Zmod_small. apply ZnZ.spec_to_Z. Qed. Theorem add_succ_l : forall n m, (S n) + m == S (n + m). Proof. intros n m. zify. rewrite succ_mod_wB. repeat rewrite Zplus_mod_idemp_l; try apply gt_wB_0. -rewrite <- (Zplus_assoc ([| n |] mod wB) 1 [| m |]). rewrite Zplus_mod_idemp_l. -rewrite (Zplus_comm 1 [| m |]); now rewrite Zplus_assoc. +rewrite <- (Z.add_assoc ([| n |] mod wB) 1 [| m |]). rewrite Zplus_mod_idemp_l. +rewrite (Z.add_comm 1 [| m |]); now rewrite Z.add_assoc. Qed. Theorem sub_0_r : forall n, n - 0 == n. Proof. -intro n. zify. rewrite Zminus_0_r. apply NZ_to_Z_mod. +intro n. zify. rewrite Z.sub_0_r. apply NZ_to_Z_mod. Qed. Theorem sub_succ_r : forall n m, n - (S m) == P (n - m). @@ -192,7 +192,7 @@ Qed. Theorem mul_succ_l : forall n m, (S n) * m == n * m + m. Proof. intros n m. zify. rewrite Zplus_mod_idemp_l, Zmult_mod_idemp_l. -now rewrite Zmult_plus_distr_l, Zmult_1_l. +now rewrite Z.mul_add_distr_r, Z.mul_1_l. Qed. Definition t := t. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleAdd.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleAdd.v index deb216dd..35d8b595 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleAdd.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleAdd.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -182,7 +182,7 @@ Section DoubleAdd. destruct x as [ |xh xl];simpl. apply spec_ww_1. generalize (spec_w_succ_c xl);destruct (w_succ_c xl) as [l|l]; intro H;unfold interp_carry in H. simpl;rewrite H;ring. - rewrite <- Zplus_assoc;rewrite <- H;rewrite Zmult_1_l. + rewrite <- Z.add_assoc;rewrite <- H;rewrite Z.mul_1_l. assert ([|l|] = 0). generalize (spec_to_Z xl)(spec_to_Z l);omega. rewrite H0;generalize (spec_w_succ_c xh);destruct (w_succ_c xh) as [h|h]; intro H1;unfold interp_carry in H1. @@ -195,19 +195,19 @@ Section DoubleAdd. Lemma spec_ww_add_c : forall x y, [+[ww_add_c x y]] = [[x]] + [[y]]. Proof. destruct x as [ |xh xl];simpl;trivial. - destruct y as [ |yh yl];simpl. rewrite Zplus_0_r;trivial. + destruct y as [ |yh yl];simpl. rewrite Z.add_0_r;trivial. replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|])) with (([|xh|]+[|yh|])*wB + ([|xl|]+[|yl|])). 2:ring. generalize (spec_w_add_c xl yl);destruct (w_add_c xl yl) as [l|l]; intros H;unfold interp_carry in H;rewrite <- H. generalize (spec_w_add_c xh yh);destruct (w_add_c xh yh) as [h|h]; intros H1;unfold interp_carry in *;rewrite <- H1. trivial. - repeat rewrite Zmult_1_l;rewrite spec_w_WW;rewrite wwB_wBwB; ring. - rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. + repeat rewrite Z.mul_1_l;rewrite spec_w_WW;rewrite wwB_wBwB; ring. + rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r. generalize (spec_w_add_carry_c xh yh);destruct (w_add_carry_c xh yh) as [h|h]; intros H1;unfold interp_carry in *;rewrite <- H1. simpl;ring. - repeat rewrite Zmult_1_l;rewrite wwB_wBwB;rewrite spec_w_WW;ring. + repeat rewrite Z.mul_1_l;rewrite wwB_wBwB;rewrite spec_w_WW;ring. Qed. Section Cont. @@ -221,23 +221,23 @@ Section DoubleAdd. destruct x as [ |xh xl];simpl;trivial. apply spec_f0;trivial. destruct y as [ |yh yl];simpl. - apply spec_f0;simpl;rewrite Zplus_0_r;trivial. + apply spec_f0;simpl;rewrite Z.add_0_r;trivial. generalize (spec_w_add_c xl yl);destruct (w_add_c xl yl) as [l|l]; intros H;unfold interp_carry in H. generalize (spec_w_add_c xh yh);destruct (w_add_c xh yh) as [h|h]; intros H1;unfold interp_carry in *. apply spec_f0. simpl;rewrite H;rewrite H1;ring. apply spec_f1. simpl;rewrite spec_w_WW;rewrite H. - rewrite Zplus_assoc;rewrite wwB_wBwB. rewrite Zpower_2; rewrite <- Zmult_plus_distr_l. - rewrite Zmult_1_l in H1;rewrite H1;ring. + rewrite Z.add_assoc;rewrite wwB_wBwB. rewrite Z.pow_2_r; rewrite <- Z.mul_add_distr_r. + rewrite Z.mul_1_l in H1;rewrite H1;ring. generalize (spec_w_add_carry_c xh yh);destruct (w_add_carry_c xh yh) as [h|h]; intros H1;unfold interp_carry in *. - apply spec_f0;simpl;rewrite H1. rewrite Zmult_plus_distr_l. - rewrite <- Zplus_assoc;rewrite H;ring. + apply spec_f0;simpl;rewrite H1. rewrite Z.mul_add_distr_r. + rewrite <- Z.add_assoc;rewrite H;ring. apply spec_f1. simpl;rewrite spec_w_WW;rewrite wwB_wBwB. - rewrite Zplus_assoc; rewrite Zpower_2; rewrite <- Zmult_plus_distr_l. - rewrite Zmult_1_l in H1;rewrite H1. rewrite Zmult_plus_distr_l. - rewrite <- Zplus_assoc;rewrite H;ring. + rewrite Z.add_assoc; rewrite Z.pow_2_r; rewrite <- Z.mul_add_distr_r. + rewrite Z.mul_1_l in H1;rewrite H1. rewrite Z.mul_add_distr_r. + rewrite <- Z.add_assoc;rewrite H;ring. Qed. End Cont. @@ -248,19 +248,19 @@ Section DoubleAdd. destruct x as [ |xh xl];intro y;simpl. exact (spec_ww_succ_c y). destruct y as [ |yh yl];simpl. - rewrite Zplus_0_r;exact (spec_ww_succ_c (WW xh xl)). + rewrite Z.add_0_r;exact (spec_ww_succ_c (WW xh xl)). replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|]) + 1) with (([|xh|]+[|yh|])*wB + ([|xl|]+[|yl|]+1)). 2:ring. generalize (spec_w_add_carry_c xl yl);destruct (w_add_carry_c xl yl) as [l|l];intros H;unfold interp_carry in H;rewrite <- H. generalize (spec_w_add_c xh yh);destruct (w_add_c xh yh) as [h|h]; intros H1;unfold interp_carry in H1;rewrite <- H1. trivial. - unfold interp_carry;repeat rewrite Zmult_1_l;simpl;rewrite wwB_wBwB;ring. - rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. + unfold interp_carry;repeat rewrite Z.mul_1_l;simpl;rewrite wwB_wBwB;ring. + rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r. generalize (spec_w_add_carry_c xh yh);destruct (w_add_carry_c xh yh) as [h|h];intros H1;unfold interp_carry in H1;rewrite <- H1. trivial. unfold interp_carry;rewrite spec_w_WW; - repeat rewrite Zmult_1_l;simpl;rewrite wwB_wBwB;ring. + repeat rewrite Z.mul_1_l;simpl;rewrite wwB_wBwB;ring. Qed. Lemma spec_ww_succ : forall x, [[ww_succ x]] = ([[x]] + 1) mod wwB. @@ -268,14 +268,14 @@ Section DoubleAdd. destruct x as [ |xh xl];simpl. rewrite spec_ww_1;rewrite Zmod_small;trivial. split;[intro;discriminate|apply wwB_pos]. - rewrite <- Zplus_assoc;generalize (spec_w_succ_c xl); + rewrite <- Z.add_assoc;generalize (spec_w_succ_c xl); destruct (w_succ_c xl) as[l|l];intro H;unfold interp_carry in H;rewrite <-H. rewrite Zmod_small;trivial. rewrite wwB_wBwB;apply beta_mult;apply spec_to_Z. assert ([|l|] = 0). clear spec_ww_1 spec_w_1 spec_w_0. assert (H1:= spec_to_Z l); assert (H2:= spec_to_Z xl); omega. - rewrite H0;rewrite Zplus_0_r;rewrite <- Zmult_plus_distr_l;rewrite wwB_wBwB. - rewrite Zpower_2; rewrite Zmult_mod_distr_r;try apply lt_0_wB. + rewrite H0;rewrite Z.add_0_r;rewrite <- Z.mul_add_distr_r;rewrite wwB_wBwB. + rewrite Z.pow_2_r; rewrite Zmult_mod_distr_r;try apply lt_0_wB. rewrite spec_w_W0;rewrite spec_w_succ;trivial. Qed. @@ -284,7 +284,7 @@ Section DoubleAdd. destruct x as [ |xh xl];intros y;simpl. rewrite Zmod_small;trivial. apply spec_ww_to_Z;trivial. destruct y as [ |yh yl]. - change [[W0]] with 0;rewrite Zplus_0_r. + change [[W0]] with 0;rewrite Z.add_0_r. rewrite Zmod_small;trivial. exact (spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW xh xl)). simpl. replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|])) @@ -292,7 +292,7 @@ Section DoubleAdd. generalize (spec_w_add_c xl yl);destruct (w_add_c xl yl) as [l|l]; unfold interp_carry;intros H;simpl;rewrite <- H. rewrite (mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_w_add;trivial. - rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. + rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r. rewrite(mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_w_add_carry;trivial. Qed. @@ -302,13 +302,13 @@ Section DoubleAdd. destruct x as [ |xh xl];intros y;simpl. exact (spec_ww_succ y). destruct y as [ |yh yl]. - change [[W0]] with 0;rewrite Zplus_0_r. exact (spec_ww_succ (WW xh xl)). + change [[W0]] with 0;rewrite Z.add_0_r. exact (spec_ww_succ (WW xh xl)). simpl;replace ([|xh|] * wB + [|xl|] + ([|yh|] * wB + [|yl|]) + 1) with (([|xh|]+[|yh|])*wB + ([|xl|]+[|yl|]+1)). 2:ring. generalize (spec_w_add_carry_c xl yl);destruct (w_add_carry_c xl yl) as [l|l];unfold interp_carry;intros H;rewrite <- H;simpl ww_to_Z. rewrite(mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_w_add;trivial. - rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. + rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r. rewrite(mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_w_add_carry;trivial. Qed. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v index e6c5a0e0..ed69a8f5 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -161,13 +161,13 @@ Section DoubleBase. Variable spec_w_0W : forall l, [[w_0W l]] = [|l|]. Variable spec_to_Z : forall x, 0 <= [|x|] < wB. Variable spec_w_compare : forall x y, - w_compare x y = Zcompare [|x|] [|y|]. + w_compare x y = Z.compare [|x|] [|y|]. Lemma wwB_wBwB : wwB = wB^2. Proof. - unfold base, ww_digits;rewrite Zpower_2; rewrite (Zpos_xO w_digits). + unfold base, ww_digits;rewrite Z.pow_2_r; rewrite (Pos2Z.inj_xO w_digits). replace (2 * Zpos w_digits) with (Zpos w_digits + Zpos w_digits). - apply Zpower_exp; unfold Zge;simpl;intros;discriminate. + apply Zpower_exp; unfold Z.ge;simpl;intros;discriminate. ring. Qed. @@ -179,28 +179,28 @@ Section DoubleBase. Lemma lt_0_wB : 0 < wB. Proof. - unfold base;apply Zpower_gt_0. unfold Zlt;reflexivity. - unfold Zle;intros H;discriminate H. + unfold base;apply Z.pow_pos_nonneg. unfold Z.lt;reflexivity. + unfold Z.le;intros H;discriminate H. Qed. Lemma lt_0_wwB : 0 < wwB. - Proof. rewrite wwB_wBwB; rewrite Zpower_2; apply Zmult_lt_0_compat;apply lt_0_wB. Qed. + Proof. rewrite wwB_wBwB; rewrite Z.pow_2_r; apply Z.mul_pos_pos;apply lt_0_wB. Qed. Lemma wB_pos: 1 < wB. Proof. - unfold base;apply Zlt_le_trans with (2^1). unfold Zlt;reflexivity. - apply Zpower_le_monotone. unfold Zlt;reflexivity. - split;unfold Zle;intros H. discriminate H. + unfold base;apply Z.lt_le_trans with (2^1). unfold Z.lt;reflexivity. + apply Zpower_le_monotone. unfold Z.lt;reflexivity. + split;unfold Z.le;intros H. discriminate H. clear spec_w_0W w_0W spec_w_Bm1 spec_to_Z spec_w_WW w_WW. destruct w_digits; discriminate H. Qed. Lemma wwB_pos: 1 < wwB. Proof. - assert (H:= wB_pos);rewrite wwB_wBwB;rewrite <-(Zmult_1_r 1). - rewrite Zpower_2. - apply Zmult_lt_compat2;(split;[unfold Zlt;reflexivity|trivial]). - apply Zlt_le_weak;trivial. + assert (H:= wB_pos);rewrite wwB_wBwB;rewrite <-(Z.mul_1_r 1). + rewrite Z.pow_2_r. + apply Zmult_lt_compat2;(split;[unfold Z.lt;reflexivity|trivial]). + apply Z.lt_le_incl;trivial. Qed. Theorem wB_div_2: 2 * (wB / 2) = wB. @@ -208,22 +208,22 @@ Section DoubleBase. clear spec_w_0 w_0 spec_w_1 w_1 spec_w_Bm1 w_Bm1 spec_w_WW spec_w_0W spec_to_Z;unfold base. assert (2 ^ Zpos w_digits = 2 * (2 ^ (Zpos w_digits - 1))). - pattern 2 at 2; rewrite <- Zpower_1_r. + pattern 2 at 2; rewrite <- Z.pow_1_r. rewrite <- Zpower_exp; auto with zarith. f_equal; auto with zarith. case w_digits; compute; intros; discriminate. rewrite H; f_equal; auto with zarith. - rewrite Zmult_comm; apply Z_div_mult; auto with zarith. + rewrite Z.mul_comm; apply Z_div_mult; auto with zarith. Qed. Theorem wwB_div_2 : wwB / 2 = wB / 2 * wB. Proof. clear spec_w_0 w_0 spec_w_1 w_1 spec_w_Bm1 w_Bm1 spec_w_WW spec_w_0W spec_to_Z. - rewrite wwB_wBwB; rewrite Zpower_2. + rewrite wwB_wBwB; rewrite Z.pow_2_r. pattern wB at 1; rewrite <- wB_div_2; auto. - rewrite <- Zmult_assoc. - repeat (rewrite (Zmult_comm 2); rewrite Z_div_mult); auto with zarith. + rewrite <- Z.mul_assoc. + repeat (rewrite (Z.mul_comm 2); rewrite Z_div_mult); auto with zarith. Qed. Lemma mod_wwB : forall z x, @@ -231,15 +231,15 @@ Section DoubleBase. Proof. intros z x. rewrite Zplus_mod. - pattern wwB at 1;rewrite wwB_wBwB; rewrite Zpower_2. + pattern wwB at 1;rewrite wwB_wBwB; rewrite Z.pow_2_r. rewrite Zmult_mod_distr_r;try apply lt_0_wB. rewrite (Zmod_small [|x|]). apply Zmod_small;rewrite wwB_wBwB;apply beta_mult;try apply spec_to_Z. - apply Z_mod_lt;apply Zlt_gt;apply lt_0_wB. + apply Z_mod_lt;apply Z.lt_gt;apply lt_0_wB. destruct (spec_to_Z x);split;trivial. change [|x|] with (0*wB+[|x|]). rewrite wwB_wBwB. - rewrite Zpower_2;rewrite <- (Zplus_0_r (wB*wB));apply beta_lex_inv. - apply lt_0_wB. apply spec_to_Z. split;[apply Zle_refl | apply lt_0_wB]. + rewrite Z.pow_2_r;rewrite <- (Z.add_0_r (wB*wB));apply beta_lex_inv. + apply lt_0_wB. apply spec_to_Z. split;[apply Z.le_refl | apply lt_0_wB]. Qed. Lemma wB_div : forall x y, ([|x|] * wB + [|y|]) / wB = [|x|]. @@ -265,29 +265,29 @@ Section DoubleBase. clear spec_w_0 spec_w_1 spec_w_Bm1 w_0 w_1 w_Bm1. unfold base;apply Zpower_lt_monotone;auto with zarith. assert (0 < Zpos w_digits). compute;reflexivity. - unfold ww_digits;rewrite Zpos_xO;auto with zarith. + unfold ww_digits;rewrite Pos2Z.inj_xO;auto with zarith. Qed. Lemma w_to_Z_wwB : forall x, x < wB -> x < wwB. Proof. - intros x H;apply Zlt_trans with wB;trivial;apply lt_wB_wwB. + intros x H;apply Z.lt_trans with wB;trivial;apply lt_wB_wwB. Qed. Lemma spec_ww_to_Z : forall x, 0 <= [[x]] < wwB. Proof. clear spec_w_0 spec_w_1 spec_w_Bm1 w_0 w_1 w_Bm1. destruct x as [ |h l];simpl. - split;[apply Zle_refl|apply lt_0_wwB]. + split;[apply Z.le_refl|apply lt_0_wwB]. assert (H:=spec_to_Z h);assert (L:=spec_to_Z l);split. - apply Zplus_le_0_compat;auto with zarith. - rewrite <- (Zplus_0_r wwB);rewrite wwB_wBwB; rewrite Zpower_2; + apply Z.add_nonneg_nonneg;auto with zarith. + rewrite <- (Z.add_0_r wwB);rewrite wwB_wBwB; rewrite Z.pow_2_r; apply beta_lex_inv;auto with zarith. Qed. Lemma double_wB_wwB : forall n, double_wB n * double_wB n = double_wB (S n). Proof. intros n;unfold double_wB;simpl. - unfold base. rewrite Pshiftl_nat_S, (Zpos_xO (_ << _)). + unfold base. rewrite Pshiftl_nat_S, (Pos2Z.inj_xO (_ << _)). replace (2 * Zpos (w_digits << n)) with (Zpos (w_digits << n) + Zpos (w_digits << n)) by ring. symmetry; apply Zpower_exp;intro;discriminate. @@ -306,14 +306,14 @@ Section DoubleBase. intros n; elim n; clear n; auto. unfold double_wB, "<<"; auto with zarith. intros n H1; rewrite <- double_wB_wwB. - apply Zle_trans with (wB * 1). - rewrite Zmult_1_r; apply Zle_refl. - apply Zmult_le_compat; auto with zarith. - apply Zle_trans with wB; auto with zarith. - unfold base. - rewrite <- (Zpower_0_r 2). - apply Zpower_le_monotone2; auto with zarith. + apply Z.le_trans with (wB * 1). + rewrite Z.mul_1_r; apply Z.le_refl. unfold base; auto with zarith. + apply Z.mul_le_mono_nonneg; auto with zarith. + apply Z.le_trans with wB; auto with zarith. + unfold base. + rewrite <- (Z.pow_0_r 2). + apply Z.pow_le_mono_r; auto with zarith. Qed. Lemma spec_double_to_Z : @@ -326,9 +326,9 @@ Section DoubleBase. unfold double_wB,base;split;auto with zarith. assert (U0:= IHn w0);assert (U1:= IHn w1). split;auto with zarith. - apply Zlt_le_trans with ((double_wB n - 1) * double_wB n + double_wB n). + apply Z.lt_le_trans with ((double_wB n - 1) * double_wB n + double_wB n). assert (double_to_Z n w0*double_wB n <= (double_wB n - 1)*double_wB n). - apply Zmult_le_compat_r;auto with zarith. + apply Z.mul_le_mono_nonneg_r;auto with zarith. auto with zarith. rewrite <- double_wB_wwB. replace ((double_wB n - 1) * double_wB n + double_wB n) with (double_wB n * double_wB n); @@ -342,22 +342,19 @@ Section DoubleBase. clear spec_w_1 spec_w_Bm1. intros n; elim n; auto; clear n. intros n Hrec x; case x; clear x; auto. - intros xx yy H1; simpl in H1. - assert (F1: [!n | xx!] = 0). - case (Zle_lt_or_eq 0 ([!n | xx!])); auto. - case (spec_double_to_Z n xx); auto. - intros F2. - assert (F3 := double_wB_more_digits n). - assert (F4: 0 <= [!n | yy!]). - case (spec_double_to_Z n yy); auto. + intros xx yy; simpl. + destruct (spec_double_to_Z n xx) as [F1 _]. Z.le_elim F1. + - (* 0 < [!n | xx!] *) + intros; exfalso. + assert (F3 := double_wB_more_digits n). + destruct (spec_double_to_Z n yy) as [F4 _]. assert (F5: 1 * wB <= [!n | xx!] * double_wB n); auto with zarith. - apply Zmult_le_compat; auto with zarith. + apply Z.mul_le_mono_nonneg; auto with zarith. unfold base; auto with zarith. - simpl get_low; simpl double_to_Z. - generalize H1; clear H1. - rewrite F1; rewrite Zmult_0_l; rewrite Zplus_0_l. - intros H1; apply Hrec; auto. + - (* 0 = [!n | xx!] *) + rewrite <- F1; rewrite Z.mul_0_l, Z.add_0_l. + intros; apply Hrec; auto. Qed. Lemma spec_double_WW : forall n (h l : word w n), @@ -399,36 +396,36 @@ Section DoubleBase. Ltac comp2ord := match goal with | |- Lt = (?x ?= ?y) => symmetry; change (x < y) - | |- Gt = (?x ?= ?y) => symmetry; change (x > y); apply Zlt_gt + | |- Gt = (?x ?= ?y) => symmetry; change (x > y); apply Z.lt_gt end. Lemma spec_ww_compare : forall x y, - ww_compare x y = Zcompare [[x]] [[y]]. + ww_compare x y = Z.compare [[x]] [[y]]. Proof. destruct x as [ |xh xl];destruct y as [ |yh yl];simpl;trivial. (* 1st case *) rewrite 2 spec_w_compare, spec_w_0. - destruct (Zcompare_spec 0 [|yh|]) as [H|H|H]. + destruct (Z.compare_spec 0 [|yh|]) as [H|H|H]. rewrite <- H;simpl. reflexivity. symmetry. change (0 < [|yh|]*wB+[|yl|]). change 0 with (0*wB+0). rewrite <- spec_w_0 at 2. apply wB_lex_inv;trivial. - absurd (0 <= [|yh|]). apply Zlt_not_le; trivial. + absurd (0 <= [|yh|]). apply Z.lt_nge; trivial. destruct (spec_to_Z yh);trivial. (* 2nd case *) rewrite 2 spec_w_compare, spec_w_0. - destruct (Zcompare_spec [|xh|] 0) as [H|H|H]. + destruct (Z.compare_spec [|xh|] 0) as [H|H|H]. rewrite H;simpl;reflexivity. - absurd (0 <= [|xh|]). apply Zlt_not_le; trivial. + absurd (0 <= [|xh|]). apply Z.lt_nge; trivial. destruct (spec_to_Z xh);trivial. comp2ord. change 0 with (0*wB+0). rewrite <- spec_w_0 at 2. apply wB_lex_inv;trivial. (* 3rd case *) rewrite 2 spec_w_compare. - destruct (Zcompare_spec [|xh|] [|yh|]) as [H|H|H]. + destruct (Z.compare_spec [|xh|] [|yh|]) as [H|H|H]. rewrite H. - symmetry. apply Zcompare_plus_compat. + symmetry. apply Z.add_compare_mono_l. comp2ord. apply wB_lex_inv;trivial. comp2ord. apply wB_lex_inv;trivial. Qed. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v index 00a84052..35fe948e 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -390,21 +390,21 @@ Section Z_2nZ. Proof. refine (spec_ww_to_Z w_digits w_to_Z _);auto. Qed. Let spec_ww_of_pos : forall p, - Zpos p = (Z_of_N (fst (ww_of_pos p)))*wwB + [|(snd (ww_of_pos p))|]. + Zpos p = (Z.of_N (fst (ww_of_pos p)))*wwB + [|(snd (ww_of_pos p))|]. Proof. unfold ww_of_pos;intros. rewrite (ZnZ.spec_of_pos p). unfold w_of_pos. case (ZnZ.of_pos p); intros. simpl. destruct n; simpl ZnZ.to_Z. simpl;unfold w_to_Z,w_0; rewrite ZnZ.spec_0;trivial. - unfold Z_of_N. + unfold Z.of_N. rewrite (ZnZ.spec_of_pos p0). case (ZnZ.of_pos p0); intros. simpl. - unfold fst, snd,Z_of_N, to_Z, wB, w_digits, w_to_Z, w_WW. + unfold fst, snd,Z.of_N, to_Z, wB, w_digits, w_to_Z, w_WW. rewrite ZnZ.spec_WW. replace wwB with (wB*wB). unfold wB,w_to_Z,w_digits;destruct n;ring. - symmetry. rewrite <- Zpower_2; exact (wwB_wBwB w_digits). + symmetry. rewrite <- Z.pow_2_r; exact (wwB_wBwB w_digits). Qed. Let spec_ww_0 : [|W0|] = 0. @@ -417,7 +417,7 @@ Section Z_2nZ. Proof. refine (spec_ww_Bm1 w_Bm1 w_digits w_to_Z _);auto. Qed. Let spec_ww_compare : - forall x y, compare x y = Zcompare [|x|] [|y|]. + forall x y, compare x y = Z.compare [|x|] [|y|]. Proof. refine (spec_ww_compare w_0 w_digits w_to_Z w_compare _ _ _);auto. Qed. @@ -575,9 +575,9 @@ Section Z_2nZ. unfold w_add_c; case ZnZ.add_c; unfold interp_carry; simpl ww_to_Z. intros w0 Hw0; simpl; unfold w_to_Z; rewrite Hw0. unfold w_0; rewrite ZnZ.spec_0; simpl; auto with zarith. - intros w0; rewrite Zmult_1_l; simpl. + intros w0; rewrite Z.mul_1_l; simpl. unfold w_to_Z, w_1; rewrite ZnZ.spec_1; auto with zarith. - rewrite Zmult_1_l; auto. + rewrite Z.mul_1_l; auto. Qed. Let spec_low: forall x, @@ -585,7 +585,7 @@ Section Z_2nZ. intros x; case x; simpl low. unfold ww_to_Z, w_to_Z, w_0; rewrite ZnZ.spec_0; simpl; auto. intros xh xl; simpl. - rewrite Zplus_comm; rewrite Z_mod_plus; auto with zarith. + rewrite Z.add_comm; rewrite Z_mod_plus; auto with zarith. rewrite Zmod_small; auto with zarith. unfold wB, base; auto with zarith. Qed. @@ -597,7 +597,7 @@ Section Z_2nZ. rewrite spec_add2. unfold w_to_Z, w_zdigits, w_digits. rewrite ZnZ.spec_zdigits; auto. - rewrite Zpos_xO; auto with zarith. + rewrite Pos2Z.inj_xO; auto with zarith. Qed. @@ -605,7 +605,7 @@ Section Z_2nZ. Proof. refine (spec_ww_head00 w_0 w_0W w_compare w_head0 w_add2 w_zdigits _ww_zdigits - w_to_Z _ _ _ (refl_equal _ww_digits) _ _ _ _); auto. + w_to_Z _ _ _ (eq_refl _ww_digits) _ _ _ _); auto. exact ZnZ.spec_head00. exact ZnZ.spec_zdigits. Qed. @@ -623,7 +623,7 @@ Section Z_2nZ. Proof. refine (spec_ww_tail00 w_0 w_0W w_compare w_tail0 w_add2 w_zdigits _ww_zdigits - w_to_Z _ _ _ (refl_equal _ww_digits) _ _ _ _); wwauto. + w_to_Z _ _ _ (eq_refl _ww_digits) _ _ _ _); wwauto. exact ZnZ.spec_tail00. exact ZnZ.spec_zdigits. Qed. @@ -749,7 +749,7 @@ refine | false => [|x|] mod 2 = 1 end. Proof. - refine (@spec_ww_is_even t w_is_even w_0 w_1 w_Bm1 w_digits _ _ _ _ _); auto. + refine (@spec_ww_is_even t w_is_even w_digits _ _ ). exact ZnZ.spec_is_even. Qed. @@ -798,7 +798,7 @@ refine exact ZnZ.spec_zdigits. unfold w_to_Z, w_zdigits. rewrite ZnZ.spec_zdigits. - rewrite <- Zpos_xO; exact spec_ww_digits. + rewrite <- Pos2Z.inj_xO; exact spec_ww_digits. Qed. Global Instance mk_zn2z_specs_karatsuba : ZnZ.Specs mk_zn2z_ops_karatsuba. @@ -811,7 +811,7 @@ refine exact ZnZ.spec_zdigits. unfold w_to_Z, w_zdigits. rewrite ZnZ.spec_zdigits. - rewrite <- Zpos_xO; exact spec_ww_digits. + rewrite <- Pos2Z.inj_xO; exact spec_ww_digits. Qed. End Z_2nZ. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v index 0cb6848e..8525b0e1 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -80,7 +80,7 @@ Section POS_MOD. Variable spec_w_0W : forall l, [[w_0W l]] = [|l|]. Variable spec_ww_compare : forall x y, - ww_compare x y = Zcompare [[x]] [[y]]. + ww_compare x y = Z.compare [[x]] [[y]]. Variable spec_ww_sub: forall x y, [[ww_sub x y]] = ([[x]] - [[y]]) mod wwB. @@ -100,7 +100,7 @@ Section POS_MOD. unfold ww_pos_mod; case w1. simpl; rewrite Zmod_small; split; auto with zarith. intros xh xl; rewrite spec_ww_compare. - case Zcompare_spec; + case Z.compare_spec; rewrite spec_w_0W; rewrite spec_zdigits; fold wB; intros H1. rewrite H1; simpl ww_to_Z. @@ -117,19 +117,19 @@ Section POS_MOD. rewrite spec_low. apply Zmod_small; auto with zarith. case (spec_to_w_Z p); intros HHH1 HHH2; split; auto with zarith. - apply Zlt_le_trans with (1 := H1). + apply Z.lt_le_trans with (1 := H1). unfold base; apply Zpower2_le_lin; auto with zarith. rewrite HH0. rewrite Zplus_mod; auto with zarith. unfold base. rewrite <- (F0 (Zpos w_digits) [[p]]). rewrite Zpower_exp; auto with zarith. - rewrite Zmult_assoc. + rewrite Z.mul_assoc. rewrite Z_mod_mult; auto with zarith. autorewrite with w_rewrite rm10. rewrite Zmod_mod; auto with zarith. rewrite spec_ww_compare. - case Zcompare_spec; rewrite spec_ww_zdigits; + case Z.compare_spec; rewrite spec_ww_zdigits; rewrite spec_zdigits; intros H2. replace (2^[[p]]) with wwB. rewrite Zmod_small; auto with zarith. @@ -143,52 +143,52 @@ Section POS_MOD. rewrite <- Zmod_div_mod; auto with zarith. rewrite Zmod_small; auto with zarith. split; auto with zarith. - apply Zlt_le_trans with (Zpos w_digits); auto with zarith. + apply Z.lt_le_trans with (Zpos w_digits); auto with zarith. unfold base; apply Zpower2_le_lin; auto with zarith. exists wB; unfold base; rewrite <- Zpower_exp; auto with zarith. rewrite spec_ww_digits; - apply f_equal with (f := Zpower 2); rewrite Zpos_xO; auto with zarith. + apply f_equal with (f := Z.pow 2); rewrite Pos2Z.inj_xO; auto with zarith. simpl ww_to_Z; autorewrite with w_rewrite. rewrite spec_pos_mod; rewrite HH0. pattern [|xh|] at 2; rewrite Z_div_mod_eq with (b := 2 ^ ([[p]] - Zpos w_digits)); auto with zarith. - rewrite (fun x => (Zmult_comm (2 ^ x))); rewrite Zmult_plus_distr_l. - unfold base; rewrite <- Zmult_assoc; rewrite <- Zpower_exp; + rewrite (fun x => (Z.mul_comm (2 ^ x))); rewrite Z.mul_add_distr_r. + unfold base; rewrite <- Z.mul_assoc; rewrite <- Zpower_exp; auto with zarith. rewrite F0; auto with zarith. - rewrite <- Zplus_assoc; rewrite Zplus_mod; auto with zarith. + rewrite <- Z.add_assoc; rewrite Zplus_mod; auto with zarith. rewrite Z_mod_mult; auto with zarith. autorewrite with rm10. rewrite Zmod_mod; auto with zarith. - apply sym_equal; apply Zmod_small; auto with zarith. + symmetry; apply Zmod_small; auto with zarith. case (spec_to_Z xh); intros U1 U2. case (spec_to_Z xl); intros U3 U4. split; auto with zarith. - apply Zplus_le_0_compat; auto with zarith. - apply Zmult_le_0_compat; auto with zarith. + apply Z.add_nonneg_nonneg; auto with zarith. + apply Z.mul_nonneg_nonneg; auto with zarith. match goal with |- 0 <= ?X mod ?Y => case (Z_mod_lt X Y); auto with zarith end. match goal with |- ?X mod ?Y * ?U + ?Z < ?T => - apply Zle_lt_trans with ((Y - 1) * U + Z ); + apply Z.le_lt_trans with ((Y - 1) * U + Z ); [case (Z_mod_lt X Y); auto with zarith | idtac] end. match goal with |- ?X * ?U + ?Y < ?Z => - apply Zle_lt_trans with (X * U + (U - 1)) + apply Z.le_lt_trans with (X * U + (U - 1)) end. - apply Zplus_le_compat_l; auto with zarith. + apply Z.add_le_mono_l; auto with zarith. case (spec_to_Z xl); unfold base; auto with zarith. - rewrite Zmult_minus_distr_r; rewrite <- Zpower_exp; auto with zarith. + rewrite Z.mul_sub_distr_r; rewrite <- Zpower_exp; auto with zarith. rewrite F0; auto with zarith. rewrite Zmod_small; auto with zarith. case (spec_to_w_Z (WW xh xl)); intros U1 U2. split; auto with zarith. - apply Zlt_le_trans with (1:= U2). + apply Z.lt_le_trans with (1:= U2). unfold base; rewrite spec_ww_digits. apply Zpower_le_monotone; auto with zarith. split; auto with zarith. - rewrite Zpos_xO; auto with zarith. + rewrite Pos2Z.inj_xO; auto with zarith. Qed. End POS_MOD. @@ -260,7 +260,7 @@ Section DoubleDiv32. Variable spec_w_WW : forall h l, [[w_WW h l]] = [|h|] * wB + [|l|]. Variable spec_compare : - forall x y, w_compare x y = Zcompare [|x|] [|y|]. + forall x y, w_compare x y = Z.compare [|x|] [|y|]. Variable spec_w_add_c : forall x y, [+|w_add_c x y|] = [|x|] + [|y|]. Variable spec_w_add_carry_c : forall x y, [+|w_add_carry_c x y|] = [|x|] + [|y|] + 1. @@ -290,14 +290,14 @@ Section DoubleDiv32. assert (H:= spec_ww_to_Z w_digits w_to_Z spec_to_Z x). Theorem wB_div2: forall x, wB/2 <= x -> wB <= 2 * x. - intros x H; rewrite <- wB_div_2; apply Zmult_le_compat_l; auto with zarith. + intros x H; rewrite <- wB_div_2; apply Z.mul_le_mono_nonneg_l; auto with zarith. Qed. Lemma Zmult_lt_0_reg_r_2 : forall n m : Z, 0 <= n -> 0 < m * n -> 0 < m. Proof. - intros n m H1 H2;apply Zmult_lt_0_reg_r with n;trivial. - destruct (Zle_lt_or_eq _ _ H1);trivial. - subst;rewrite Zmult_0_r in H2;discriminate H2. + intros n m H1 H2;apply Z.mul_pos_cancel_r with n;trivial. + Z.le_elim H1; trivial. + subst;rewrite Z.mul_0_r in H2;discriminate H2. Qed. Theorem spec_w_div32 : forall a1 a2 a3 b1 b2, @@ -311,7 +311,7 @@ Section DoubleDiv32. intros a1 a2 a3 b1 b2 Hle Hlt. assert (U:= lt_0_wB w_digits); assert (U1:= lt_0_wwB w_digits). Spec_w_to_Z a1;Spec_w_to_Z a2;Spec_w_to_Z a3;Spec_w_to_Z b1;Spec_w_to_Z b2. - rewrite wwB_wBwB; rewrite Zpower_2; rewrite Zmult_assoc;rewrite <- Zmult_plus_distr_l. + rewrite wwB_wBwB; rewrite Z.pow_2_r; rewrite Z.mul_assoc;rewrite <- Z.mul_add_distr_r. change (w_div32 a1 a2 a3 b1 b2) with match w_compare a1 b1 with | Lt => @@ -332,7 +332,7 @@ Section DoubleDiv32. (WW (w_sub a2 b2) a3) (WW b1 b2) | Gt => (w_0, W0) (* cas absurde *) end. - rewrite spec_compare. case Zcompare_spec; intro Hcmp. + rewrite spec_compare. case Z.compare_spec; intro Hcmp. simpl in Hlt. rewrite Hcmp in Hlt;assert ([|a2|] < [|b2|]). omega. assert ([[WW (w_sub a2 b2) a3]] = ([|a2|]-[|b2|])*wB + [|a3|] + wwB). @@ -351,17 +351,17 @@ Section DoubleDiv32. rewrite H0;intros r. repeat (rewrite spec_ww_add;eauto || rewrite spec_w_Bm1 || rewrite spec_w_Bm2); - simpl ww_to_Z;try rewrite Zmult_1_l;intros H1. + simpl ww_to_Z;try rewrite Z.mul_1_l;intros H1. assert (0<= ([[r]] + ([|b1|] * wB + [|b2|])) - wwB < [|b1|] * wB + [|b2|]). Spec_ww_to_Z r;split;zarith. rewrite H1. assert (H12:= wB_div2 Hle). assert (wwB <= 2 * [|b1|] * wB). - rewrite wwB_wBwB; rewrite Zpower_2; zarith. + rewrite wwB_wBwB; rewrite Z.pow_2_r; zarith. assert (-wwB < ([|a2|] - [|b2|]) * wB + [|a3|] < 0). - split. apply Zlt_le_trans with (([|a2|] - [|b2|]) * wB);zarith. + split. apply Z.lt_le_trans with (([|a2|] - [|b2|]) * wB);zarith. rewrite wwB_wBwB;replace (-(wB^2)) with (-wB*wB);[zarith | ring]. - apply Zmult_lt_compat_r;zarith. - apply Zle_lt_trans with (([|a2|] - [|b2|]) * wB + (wB -1));zarith. + apply Z.mul_lt_mono_pos_r;zarith. + apply Z.le_lt_trans with (([|a2|] - [|b2|]) * wB + (wB -1));zarith. replace ( ([|a2|] - [|b2|]) * wB + (wB - 1)) with (([|a2|] - [|b2|] + 1) * wB + - 1);[zarith | ring]. assert (([|a2|] - [|b2|] + 1) * wB <= 0);zarith. @@ -376,13 +376,13 @@ Section DoubleDiv32. Spec_ww_to_Z (WW b1 b2). simpl in HH4;zarith. rewrite H0;intros r;repeat (rewrite spec_w_Bm1 || rewrite spec_w_Bm2); - simpl ww_to_Z;try rewrite Zmult_1_l;intros H1. + simpl ww_to_Z;try rewrite Z.mul_1_l;intros H1. assert ([[r]]=([|a2|]-[|b2|])*wB+[|a3|]+([|b1|]*wB+[|b2|])). zarith. split. rewrite H2;rewrite Hcmp;ring. split. Spec_ww_to_Z r;zarith. rewrite H2. assert (([|a2|] - [|b2|]) * wB + [|a3|] < 0);zarith. - apply Zle_lt_trans with (([|a2|] - [|b2|]) * wB + (wB -1));zarith. + apply Z.le_lt_trans with (([|a2|] - [|b2|]) * wB + (wB -1));zarith. replace ( ([|a2|] - [|b2|]) * wB + (wB - 1)) with (([|a2|] - [|b2|] + 1) * wB + - 1);[zarith|ring]. assert (([|a2|] - [|b2|] + 1) * wB <= 0);zarith. @@ -400,7 +400,7 @@ Section DoubleDiv32. rewrite H1. split. ring. split. rewrite <- H1;destruct (spec_ww_to_Z w_digits w_to_Z spec_to_Z r1);trivial. - apply Zle_lt_trans with ([|r|] * wB + [|a3|]). + apply Z.le_lt_trans with ([|r|] * wB + [|a3|]). assert ( 0 <= [|q|] * [|b2|]);zarith. apply beta_lex_inv;zarith. assert ([[r1]] = [|r|] * wB + [|a3|] - [|q|] * [|b2|] + wwB). @@ -418,10 +418,10 @@ Section DoubleDiv32. intros r2;repeat (rewrite spec_pred || rewrite spec_ww_add;eauto); simpl ww_to_Z;intros H7. assert (0 < [|q|] - 1). - assert (1 <= [|q|]). zarith. - destruct (Zle_lt_or_eq _ _ H6);zarith. - rewrite <- H8 in H2;rewrite H2 in H7. - assert (0 < [|b1|]*wB). apply Zmult_lt_0_compat;zarith. + assert (H6 : 1 <= [|q|]) by zarith. + Z.le_elim H6;zarith. + rewrite <- H6 in H2;rewrite H2 in H7. + assert (0 < [|b1|]*wB). apply Z.mul_pos_pos;zarith. Spec_ww_to_Z r2. zarith. rewrite (Zmod_small ([|q|] -1));zarith. rewrite (Zmod_small ([|q|] -1 -1));zarith. @@ -439,7 +439,7 @@ Section DoubleDiv32. < wwB). split;try omega. replace (2*([|b1|]*wB+[|b2|])) with ((2*[|b1|])*wB+2*[|b2|]). 2:ring. assert (H12:= wB_div2 Hle). assert (wwB <= 2 * [|b1|] * wB). - rewrite wwB_wBwB; rewrite Zpower_2; zarith. omega. + rewrite wwB_wBwB; rewrite Z.pow_2_r; zarith. omega. rewrite <- (Zmod_unique ([[r2]] + ([|b1|] * wB + [|b2|])) wwB @@ -534,13 +534,13 @@ Section DoubleDiv21. 0 <= [[r]] < [|b1|] * wB + [|b2|]. Variable spec_ww_1 : [[ww_1]] = 1. Variable spec_ww_compare : forall x y, - ww_compare x y = Zcompare [[x]] [[y]]. + ww_compare x y = Z.compare [[x]] [[y]]. Variable spec_ww_sub : forall x y, [[ww_sub x y]] = ([[x]] - [[y]]) mod wwB. Theorem wwB_div: wwB = 2 * (wwB / 2). Proof. - rewrite wwB_div_2; rewrite Zmult_assoc; rewrite wB_div_2; auto. - rewrite <- Zpower_2; apply wwB_wBwB. + rewrite wwB_div_2; rewrite Z.mul_assoc; rewrite wB_div_2; auto. + rewrite <- Z.pow_2_r; apply wwB_wBwB. Qed. Ltac Spec_w_to_Z x := @@ -562,7 +562,7 @@ Section DoubleDiv21. Spec_ww_to_Z b; assert (Eq: 0 < [[b]]). Spec_ww_to_Z a1;omega. generalize Hlt H ;clear Hlt H;case a1. intros H1 H2;simpl in H1;Spec_ww_to_Z a2. - rewrite spec_ww_compare. case Zcompare_spec; + rewrite spec_ww_compare. case Z.compare_spec; simpl;try rewrite spec_ww_1;autorewrite with rm10; intros;zarith. rewrite spec_ww_sub;simpl. rewrite Zmod_small;zarith. split. ring. @@ -570,32 +570,32 @@ Section DoubleDiv21. rewrite wwB_div;zarith. intros a1h a1l. Spec_w_to_Z a1h;Spec_w_to_Z a1l. Spec_ww_to_Z a2. destruct a2 as [ |a3 a4]; - (destruct b as [ |b1 b2];[unfold Zle in Eq;discriminate Eq|idtac]); + (destruct b as [ |b1 b2];[unfold Z.le in Eq;discriminate Eq|idtac]); try (Spec_w_to_Z a3; Spec_w_to_Z a4); Spec_w_to_Z b1; Spec_w_to_Z b2; intros Hlt H; match goal with |-context [w_div32 ?X ?Y ?Z ?T ?U] => generalize (@spec_w_div32 X Y Z T U); case (w_div32 X Y Z T U); intros q1 r H0 end; (assert (Eq1: wB / 2 <= [|b1|]);[ apply (@beta_lex (wB / 2) 0 [|b1|] [|b2|] wB); auto with zarith; - autorewrite with rm10;repeat rewrite (Zmult_comm wB); + autorewrite with rm10;repeat rewrite (Z.mul_comm wB); rewrite <- wwB_div_2; trivial | generalize (H0 Eq1 Hlt);clear H0;destruct r as [ |r1 r2];simpl; - try rewrite spec_w_0; try rewrite spec_w_0W;repeat rewrite Zplus_0_r; + try rewrite spec_w_0; try rewrite spec_w_0W;repeat rewrite Z.add_0_r; intros (H1,H2) ]). - split;[rewrite wwB_wBwB; rewrite Zpower_2 | trivial]. - rewrite Zmult_assoc;rewrite Zmult_plus_distr_l;rewrite <- Zmult_assoc; - rewrite <- Zpower_2; rewrite <- wwB_wBwB;rewrite H1;ring. + split;[rewrite wwB_wBwB; rewrite Z.pow_2_r | trivial]. + rewrite Z.mul_assoc;rewrite Z.mul_add_distr_r;rewrite <- Z.mul_assoc; + rewrite <- Z.pow_2_r; rewrite <- wwB_wBwB;rewrite H1;ring. destruct H2 as (H2,H3);match goal with |-context [w_div32 ?X ?Y ?Z ?T ?U] => generalize (@spec_w_div32 X Y Z T U); case (w_div32 X Y Z T U); intros q r H0;generalize (H0 Eq1 H3);clear H0;intros (H4,H5) end. split;[rewrite wwB_wBwB | trivial]. - rewrite Zpower_2. - rewrite Zmult_assoc;rewrite Zmult_plus_distr_l;rewrite <- Zmult_assoc; - rewrite <- Zpower_2. + rewrite Z.pow_2_r. + rewrite Z.mul_assoc;rewrite Z.mul_add_distr_r;rewrite <- Z.mul_assoc; + rewrite <- Z.pow_2_r. rewrite <- wwB_wBwB;rewrite H1. - rewrite spec_w_0 in H4;rewrite Zplus_0_r in H4. - repeat rewrite Zmult_plus_distr_l. rewrite <- (Zmult_assoc [|r1|]). - rewrite <- Zpower_2; rewrite <- wwB_wBwB;rewrite H4;simpl;ring. + rewrite spec_w_0 in H4;rewrite Z.add_0_r in H4. + repeat rewrite Z.mul_add_distr_r. rewrite <- (Z.mul_assoc [|r1|]). + rewrite <- Z.pow_2_r; rewrite <- wwB_wBwB;rewrite H4;simpl;ring. split;[rewrite wwB_wBwB | split;zarith]. replace (([|a1h|] * wB + [|a1l|]) * wB^2 + ([|a3|] * wB + [|a4|])) with (([|a1h|] * wwB + [|a1l|] * wB + [|a3|])*wB+ [|a4|]). @@ -793,7 +793,7 @@ Section DoubleDivGt. Variable spec_w_WW : forall h l, [[w_WW h l]] = [|h|] * wB + [|l|]. Variable spec_w_0W : forall l, [[w_0W l]] = [|l|]. Variable spec_compare : - forall x y, w_compare x y = Zcompare [|x|] [|y|]. + forall x y, w_compare x y = Z.compare [|x|] [|y|]. Variable spec_eq0 : forall x, w_eq0 x = true -> [|x|] = 0. Variable spec_opp_c : forall x, [-|w_opp_c x|] = -[|x|]. @@ -893,42 +893,42 @@ Section DoubleDivGt. end in [[WW ah al]]=[[q]]*[[WW bh bl]]+[[r]] /\ 0 <=[[r]]< [[WW bh bl]]). assert (Hh := spec_head0 Hpos). lazy zeta. - rewrite spec_compare; case Zcompare_spec; + rewrite spec_compare; case Z.compare_spec; rewrite spec_w_0; intros HH. - generalize Hh; rewrite HH; simpl Zpower; - rewrite Zmult_1_l; intros (HH1, HH2); clear HH. + generalize Hh; rewrite HH; simpl Z.pow; + rewrite Z.mul_1_l; intros (HH1, HH2); clear HH. assert (wwB <= 2*[[WW bh bl]]). - apply Zle_trans with (2*[|bh|]*wB). - rewrite wwB_wBwB; rewrite Zpower_2; apply Zmult_le_compat_r; zarith. - rewrite <- wB_div_2; apply Zmult_le_compat_l; zarith. - simpl ww_to_Z;rewrite Zmult_plus_distr_r;rewrite Zmult_assoc. + apply Z.le_trans with (2*[|bh|]*wB). + rewrite wwB_wBwB; rewrite Z.pow_2_r; apply Z.mul_le_mono_nonneg_r; zarith. + rewrite <- wB_div_2; apply Z.mul_le_mono_nonneg_l; zarith. + simpl ww_to_Z;rewrite Z.mul_add_distr_l;rewrite Z.mul_assoc. Spec_w_to_Z bl;zarith. Spec_ww_to_Z (WW ah al). rewrite spec_ww_sub;eauto. - simpl;rewrite spec_ww_1;rewrite Zmult_1_l;simpl. + simpl;rewrite spec_ww_1;rewrite Z.mul_1_l;simpl. simpl ww_to_Z in Hgt, H, HH;rewrite Zmod_small;split;zarith. case (spec_to_Z (w_head0 bh)); auto with zarith. assert ([|w_head0 bh|] < Zpos w_digits). destruct (Z_lt_ge_dec [|w_head0 bh|] (Zpos w_digits));trivial. exfalso. assert (2 ^ [|w_head0 bh|] * [|bh|] >= wB);auto with zarith. - apply Zle_ge; replace wB with (wB * 1);try ring. - Spec_w_to_Z bh;apply Zmult_le_compat;zarith. + apply Z.le_ge; replace wB with (wB * 1);try ring. + Spec_w_to_Z bh;apply Z.mul_le_mono_nonneg;zarith. unfold base;apply Zpower_le_monotone;zarith. assert (HHHH : 0 < [|w_head0 bh|] < Zpos w_digits); auto with zarith. - assert (Hb:= Zlt_le_weak _ _ H). + assert (Hb:= Z.lt_le_incl _ _ H). generalize (spec_add_mul_div w_0 ah Hb) (spec_add_mul_div ah al Hb) (spec_add_mul_div al w_0 Hb) (spec_add_mul_div bh bl Hb) (spec_add_mul_div bl w_0 Hb); - rewrite spec_w_0; repeat rewrite Zmult_0_l;repeat rewrite Zplus_0_l; - rewrite Zdiv_0_l;repeat rewrite Zplus_0_r. + rewrite spec_w_0; repeat rewrite Z.mul_0_l;repeat rewrite Z.add_0_l; + rewrite Zdiv_0_l;repeat rewrite Z.add_0_r. Spec_w_to_Z ah;Spec_w_to_Z bh. unfold base;repeat rewrite Zmod_shift_r;zarith. assert (H3:=to_Z_div_minus_p ah HHHH);assert(H4:=to_Z_div_minus_p al HHHH); assert (H5:=to_Z_div_minus_p bl HHHH). - rewrite Zmult_comm in Hh. + rewrite Z.mul_comm in Hh. assert (2^[|w_head0 bh|] < wB). unfold base;apply Zpower_lt_monotone;zarith. unfold base in H0;rewrite Zmod_small;zarith. fold wB; rewrite (Zmod_small ([|bh|] * 2 ^ [|w_head0 bh|]));zarith. @@ -943,15 +943,15 @@ Section DoubleDivGt. (w_add_mul_div (w_head0 bh) al w_0) (w_add_mul_div (w_head0 bh) bh bl) (w_add_mul_div (w_head0 bh) bl w_0)) as (q,r). - rewrite V1;rewrite V2. rewrite Zmult_plus_distr_l. - rewrite <- (Zplus_assoc ([|bh|] * 2 ^ [|w_head0 bh|] * wB)). + rewrite V1;rewrite V2. rewrite Z.mul_add_distr_r. + rewrite <- (Z.add_assoc ([|bh|] * 2 ^ [|w_head0 bh|] * wB)). unfold base;rewrite <- shift_unshift_mod;zarith. fold wB. replace ([|bh|] * 2 ^ [|w_head0 bh|] * wB + [|bl|] * 2 ^ [|w_head0 bh|]) with ([[WW bh bl]] * 2^[|w_head0 bh|]). 2:simpl;ring. - fold wwB. rewrite wwB_wBwB. rewrite Zpower_2. rewrite U1;rewrite U2;rewrite U3. - rewrite Zmult_assoc. rewrite Zmult_plus_distr_l. - rewrite (Zplus_assoc ([|ah|] / 2^(Zpos(w_digits) - [|w_head0 bh|])*wB * wB)). - rewrite <- Zmult_plus_distr_l. rewrite <- Zplus_assoc. + fold wwB. rewrite wwB_wBwB. rewrite Z.pow_2_r. rewrite U1;rewrite U2;rewrite U3. + rewrite Z.mul_assoc. rewrite Z.mul_add_distr_r. + rewrite (Z.add_assoc ([|ah|] / 2^(Zpos(w_digits) - [|w_head0 bh|])*wB * wB)). + rewrite <- Z.mul_add_distr_r. rewrite <- Z.add_assoc. unfold base;repeat rewrite <- shift_unshift_mod;zarith. fold wB. replace ([|ah|] * 2 ^ [|w_head0 bh|] * wB + [|al|] * 2 ^ [|w_head0 bh|]) with ([[WW ah al]] * 2^[|w_head0 bh|]). 2:simpl;ring. @@ -962,42 +962,42 @@ Section DoubleDivGt. unfold base. replace (2^Zpos (w_digits)) with (2^(Zpos (w_digits) - 1)*2). rewrite Z_div_mult;zarith. rewrite <- Zpower_exp;zarith. - apply Zlt_le_trans with wB;zarith. + apply Z.lt_le_trans with wB;zarith. unfold base;apply Zpower_le_monotone;zarith. pattern 2 at 2;replace 2 with (2^1);trivial. rewrite <- Zpower_exp;zarith. ring_simplify (Zpos (w_digits) - 1 + 1);trivial. change [[WW w_0 q]] with ([|w_0|]*wB+[|q|]);rewrite spec_w_0;rewrite - Zmult_0_l;rewrite Zplus_0_l. + Z.mul_0_l;rewrite Z.add_0_l. replace [[ww_add_mul_div (ww_sub w_0 w_WW w_opp_c w_opp_carry w_sub_c w_opp w_sub w_sub_carry _ww_zdigits (w_0W (w_head0 bh))) W0 r]] with ([[r]]/2^[|w_head0 bh|]). - assert (0 < 2^[|w_head0 bh|]). apply Zpower_gt_0;zarith. + assert (0 < 2^[|w_head0 bh|]). apply Z.pow_pos_nonneg;zarith. split. rewrite <- (Z_div_mult [[WW ah al]] (2^[|w_head0 bh|]));zarith. - rewrite H1;rewrite Zmult_assoc;apply Z_div_plus_l;trivial. + rewrite H1;rewrite Z.mul_assoc;apply Z_div_plus_l;trivial. split;[apply Zdiv_le_lower_bound| apply Zdiv_lt_upper_bound];zarith. rewrite spec_ww_add_mul_div. rewrite spec_ww_sub; auto with zarith. rewrite spec_ww_digits_. change (Zpos (xO (w_digits))) with (2*Zpos (w_digits));zarith. - simpl ww_to_Z;rewrite Zmult_0_l;rewrite Zplus_0_l. + simpl ww_to_Z;rewrite Z.mul_0_l;rewrite Z.add_0_l. rewrite spec_w_0W. rewrite (fun x y => Zmod_small (x-y)); auto with zarith. ring_simplify (2 * Zpos w_digits - (2 * Zpos w_digits - [|w_head0 bh|])). rewrite Zmod_small;zarith. split;[apply Zdiv_le_lower_bound| apply Zdiv_lt_upper_bound];zarith. Spec_ww_to_Z r. - apply Zlt_le_trans with wwB;zarith. - rewrite <- (Zmult_1_r wwB);apply Zmult_le_compat;zarith. + apply Z.lt_le_trans with wwB;zarith. + rewrite <- (Z.mul_1_r wwB);apply Z.mul_le_mono_nonneg;zarith. split; auto with zarith. - apply Zle_lt_trans with (2 * Zpos w_digits); auto with zarith. - unfold base, ww_digits; rewrite (Zpos_xO w_digits). + apply Z.le_lt_trans with (2 * Zpos w_digits); auto with zarith. + unfold base, ww_digits; rewrite (Pos2Z.inj_xO w_digits). apply Zpower2_lt_lin; auto with zarith. rewrite spec_ww_sub; auto with zarith. rewrite spec_ww_digits_; rewrite spec_w_0W. rewrite Zmod_small;zarith. - rewrite Zpos_xO; split; auto with zarith. - apply Zle_lt_trans with (2 * Zpos w_digits); auto with zarith. - unfold base, ww_digits; rewrite (Zpos_xO w_digits). + rewrite Pos2Z.inj_xO; split; auto with zarith. + apply Z.le_lt_trans with (2 * Zpos w_digits); auto with zarith. + unfold base, ww_digits; rewrite (Pos2Z.inj_xO w_digits). apply Zpower2_lt_lin; auto with zarith. Qed. @@ -1037,9 +1037,9 @@ Section DoubleDivGt. assert (H2:=spec_div_gt Hgt Hpos);destruct (w_div_gt al bl). repeat rewrite spec_w_0W;simpl;rewrite spec_w_0;simpl;trivial. clear H. - rewrite spec_compare; case Zcompare_spec; intros Hcmp. + rewrite spec_compare; case Z.compare_spec; intros Hcmp. rewrite spec_w_0 in Hcmp. change [[WW bh bl]] with ([|bh|]*wB+[|bl|]). - rewrite <- Hcmp;rewrite Zmult_0_l;rewrite Zplus_0_l. + rewrite <- Hcmp;rewrite Z.mul_0_l;rewrite Z.add_0_l. simpl in Hpos;rewrite <- Hcmp in Hpos;simpl in Hpos. assert (H2:= @spec_double_divn1 w w_digits w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 w_compare w_sub w_to_Z spec_to_Z spec_w_zdigits spec_w_0 spec_w_WW spec_head0 @@ -1079,7 +1079,7 @@ Section DoubleDivGt. rewrite spec_mod_gt;trivial. assert (H:=spec_div_gt Hgt Hpos). destruct (w_div_gt a b) as (q,r);simpl. - rewrite Zmult_comm in H;destruct H. + rewrite Z.mul_comm in H;destruct H. symmetry;apply Zmod_unique with [|q|];trivial. Qed. @@ -1132,7 +1132,7 @@ Section DoubleDivGt. rewrite spec_w_0W;rewrite spec_w_mod_gt_eq;trivial. destruct (w_div_gt al bl);simpl;rewrite spec_w_0W;trivial. clear H. - rewrite spec_compare; case Zcompare_spec; intros H2. + rewrite spec_compare; case Z.compare_spec; intros H2. rewrite (@spec_double_modn1_aux w w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 w_compare w_sub w_to_Z spec_w_0 spec_compare 1 (WW ah al) bl). destruct (double_divn1 w_zdigits w_0 w_WW w_head0 w_add_mul_div w_div21 w_compare w_sub 1 @@ -1149,7 +1149,7 @@ Section DoubleDivGt. rewrite (spec_ww_mod_gt_eq a b Hgt Hpos). destruct (ww_div_gt a b)as(q,r);destruct H. apply Zmod_unique with[[q]];simpl;trivial. - rewrite Zmult_comm;trivial. + rewrite Z.mul_comm;trivial. Qed. Lemma Zis_gcd_mod : forall a b d, @@ -1206,13 +1206,13 @@ Section DoubleDivGt. | Gt => W0 (* absurde *) end). rewrite spec_compare, spec_w_0. - case Zcompare_spec; intros Hbh. + case Z.compare_spec; intros Hbh. simpl ww_to_Z in *. rewrite <- Hbh. - rewrite Zmult_0_l;rewrite Zplus_0_l. + rewrite Z.mul_0_l;rewrite Z.add_0_l. rewrite spec_compare, spec_w_0. - case Zcompare_spec; intros Hbl. + case Z.compare_spec; intros Hbl. rewrite <- Hbl;apply Zis_gcd_0. - simpl;rewrite spec_w_0;rewrite Zmult_0_l;rewrite Zplus_0_l. + simpl;rewrite spec_w_0;rewrite Z.mul_0_l;rewrite Z.add_0_l. apply Zis_gcd_mod;zarith. change ([|ah|] * wB + [|al|]) with (double_to_Z w_digits w_to_Z 1 (WW ah al)). rewrite <- (@spec_double_modn1 w w_digits w_zdigits w_0 w_WW w_head0 w_add_mul_div @@ -1220,19 +1220,19 @@ Section DoubleDivGt. spec_div21 spec_compare spec_sub 1 (WW ah al) bl Hbl). apply spec_gcd_gt. rewrite (@spec_double_modn1 w w_digits w_zdigits w_0 w_WW); trivial. - apply Zlt_gt;match goal with | |- ?x mod ?y < ?y => + apply Z.lt_gt;match goal with | |- ?x mod ?y < ?y => destruct (Z_mod_lt x y);zarith end. Spec_w_to_Z bl;exfalso;omega. assert (H:= spec_ww_mod_gt_aux _ _ _ Hgt Hbh). assert (H2 : 0 < [[WW bh bl]]). - simpl;Spec_w_to_Z bl. apply Zlt_le_trans with ([|bh|]*wB);zarith. - apply Zmult_lt_0_compat;zarith. + simpl;Spec_w_to_Z bl. apply Z.lt_le_trans with ([|bh|]*wB);zarith. + apply Z.mul_pos_pos;zarith. apply Zis_gcd_mod;trivial. rewrite <- H. simpl in *;destruct (ww_mod_gt_aux ah al bh bl) as [ |mh ml]. simpl;apply Zis_gcd_0;zarith. - rewrite spec_compare, spec_w_0; case Zcompare_spec; intros Hmh. + rewrite spec_compare, spec_w_0; case Z.compare_spec; intros Hmh. simpl;rewrite <- Hmh;simpl. - rewrite spec_compare, spec_w_0; case Zcompare_spec; intros Hml. + rewrite spec_compare, spec_w_0; case Z.compare_spec; intros Hml. rewrite <- Hml;simpl;apply Zis_gcd_0. simpl; rewrite spec_w_0; simpl. apply Zis_gcd_mod;zarith. @@ -1242,38 +1242,38 @@ Section DoubleDivGt. spec_div21 spec_compare spec_sub 1 (WW bh bl) ml Hml). apply spec_gcd_gt. rewrite (@spec_double_modn1 w w_digits w_zdigits w_0 w_WW); trivial. - apply Zlt_gt;match goal with | |- ?x mod ?y < ?y => + apply Z.lt_gt;match goal with | |- ?x mod ?y < ?y => destruct (Z_mod_lt x y);zarith end. Spec_w_to_Z ml;exfalso;omega. assert ([[WW bh bl]] > [[WW mh ml]]). - rewrite H;simpl; apply Zlt_gt;match goal with | |- ?x mod ?y < ?y => + rewrite H;simpl; apply Z.lt_gt;match goal with | |- ?x mod ?y < ?y => destruct (Z_mod_lt x y);zarith end. assert (H1:= spec_ww_mod_gt_aux _ _ _ H0 Hmh). assert (H3 : 0 < [[WW mh ml]]). - simpl;Spec_w_to_Z ml. apply Zlt_le_trans with ([|mh|]*wB);zarith. - apply Zmult_lt_0_compat;zarith. + simpl;Spec_w_to_Z ml. apply Z.lt_le_trans with ([|mh|]*wB);zarith. + apply Z.mul_pos_pos;zarith. apply Zis_gcd_mod;zarith. simpl in *;rewrite <- H1. destruct (ww_mod_gt_aux bh bl mh ml) as [ |rh rl]. simpl; apply Zis_gcd_0. simpl;apply Hcont. simpl in H1;rewrite H1. - apply Zlt_gt;match goal with | |- ?x mod ?y < ?y => + apply Z.lt_gt;match goal with | |- ?x mod ?y < ?y => destruct (Z_mod_lt x y);zarith end. - apply Zle_trans with (2^n/2). + apply Z.le_trans with (2^n/2). apply Zdiv_le_lower_bound;zarith. - apply Zle_trans with ([|bh|] * wB + [|bl|]);zarith. - assert (H3' := Z_div_mod_eq [[WW bh bl]] [[WW mh ml]] (Zlt_gt _ _ H3)). - assert (H4' : 0 <= [[WW bh bl]]/[[WW mh ml]]). - apply Zge_le;apply Z_div_ge0;zarith. simpl in *;rewrite H1. + apply Z.le_trans with ([|bh|] * wB + [|bl|]);zarith. + assert (H3' := Z_div_mod_eq [[WW bh bl]] [[WW mh ml]] (Z.lt_gt _ _ H3)). + assert (H4 : 0 <= [[WW bh bl]]/[[WW mh ml]]). + apply Z.ge_le;apply Z_div_ge0;zarith. simpl in *;rewrite H1. pattern ([|bh|] * wB + [|bl|]) at 2;rewrite H3'. - destruct (Zle_lt_or_eq _ _ H4'). + Z.le_elim H4. assert (H6' : [[WW bh bl]] mod [[WW mh ml]] = [[WW bh bl]] - [[WW mh ml]] * ([[WW bh bl]]/[[WW mh ml]])). simpl;pattern ([|bh|] * wB + [|bl|]) at 2;rewrite H3';ring. simpl in H6'. assert ([[WW mh ml]] <= [[WW mh ml]] * ([[WW bh bl]]/[[WW mh ml]])). - simpl;pattern ([|mh|]*wB+[|ml|]) at 1;rewrite <- Zmult_1_r;zarith. + simpl;pattern ([|mh|]*wB+[|ml|]) at 1;rewrite <- Z.mul_1_r;zarith. simpl in *;assert (H8 := Z_mod_lt [[WW bh bl]] [[WW mh ml]]);simpl in H8; zarith. assert (H8 := Z_mod_lt [[WW bh bl]] [[WW mh ml]]);simpl in *;zarith. - rewrite <- H4 in H3';rewrite Zmult_0_r in H3';simpl in H3';zarith. + rewrite <- H4 in H3';rewrite Z.mul_0_r in H3';simpl in H3';zarith. pattern n at 1;replace n with (n-1+1);try ring. rewrite Zpower_exp;zarith. change (2^1) with 2. rewrite Z_div_mult;zarith. @@ -1295,27 +1295,27 @@ Section DoubleDivGt. [[ww_gcd_gt_aux p cont ah al bh bl]]. Proof. induction p;intros cont n Hcont ah al bh bl Hgt Hs;simpl ww_gcd_gt_aux. - assert (0 < Zpos p). unfold Zlt;reflexivity. + assert (0 < Zpos p). unfold Z.lt;reflexivity. apply spec_ww_gcd_gt_aux_body with (n := Zpos (xI p) + n); - trivial;rewrite Zpos_xI. + trivial;rewrite Pos2Z.inj_xI. intros. apply IHp with (n := Zpos p + n);zarith. intros. apply IHp with (n := n );zarith. - apply Zle_trans with (2 ^ (2* Zpos p + 1+ n -1));zarith. - apply Zpower_le_monotone2;zarith. - assert (0 < Zpos p). unfold Zlt;reflexivity. + apply Z.le_trans with (2 ^ (2* Zpos p + 1+ n -1));zarith. + apply Z.pow_le_mono_r;zarith. + assert (0 < Zpos p). unfold Z.lt;reflexivity. apply spec_ww_gcd_gt_aux_body with (n := Zpos (xO p) + n );trivial. - rewrite (Zpos_xO p). + rewrite (Pos2Z.inj_xO p). intros. apply IHp with (n := Zpos p + n - 1);zarith. intros. apply IHp with (n := n -1 );zarith. intros;apply Hcont;zarith. - apply Zle_trans with (2^(n-1));zarith. - apply Zpower_le_monotone2;zarith. - apply Zle_trans with (2 ^ (Zpos p + n -1));zarith. - apply Zpower_le_monotone2;zarith. - apply Zle_trans with (2 ^ (2*Zpos p + n -1));zarith. - apply Zpower_le_monotone2;zarith. + apply Z.le_trans with (2^(n-1));zarith. + apply Z.pow_le_mono_r;zarith. + apply Z.le_trans with (2 ^ (Zpos p + n -1));zarith. + apply Z.pow_le_mono_r;zarith. + apply Z.le_trans with (2 ^ (2*Zpos p + n -1));zarith. + apply Z.pow_le_mono_r;zarith. apply spec_ww_gcd_gt_aux_body with (n := n+1);trivial. - rewrite Zplus_comm;trivial. + rewrite Z.add_comm;trivial. ring_simplify (n + 1 - 1);trivial. Qed. @@ -1353,7 +1353,7 @@ Section DoubleDiv. Variable spec_to_Z : forall x, 0 <= [|x|] < wB. Variable spec_ww_1 : [[ww_1]] = 1. Variable spec_ww_compare : forall x y, - ww_compare x y = Zcompare [[x]] [[y]]. + ww_compare x y = Z.compare [[x]] [[y]]. Variable spec_ww_div_gt : forall a b, [[a]] > [[b]] -> 0 < [[b]] -> let (q,r) := ww_div_gt a b in [[a]] = [[q]] * [[b]] + [[r]] /\ @@ -1375,7 +1375,7 @@ Section DoubleDiv. 0 <= [[r]] < [[b]]. Proof. intros a b Hpos;unfold ww_div. - rewrite spec_ww_compare; case Zcompare_spec; intros. + rewrite spec_ww_compare; case Z.compare_spec; intros. simpl;rewrite spec_ww_1;split;zarith. simpl;split;[ring|Spec_ww_to_Z a;zarith]. apply spec_ww_div_gt;auto with zarith. @@ -1385,7 +1385,7 @@ Section DoubleDiv. [[ww_mod a b]] = [[a]] mod [[b]]. Proof. intros a b Hpos;unfold ww_mod. - rewrite spec_ww_compare; case Zcompare_spec; intros. + rewrite spec_ww_compare; case Z.compare_spec; intros. simpl;apply Zmod_unique with 1;try rewrite H;zarith. Spec_ww_to_Z a;symmetry;apply Zmod_small;zarith. apply spec_ww_mod_gt;auto with zarith. @@ -1406,7 +1406,7 @@ Section DoubleDiv. Variable spec_w_0 : [|w_0|] = 0. Variable spec_w_1 : [|w_1|] = 1. Variable spec_compare : - forall x y, w_compare x y = Zcompare [|x|] [|y|]. + forall x y, w_compare x y = Z.compare [|x|] [|y|]. Variable spec_eq0 : forall x, w_eq0 x = true -> [|x|] = 0. Variable spec_gcd_gt : forall a b, [|a|] > [|b|] -> Zis_gcd [|a|] [|b|] [|w_gcd_gt a b|]. @@ -1439,7 +1439,7 @@ Section DoubleDiv. assert (H1:= beta_lex _ _ _ _ _ Hle (spec_to_Z yl) H). Spec_w_to_Z yh;zarith. unfold gcd_cont; rewrite spec_compare, spec_w_1. - case Zcompare_spec; intros Hcmpy. + case Z.compare_spec; intros Hcmpy. simpl;rewrite H;simpl; rewrite spec_ww_1;rewrite <- Hcmpy;apply Zis_gcd_mod;zarith. rewrite <- (Zmod_unique ([|xh|]*wB+[|xl|]) 1 ([|xh|]*wB+[|xl|]) 0);zarith. @@ -1485,7 +1485,7 @@ Section DoubleDiv. Spec_w_to_Z bh;assert ([|bh|] = 0);zarith. rewrite H1 in Hgt;simpl in Hgt. rewrite H1;simpl;auto. clear H. apply spec_gcd_gt_fix with (n:= 0);trivial. - rewrite Zplus_0_r;rewrite spec_ww_digits_. + rewrite Z.add_0_r;rewrite spec_ww_digits_. change (2 ^ Zpos (xO w_digits)) with wwB. Spec_ww_to_Z (WW bh bl);zarith. Qed. @@ -1498,7 +1498,7 @@ Section DoubleDiv. | Eq => a | Lt => ww_gcd_gt b a end). - rewrite spec_ww_compare; case Zcompare_spec; intros Hcmp. + rewrite spec_ww_compare; case Z.compare_spec; intros Hcmp. Spec_ww_to_Z b;rewrite Hcmp. apply Zis_gcd_for_euclid with 1;zarith. ring_simplify ([[b]] - 1 * [[b]]). apply Zis_gcd_0;zarith. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v index 062282f2..5cb7405a 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -62,7 +62,7 @@ Section GENDIVN1. [|a1|] *wB+ [|a2|] = [|q|] * [|b|] + [|r|] /\ 0 <= [|r|] < [|b|]. Variable spec_compare : - forall x y, w_compare x y = Zcompare [|x|] [|y|]. + forall x y, w_compare x y = Z.compare [|x|] [|y|]. Variable spec_sub: forall x y, [|w_sub x y|] = ([|x|] - [|y|]) mod wB. @@ -107,8 +107,8 @@ Section GENDIVN1. destruct H4;split;trivial. rewrite spec_double_WW;trivial. rewrite <- double_wB_wwB. - rewrite Zmult_assoc;rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. - rewrite H0;rewrite Zmult_plus_distr_l;rewrite <- Zplus_assoc. + rewrite Z.mul_assoc;rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r. + rewrite H0;rewrite Z.mul_add_distr_r;rewrite <- Z.add_assoc. rewrite H4;ring. Qed. @@ -160,7 +160,7 @@ Section GENDIVN1. Lemma p_lt_double_digits : forall n, [|p|] <= Zpos (w_digits << n). Proof. induction n;simpl. trivial. - case (spec_to_Z p); rewrite Pshiftl_nat_S, Zpos_xO;auto with zarith. + case (spec_to_Z p); rewrite Pshiftl_nat_S, Pos2Z.inj_xO;auto with zarith. Qed. Lemma spec_double_divn1_p : forall n r h l, @@ -225,11 +225,11 @@ Section GENDIVN1. replace (2 ^ (Zpos (w_digits << (S n)) - [|p|])) with (2^(Zpos (w_digits << n) - [|p|])*2^Zpos (w_digits << n)). rewrite Zdiv_mult_cancel_r;auto with zarith. - rewrite Zmult_plus_distr_l with (p:= 2^[|p|]). + rewrite Z.mul_add_distr_r with (p:= 2^[|p|]). pattern ([!n|hl!] * 2^[|p|]) at 2; rewrite (shift_unshift_mod (Zpos(w_digits << n))([|p|])([!n|hl!])); auto with zarith. - rewrite Zplus_assoc. + rewrite Z.add_assoc. replace ([!n|hh!] * 2^Zpos (w_digits << n)* 2^[|p|] + ([!n|hl!] / 2^(Zpos (w_digits << n)-[|p|])* @@ -238,7 +238,7 @@ Section GENDIVN1. (([!n|hh!] *2^[|p|] + double_to_Z w_digits w_to_Z n hl / 2^(Zpos (w_digits << n)-[|p|])) * 2^Zpos(w_digits << n));try (ring;fail). - rewrite <- Zplus_assoc. + rewrite <- Z.add_assoc. rewrite <- (Zmod_shift_r ([|p|]));auto with zarith. replace (2 ^ Zpos (w_digits << n) * 2 ^ Zpos (w_digits << n)) with @@ -246,12 +246,12 @@ Section GENDIVN1. rewrite (Zmod_shift_r (Zpos (w_digits << n)));auto with zarith. replace (2 ^ (Zpos (w_digits << n) + Zpos (w_digits << n))) with (2^Zpos(w_digits << n) *2^Zpos(w_digits << n)). - rewrite (Zmult_comm (([!n|hh!] * 2 ^ [|p|] + + rewrite (Z.mul_comm (([!n|hh!] * 2 ^ [|p|] + [!n|hl!] / 2 ^ (Zpos (w_digits << n) - [|p|])))). rewrite Zmult_mod_distr_l;auto with zarith. ring. rewrite Zpower_exp;auto with zarith. - assert (0 < Zpos (w_digits << n)). unfold Zlt;reflexivity. + assert (0 < Zpos (w_digits << n)). unfold Z.lt;reflexivity. auto with zarith. apply Z_mod_lt;auto with zarith. rewrite Zpower_exp;auto with zarith. @@ -320,7 +320,7 @@ Section GENDIVN1. replace (Zpos w_digits - Zpos w_digits) with 0;try ring. simpl. rewrite <- (Zdiv_unique [|x|] 1 [|x|] 0);auto with zarith. assert (U2 := spec_double_digits n). - assert (U3 : 0 < Zpos w_digits). exact (refl_equal Lt). + assert (U3 : 0 < Zpos w_digits). exact (eq_refl Lt). destruct x;unfold high;fold high. unfold double_to_Z,zn2z_to_Z;rewrite spec_0. rewrite Zdiv_0_l;trivial. @@ -365,30 +365,30 @@ Section GENDIVN1. intros n a b H. unfold double_divn1. case (spec_head0 H); intros H0 H1. case (spec_to_Z (w_head0 b)); intros HH1 HH2. - rewrite spec_compare; case Zcompare_spec; + rewrite spec_compare; case Z.compare_spec; rewrite spec_0; intros H2; auto with zarith. assert (Hv1: wB/2 <= [|b|]). - generalize H0; rewrite H2; rewrite Zpower_0_r; - rewrite Zmult_1_l; auto. + generalize H0; rewrite H2; rewrite Z.pow_0_r; + rewrite Z.mul_1_l; auto. assert (Hv2: [|w_0|] < [|b|]). rewrite spec_0; auto. generalize (spec_double_divn1_0 Hv1 n a Hv2). - rewrite spec_0;rewrite Zmult_0_l; rewrite Zplus_0_l; auto. + rewrite spec_0;rewrite Z.mul_0_l; rewrite Z.add_0_l; auto. contradict H2; auto with zarith. assert (HHHH : 0 < [|w_head0 b|]); auto with zarith. assert ([|w_head0 b|] < Zpos w_digits). - case (Zle_or_lt (Zpos w_digits) [|w_head0 b|]); auto; intros HH. + case (Z.le_gt_cases (Zpos w_digits) [|w_head0 b|]); auto; intros HH. assert (2 ^ [|w_head0 b|] < wB). - apply Zle_lt_trans with (2 ^ [|w_head0 b|] * [|b|]);auto with zarith. + apply Z.le_lt_trans with (2 ^ [|w_head0 b|] * [|b|]);auto with zarith. replace (2 ^ [|w_head0 b|]) with (2^[|w_head0 b|] * 1);try (ring;fail). - apply Zmult_le_compat;auto with zarith. + apply Z.mul_le_mono_nonneg;auto with zarith. assert (wB <= 2^[|w_head0 b|]). unfold base;apply Zpower_le_monotone;auto with zarith. omega. assert ([|w_add_mul_div (w_head0 b) b w_0|] = 2 ^ [|w_head0 b|] * [|b|]). rewrite (spec_add_mul_div b w_0); auto with zarith. rewrite spec_0;rewrite Zdiv_0_l; try omega. - rewrite Zplus_0_r; rewrite Zmult_comm. + rewrite Z.add_0_r; rewrite Z.mul_comm. rewrite Zmod_small; auto with zarith. assert (H5 := spec_to_Z (high n a)). assert @@ -396,21 +396,21 @@ Section GENDIVN1. <[|w_add_mul_div (w_head0 b) b w_0|]). rewrite H4. rewrite spec_add_mul_div;auto with zarith. - rewrite spec_0;rewrite Zmult_0_l;rewrite Zplus_0_l. + rewrite spec_0;rewrite Z.mul_0_l;rewrite Z.add_0_l. assert (([|high n a|]/2^(Zpos w_digits - [|w_head0 b|])) < wB). apply Zdiv_lt_upper_bound;auto with zarith. - apply Zlt_le_trans with wB;auto with zarith. + apply Z.lt_le_trans with wB;auto with zarith. pattern wB at 1;replace wB with (wB*1);try ring. - apply Zmult_le_compat;auto with zarith. - assert (H6 := Zpower_gt_0 2 (Zpos w_digits - [|w_head0 b|])); + apply Z.mul_le_mono_nonneg;auto with zarith. + assert (H6 := Z.pow_pos_nonneg 2 (Zpos w_digits - [|w_head0 b|])); auto with zarith. rewrite Zmod_small;auto with zarith. apply Zdiv_lt_upper_bound;auto with zarith. - apply Zlt_le_trans with wB;auto with zarith. - apply Zle_trans with (2 ^ [|w_head0 b|] * [|b|] * 2). + apply Z.lt_le_trans with wB;auto with zarith. + apply Z.le_trans with (2 ^ [|w_head0 b|] * [|b|] * 2). rewrite <- wB_div_2; try omega. - apply Zmult_le_compat;auto with zarith. - pattern 2 at 1;rewrite <- Zpower_1_r. + apply Z.mul_le_mono_nonneg;auto with zarith. + pattern 2 at 1;rewrite <- Z.pow_1_r. apply Zpower_le_monotone;split;auto with zarith. rewrite <- H4 in H0. assert (Hb3: [|w_head0 b|] <= Zpos w_digits); auto with zarith. @@ -420,9 +420,9 @@ Section GENDIVN1. (double_0 w_0 n)) as (q,r). assert (U:= spec_double_digits n). rewrite spec_double_0 in H7;trivial;rewrite Zdiv_0_l in H7. - rewrite Zplus_0_r in H7. + rewrite Z.add_0_r in H7. rewrite spec_add_mul_div in H7;auto with zarith. - rewrite spec_0 in H7;rewrite Zmult_0_l in H7;rewrite Zplus_0_l in H7. + rewrite spec_0 in H7;rewrite Z.mul_0_l in H7;rewrite Z.add_0_l in H7. assert (([|high n a|] / 2 ^ (Zpos w_digits - [|w_head0 b|])) mod wB = [!n|a!] / 2^(Zpos (w_digits << n) - [|w_head0 b|])). rewrite Zmod_small;auto with zarith. @@ -431,29 +431,29 @@ Section GENDIVN1. replace (Zpos (w_digits << n) - Zpos w_digits + (Zpos w_digits - [|w_head0 b|])) with (Zpos (w_digits << n) - [|w_head0 b|]);trivial;ring. - assert (H8 := Zpower_gt_0 2 (Zpos w_digits - [|w_head0 b|]));auto with zarith. + assert (H8 := Z.pow_pos_nonneg 2 (Zpos w_digits - [|w_head0 b|]));auto with zarith. split;auto with zarith. - apply Zle_lt_trans with ([|high n a|]);auto with zarith. + apply Z.le_lt_trans with ([|high n a|]);auto with zarith. apply Zdiv_le_upper_bound;auto with zarith. - pattern ([|high n a|]) at 1;rewrite <- Zmult_1_r. - apply Zmult_le_compat;auto with zarith. + pattern ([|high n a|]) at 1;rewrite <- Z.mul_1_r. + apply Z.mul_le_mono_nonneg;auto with zarith. rewrite H8 in H7;unfold double_wB,base in H7. rewrite <- shift_unshift_mod in H7;auto with zarith. rewrite H4 in H7. assert ([|w_add_mul_div (w_sub w_zdigits (w_head0 b)) w_0 r|] = [|r|]/2^[|w_head0 b|]). rewrite spec_add_mul_div. - rewrite spec_0;rewrite Zmult_0_l;rewrite Zplus_0_l. + rewrite spec_0;rewrite Z.mul_0_l;rewrite Z.add_0_l. replace (Zpos w_digits - [|w_sub w_zdigits (w_head0 b)|]) with ([|w_head0 b|]). rewrite Zmod_small;auto with zarith. assert (H9 := spec_to_Z r). split;auto with zarith. - apply Zle_lt_trans with ([|r|]);auto with zarith. + apply Z.le_lt_trans with ([|r|]);auto with zarith. apply Zdiv_le_upper_bound;auto with zarith. - pattern ([|r|]) at 1;rewrite <- Zmult_1_r. - apply Zmult_le_compat;auto with zarith. - assert (H10 := Zpower_gt_0 2 ([|w_head0 b|]));auto with zarith. + pattern ([|r|]) at 1;rewrite <- Z.mul_1_r. + apply Z.mul_le_mono_nonneg;auto with zarith. + assert (H10 := Z.pow_pos_nonneg 2 ([|w_head0 b|]));auto with zarith. rewrite spec_sub. rewrite Zmod_small; auto with zarith. split; auto with zarith. @@ -475,7 +475,7 @@ Section GENDIVN1. auto with zarith. rewrite H9. apply Zdiv_lt_upper_bound;auto with zarith. - rewrite Zmult_comm;auto with zarith. + rewrite Z.mul_comm;auto with zarith. exact (spec_double_to_Z w_digits w_to_Z spec_to_Z n a). Qed. @@ -498,7 +498,7 @@ Section GENDIVN1. double_modn1 n a b = snd (double_divn1 n a b). Proof. intros n a b;unfold double_divn1,double_modn1. - rewrite spec_compare; case Zcompare_spec; + rewrite spec_compare; case Z.compare_spec; rewrite spec_0; intros H2; auto with zarith. apply spec_double_modn1_0. apply spec_double_modn1_0. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v index a6a0fc8e..0a70dbf4 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -104,9 +104,9 @@ Section DoubleLift. Variable spec_w_W0 : forall h, [[w_W0 h]] = [|h|] * wB. Variable spec_w_0W : forall l, [[w_0W l]] = [|l|]. Variable spec_compare : forall x y, - w_compare x y = Zcompare [|x|] [|y|]. + w_compare x y = Z.compare [|x|] [|y|]. Variable spec_ww_compare : forall x y, - ww_compare x y = Zcompare [[x]] [[y]]. + ww_compare x y = Z.compare [[x]] [[y]]. Variable spec_ww_digits : ww_Digits = xO w_digits. Variable spec_w_head00 : forall x, [|x|] = 0 -> [|w_head0 x|] = Zpos w_digits. Variable spec_w_head0 : forall x, 0 < [|x|] -> @@ -140,20 +140,20 @@ Section DoubleLift. case (spec_to_Z xh); intros Hx1 Hx2. case (spec_to_Z xl); intros Hy1 Hy2. assert (F1: [|xh|] = 0). - case (Zle_lt_or_eq _ _ Hy1); auto; intros Hy3. - absurd (0 < [|xh|] * wB + [|xl|]); auto with zarith. - apply Zlt_le_trans with (1 := Hy3); auto with zarith. - pattern [|xl|] at 1; rewrite <- (Zplus_0_l [|xl|]). - apply Zplus_le_compat_r; auto with zarith. - case (Zle_lt_or_eq _ _ Hx1); auto; intros Hx3. - absurd (0 < [|xh|] * wB + [|xl|]); auto with zarith. - rewrite <- Hy3; rewrite Zplus_0_r; auto with zarith. - apply Zmult_lt_0_compat; auto with zarith. - rewrite spec_compare. case Zcompare_spec. + { Z.le_elim Hy1; auto. + - absurd (0 < [|xh|] * wB + [|xl|]); auto with zarith. + apply Z.lt_le_trans with (1 := Hy1); auto with zarith. + pattern [|xl|] at 1; rewrite <- (Z.add_0_l [|xl|]). + apply Z.add_le_mono_r; auto with zarith. + - Z.le_elim Hx1; auto. + absurd (0 < [|xh|] * wB + [|xl|]); auto with zarith. + rewrite <- Hy1; rewrite Z.add_0_r; auto with zarith. + apply Z.mul_pos_pos; auto with zarith. } + rewrite spec_compare. case Z.compare_spec. intros H; simpl. rewrite spec_w_add; rewrite spec_w_head00. rewrite spec_zdigits; rewrite spec_ww_digits. - rewrite Zpos_xO; auto with zarith. + rewrite Pos2Z.inj_xO; auto with zarith. rewrite F1 in Hx; auto with zarith. rewrite spec_w_0; auto with zarith. rewrite spec_w_0; auto with zarith. @@ -163,43 +163,43 @@ Section DoubleLift. wwB/ 2 <= 2 ^ [[ww_head0 x]] * [[x]] < wwB. Proof. clear spec_ww_zdigits. - rewrite wwB_div_2;rewrite Zmult_comm;rewrite wwB_wBwB. + rewrite wwB_div_2;rewrite Z.mul_comm;rewrite wwB_wBwB. assert (U:= lt_0_wB w_digits); destruct x as [ |xh xl];simpl ww_to_Z;intros H. - unfold Zlt in H;discriminate H. - rewrite spec_compare, spec_w_0. case Zcompare_spec; intros H0. - rewrite <- H0 in *. simpl Zplus. simpl in H. + unfold Z.lt in H;discriminate H. + rewrite spec_compare, spec_w_0. case Z.compare_spec; intros H0. + rewrite <- H0 in *. simpl Z.add. simpl in H. case (spec_to_Z w_zdigits); case (spec_to_Z (w_head0 xl)); intros HH1 HH2 HH3 HH4. rewrite spec_w_add. rewrite spec_zdigits; rewrite Zpower_exp; auto with zarith. case (spec_w_head0 H); intros H1 H2. - rewrite Zpower_2; fold wB; rewrite <- Zmult_assoc; split. - apply Zmult_le_compat_l; auto with zarith. - apply Zmult_lt_compat_l; auto with zarith. + rewrite Z.pow_2_r; fold wB; rewrite <- Z.mul_assoc; split. + apply Z.mul_le_mono_nonneg_l; auto with zarith. + apply Z.mul_lt_mono_pos_l; auto with zarith. assert (H1 := spec_w_head0 H0). rewrite spec_w_0W. split. - rewrite Zmult_plus_distr_r;rewrite Zmult_assoc. - apply Zle_trans with (2 ^ [|w_head0 xh|] * [|xh|] * wB). - rewrite Zmult_comm; zarith. + rewrite Z.mul_add_distr_l;rewrite Z.mul_assoc. + apply Z.le_trans with (2 ^ [|w_head0 xh|] * [|xh|] * wB). + rewrite Z.mul_comm; zarith. assert (0 <= 2 ^ [|w_head0 xh|] * [|xl|]);zarith. - assert (H2:=spec_to_Z xl);apply Zmult_le_0_compat;zarith. + assert (H2:=spec_to_Z xl);apply Z.mul_nonneg_nonneg;zarith. case (spec_to_Z (w_head0 xh)); intros H2 _. generalize ([|w_head0 xh|]) H1 H2;clear H1 H2; intros p H1 H2. assert (Eq1 : 2^p < wB). - rewrite <- (Zmult_1_r (2^p));apply Zle_lt_trans with (2^p*[|xh|]);zarith. + rewrite <- (Z.mul_1_r (2^p));apply Z.le_lt_trans with (2^p*[|xh|]);zarith. assert (Eq2: p < Zpos w_digits). - destruct (Zle_or_lt (Zpos w_digits) p);trivial;contradict Eq1. - apply Zle_not_lt;unfold base;apply Zpower_le_monotone;zarith. + destruct (Z.le_gt_cases (Zpos w_digits) p);trivial;contradict Eq1. + apply Z.le_ngt;unfold base;apply Zpower_le_monotone;zarith. assert (Zpos w_digits = p + (Zpos w_digits - p)). ring. - rewrite Zpower_2. + rewrite Z.pow_2_r. unfold base at 2;rewrite H3;rewrite Zpower_exp;zarith. - rewrite <- Zmult_assoc; apply Zmult_lt_compat_l; zarith. - rewrite <- (Zplus_0_r (2^(Zpos w_digits - p)*wB));apply beta_lex_inv;zarith. - apply Zmult_lt_reg_r with (2 ^ p); zarith. + rewrite <- Z.mul_assoc; apply Z.mul_lt_mono_pos_l; zarith. + rewrite <- (Z.add_0_r (2^(Zpos w_digits - p)*wB));apply beta_lex_inv;zarith. + apply Z.mul_lt_mono_pos_r with (2 ^ p); zarith. rewrite <- Zpower_exp;zarith. - rewrite Zmult_comm;ring_simplify (Zpos w_digits - p + p);fold wB;zarith. + rewrite Z.mul_comm;ring_simplify (Zpos w_digits - p + p);fold wB;zarith. assert (H1 := spec_to_Z xh);zarith. Qed. @@ -211,22 +211,22 @@ Section DoubleLift. case (spec_to_Z xh); intros Hx1 Hx2. case (spec_to_Z xl); intros Hy1 Hy2. assert (F1: [|xh|] = 0). - case (Zle_lt_or_eq _ _ Hy1); auto; intros Hy3. - absurd (0 < [|xh|] * wB + [|xl|]); auto with zarith. - apply Zlt_le_trans with (1 := Hy3); auto with zarith. - pattern [|xl|] at 1; rewrite <- (Zplus_0_l [|xl|]). - apply Zplus_le_compat_r; auto with zarith. - case (Zle_lt_or_eq _ _ Hx1); auto; intros Hx3. - absurd (0 < [|xh|] * wB + [|xl|]); auto with zarith. - rewrite <- Hy3; rewrite Zplus_0_r; auto with zarith. - apply Zmult_lt_0_compat; auto with zarith. + { Z.le_elim Hy1; auto. + - absurd (0 < [|xh|] * wB + [|xl|]); auto with zarith. + apply Z.lt_le_trans with (1 := Hy1); auto with zarith. + pattern [|xl|] at 1; rewrite <- (Z.add_0_l [|xl|]). + apply Z.add_le_mono_r; auto with zarith. + - Z.le_elim Hx1; auto. + absurd (0 < [|xh|] * wB + [|xl|]); auto with zarith. + rewrite <- Hy1; rewrite Z.add_0_r; auto with zarith. + apply Z.mul_pos_pos; auto with zarith. } assert (F2: [|xl|] = 0). rewrite F1 in Hx; auto with zarith. - rewrite spec_compare; case Zcompare_spec. + rewrite spec_compare; case Z.compare_spec. intros H; simpl. rewrite spec_w_add; rewrite spec_w_tail00; auto. rewrite spec_zdigits; rewrite spec_ww_digits. - rewrite Zpos_xO; auto with zarith. + rewrite Pos2Z.inj_xO; auto with zarith. rewrite spec_w_0; auto with zarith. rewrite spec_w_0; auto with zarith. Qed. @@ -236,51 +236,51 @@ Section DoubleLift. Proof. clear spec_ww_zdigits. destruct x as [ |xh xl];simpl ww_to_Z;intros H. - unfold Zlt in H;discriminate H. - rewrite spec_compare, spec_w_0. case Zcompare_spec; intros H0. - rewrite <- H0; rewrite Zplus_0_r. + unfold Z.lt in H;discriminate H. + rewrite spec_compare, spec_w_0. case Z.compare_spec; intros H0. + rewrite <- H0; rewrite Z.add_0_r. case (spec_to_Z (w_tail0 xh)); intros HH1 HH2. - generalize H; rewrite <- H0; rewrite Zplus_0_r; clear H; intros H. + generalize H; rewrite <- H0; rewrite Z.add_0_r; clear H; intros H. case (@spec_w_tail0 xh). - apply Zmult_lt_reg_r with wB; auto with zarith. + apply Z.mul_lt_mono_pos_r with wB; auto with zarith. unfold base; auto with zarith. intros z (Hz1, Hz2); exists z; split; auto. - rewrite spec_w_add; rewrite (fun x => Zplus_comm [|x|]). + rewrite spec_w_add; rewrite (fun x => Z.add_comm [|x|]). rewrite spec_zdigits; rewrite Zpower_exp; auto with zarith. - rewrite Zmult_assoc; rewrite <- Hz2; auto. + rewrite Z.mul_assoc; rewrite <- Hz2; auto. case (spec_to_Z (w_tail0 xh)); intros HH1 HH2. case (spec_w_tail0 H0); intros z (Hz1, Hz2). assert (Hp: [|w_tail0 xl|] < Zpos w_digits). - case (Zle_or_lt (Zpos w_digits) [|w_tail0 xl|]); auto; intros H1. + case (Z.le_gt_cases (Zpos w_digits) [|w_tail0 xl|]); auto; intros H1. absurd (2 ^ (Zpos w_digits) <= 2 ^ [|w_tail0 xl|]). - apply Zlt_not_le. + apply Z.lt_nge. case (spec_to_Z xl); intros HH3 HH4. - apply Zle_lt_trans with (2 := HH4). - apply Zle_trans with (1 * 2 ^ [|w_tail0 xl|]); auto with zarith. + apply Z.le_lt_trans with (2 := HH4). + apply Z.le_trans with (1 * 2 ^ [|w_tail0 xl|]); auto with zarith. rewrite Hz2. - apply Zmult_le_compat_r; auto with zarith. + apply Z.mul_le_mono_nonneg_r; auto with zarith. apply Zpower_le_monotone; auto with zarith. exists ([|xh|] * (2 ^ ((Zpos w_digits - [|w_tail0 xl|]) - 1)) + z); split. - apply Zplus_le_0_compat; auto. - apply Zmult_le_0_compat; auto with zarith. + apply Z.add_nonneg_nonneg; auto. + apply Z.mul_nonneg_nonneg; auto with zarith. case (spec_to_Z xh); auto. rewrite spec_w_0W. - rewrite (Zmult_plus_distr_r 2); rewrite <- Zplus_assoc. - rewrite Zmult_plus_distr_l; rewrite <- Hz2. - apply f_equal2 with (f := Zplus); auto. - rewrite (Zmult_comm 2). - repeat rewrite <- Zmult_assoc. - apply f_equal2 with (f := Zmult); auto. + rewrite (Z.mul_add_distr_l 2); rewrite <- Z.add_assoc. + rewrite Z.mul_add_distr_r; rewrite <- Hz2. + apply f_equal2 with (f := Z.add); auto. + rewrite (Z.mul_comm 2). + repeat rewrite <- Z.mul_assoc. + apply f_equal2 with (f := Z.mul); auto. case (spec_to_Z (w_tail0 xl)); intros HH3 HH4. - pattern 2 at 2; rewrite <- Zpower_1_r. + pattern 2 at 2; rewrite <- Z.pow_1_r. lazy beta; repeat rewrite <- Zpower_exp; auto with zarith. - unfold base; apply f_equal with (f := Zpower 2); auto with zarith. + unfold base; apply f_equal with (f := Z.pow 2); auto with zarith. contradict H0; case (spec_to_Z xl); auto with zarith. Qed. - Hint Rewrite Zdiv_0_l Zmult_0_l Zplus_0_l Zmult_0_r Zplus_0_r + Hint Rewrite Zdiv_0_l Z.mul_0_l Z.add_0_l Z.mul_0_r Z.add_0_r spec_w_W0 spec_w_0W spec_w_WW spec_w_0 (wB_div w_digits w_to_Z spec_to_Z) (wB_div_plus w_digits w_to_Z spec_to_Z) : w_rewrite. @@ -304,20 +304,20 @@ Section DoubleLift. intros xh xl yh yl p zdigits;assert (HwwB := wwB_pos w_digits). case (spec_to_w_Z p); intros Hv1 Hv2. replace (Zpos (xO w_digits)) with (Zpos w_digits + Zpos w_digits). - 2 : rewrite Zpos_xO;ring. + 2 : rewrite Pos2Z.inj_xO;ring. replace (Zpos w_digits + Zpos w_digits - [[p]]) with (Zpos w_digits + (Zpos w_digits - [[p]])). 2:ring. intros Hp; assert (Hxh := spec_to_Z xh);assert (Hxl:=spec_to_Z xl); assert (Hx := spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW xh xl)); simpl in Hx;assert (Hyh := spec_to_Z yh);assert (Hyl:=spec_to_Z yl); assert (Hy:=spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW yh yl));simpl in Hy. - rewrite spec_ww_compare; case Zcompare_spec; intros H1. + rewrite spec_ww_compare; case Z.compare_spec; intros H1. rewrite H1; unfold zdigits; rewrite spec_w_0W. - rewrite spec_zdigits; rewrite Zminus_diag; rewrite Zplus_0_r. + rewrite spec_zdigits; rewrite Z.sub_diag; rewrite Z.add_0_r. simpl ww_to_Z; w_rewrite;zarith. fold wB. - rewrite Zmult_plus_distr_l;rewrite <- Zmult_assoc;rewrite <- Zplus_assoc. - rewrite <- Zpower_2. + rewrite Z.mul_add_distr_r;rewrite <- Z.mul_assoc;rewrite <- Z.add_assoc. + rewrite <- Z.pow_2_r. rewrite <- wwB_wBwB;apply Zmod_unique with [|xh|]. exact (spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW xl yh)). ring. simpl ww_to_Z; w_rewrite;zarith. @@ -327,7 +327,7 @@ Section DoubleLift. case (spec_to_w_Z p); intros HH1 HH2; split; auto. generalize H1; unfold zdigits; rewrite spec_w_0W; rewrite spec_zdigits; intros tmp. - apply Zlt_le_trans with (1 := tmp). + apply Z.lt_le_trans with (1 := tmp). unfold base. apply Zpower2_le_lin; auto with zarith. 2: generalize H1; unfold zdigits; rewrite spec_w_0W; @@ -338,16 +338,16 @@ Section DoubleLift. rewrite HH0; auto with zarith. repeat rewrite spec_w_add_mul_div with (1 := HH). rewrite HH0. - rewrite Zmult_plus_distr_l. + rewrite Z.mul_add_distr_r. pattern ([|xl|] * 2 ^ [[p]]) at 2; rewrite shift_unshift_mod with (n:= Zpos w_digits);fold wB;zarith. replace ([|xh|] * wB * 2^[[p]]) with ([|xh|] * 2^[[p]] * wB). 2:ring. - rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. rewrite <- Zplus_assoc. + rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r. rewrite <- Z.add_assoc. unfold base at 5;rewrite <- Zmod_shift_r;zarith. unfold base;rewrite Zmod_shift_r with (b:= Zpos (ww_digits w_digits)); fold wB;fold wwB;zarith. - rewrite wwB_wBwB;rewrite Zpower_2; rewrite Zmult_mod_distr_r;zarith. - unfold ww_digits;rewrite Zpos_xO;zarith. apply Z_mod_lt;zarith. + rewrite wwB_wBwB;rewrite Z.pow_2_r; rewrite Zmult_mod_distr_r;zarith. + unfold ww_digits;rewrite Pos2Z.inj_xO;zarith. apply Z_mod_lt;zarith. split;zarith. apply Zdiv_lt_upper_bound;zarith. rewrite <- Zpower_exp;zarith. ring_simplify ([[p]] + (Zpos w_digits - [[p]]));fold wB;zarith. @@ -362,10 +362,10 @@ Section DoubleLift. rewrite <- Zmod_div_mod; auto with zarith. rewrite Zmod_small; auto with zarith. split; auto with zarith. - apply Zle_lt_trans with (Zpos w_digits); auto with zarith. + apply Z.le_lt_trans with (Zpos w_digits); auto with zarith. unfold base; apply Zpower2_lt_lin; auto with zarith. exists wB; unfold base. - unfold ww_digits; rewrite (Zpos_xO w_digits). + unfold ww_digits; rewrite (Pos2Z.inj_xO w_digits). rewrite <- Zpower_exp; auto with zarith. apply f_equal with (f := fun x => 2 ^ x); auto with zarith. assert (HH: [|low (ww_sub p zdigits)|] <= Zpos w_digits). @@ -378,25 +378,25 @@ Section DoubleLift. pattern wB at 5;replace wB with (2^(([[p]] - Zpos w_digits) + (Zpos w_digits - ([[p]] - Zpos w_digits)))). - rewrite Zpower_exp;zarith. rewrite Zmult_assoc. + rewrite Zpower_exp;zarith. rewrite Z.mul_assoc. rewrite Z_div_plus_l;zarith. rewrite shift_unshift_mod with (a:= [|yh|]) (p:= [[p]] - Zpos w_digits) (n := Zpos w_digits);zarith. fold wB. set (u := [[p]] - Zpos w_digits). replace [[p]] with (u + Zpos w_digits);zarith. - rewrite Zpower_exp;zarith. rewrite Zmult_assoc. fold wB. - repeat rewrite Zplus_assoc. rewrite <- Zmult_plus_distr_l. - repeat rewrite <- Zplus_assoc. + rewrite Zpower_exp;zarith. rewrite Z.mul_assoc. fold wB. + repeat rewrite Z.add_assoc. rewrite <- Z.mul_add_distr_r. + repeat rewrite <- Z.add_assoc. unfold base;rewrite Zmod_shift_r with (b:= Zpos (ww_digits w_digits)); fold wB;fold wwB;zarith. unfold base;rewrite Zmod_shift_r with (a:= Zpos w_digits) (b:= Zpos w_digits);fold wB;fold wwB;zarith. - rewrite wwB_wBwB; rewrite Zpower_2; rewrite Zmult_mod_distr_r;zarith. - rewrite Zmult_plus_distr_l. + rewrite wwB_wBwB; rewrite Z.pow_2_r; rewrite Zmult_mod_distr_r;zarith. + rewrite Z.mul_add_distr_r. replace ([|xh|] * wB * 2 ^ u) with ([|xh|]*2^u*wB). 2:ring. - repeat rewrite <- Zplus_assoc. - rewrite (Zplus_comm ([|xh|] * 2 ^ u * wB)). + repeat rewrite <- Z.add_assoc. + rewrite (Z.add_comm ([|xh|] * 2 ^ u * wB)). rewrite Z_mod_plus;zarith. rewrite Z_mod_mult;zarith. unfold base;rewrite <- Zmod_shift_r;zarith. fold base;apply Z_mod_lt;zarith. unfold u; split;zarith. @@ -404,7 +404,7 @@ Section DoubleLift. rewrite <- Zpower_exp;zarith. fold u. ring_simplify (u + (Zpos w_digits - u)); fold - wB;zarith. unfold ww_digits;rewrite Zpos_xO;zarith. + wB;zarith. unfold ww_digits;rewrite Pos2Z.inj_xO;zarith. unfold base;rewrite <- Zmod_shift_r;zarith. fold base;apply Z_mod_lt;zarith. unfold u; split;zarith. unfold u; split;zarith. @@ -434,14 +434,14 @@ Section DoubleLift. clear H1;w_rewrite);simpl ww_add_mul_div. replace [[WW w_0 w_0]] with 0;[w_rewrite|simpl;w_rewrite;trivial]. intros Heq;rewrite <- Heq;clear Heq; auto. - rewrite spec_ww_compare. case Zcompare_spec; intros H1; w_rewrite. + rewrite spec_ww_compare. case Z.compare_spec; intros H1; w_rewrite. rewrite (spec_w_add_mul_div w_0 w_0);w_rewrite;zarith. generalize H1; w_rewrite; rewrite spec_zdigits; clear H1; intros H1. assert (HH0: [|low p|] = [[p]]). rewrite spec_low. apply Zmod_small. case (spec_to_w_Z p); intros HH1 HH2; split; auto. - apply Zlt_le_trans with (1 := H1). + apply Z.lt_le_trans with (1 := H1). unfold base; apply Zpower2_le_lin; auto with zarith. rewrite HH0; auto with zarith. replace [[WW w_0 w_0]] with 0;[w_rewrite|simpl;w_rewrite;trivial]. @@ -449,7 +449,7 @@ Section DoubleLift. generalize (spec_ww_compare p (w_0W w_zdigits)); case ww_compare; intros H1; w_rewrite. rewrite (spec_w_add_mul_div w_0 w_0);w_rewrite;zarith. - rewrite Zpos_xO in H;zarith. + rewrite Pos2Z.inj_xO in H;zarith. assert (HH: [|low (ww_sub p (w_0W w_zdigits)) |] = [[p]] - Zpos w_digits). symmetry in H1; change ([[p]] > [[w_0W w_zdigits]]) in H1. revert H1. @@ -458,12 +458,12 @@ Section DoubleLift. rewrite <- Zmod_div_mod; auto with zarith. rewrite Zmod_small; auto with zarith. split; auto with zarith. - apply Zle_lt_trans with (Zpos w_digits); auto with zarith. + apply Z.le_lt_trans with (Zpos w_digits); auto with zarith. unfold base; apply Zpower2_lt_lin; auto with zarith. unfold base; auto with zarith. unfold base; auto with zarith. exists wB; unfold base. - unfold ww_digits; rewrite (Zpos_xO w_digits). + unfold ww_digits; rewrite (Pos2Z.inj_xO w_digits). rewrite <- Zpower_exp; auto with zarith. apply f_equal with (f := fun x => 2 ^ x); auto with zarith. case (spec_to_Z xh); auto with zarith. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v index 0032d2c3..7a92ff0c 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -246,7 +246,7 @@ Section DoubleMul. Variable spec_w_W0 : forall h, [[w_W0 h]] = [|h|] * wB. Variable spec_w_0W : forall l, [[w_0W l]] = [|l|]. Variable spec_w_compare : - forall x y, w_compare x y = Zcompare [|x|] [|y|]. + forall x y, w_compare x y = Z.compare [|x|] [|y|]. Variable spec_w_succ : forall x, [|w_succ x|] = ([|x|] + 1) mod wB. Variable spec_w_add_c : forall x y, [+|w_add_c x y|] = [|x|] + [|y|]. Variable spec_w_add : forall x y, [|w_add x y|] = ([|x|] + [|y|]) mod wB. @@ -325,7 +325,7 @@ Section DoubleMul. destruct cc as [ | cch ccl]; simpl zn2z_to_Z; simpl ww_to_Z. rewrite spec_ww_add;rewrite spec_w_W0;rewrite Zmod_small; rewrite wwB_wBwB. ring. - rewrite <- (Zplus_0_r ([|wc|]*wB));rewrite H;apply mult_add_ineq3;zarith. + rewrite <- (Z.add_0_r ([|wc|]*wB));rewrite H;apply mult_add_ineq3;zarith. simpl ww_to_Z in H1. assert (U:=spec_to_Z cch). assert ([|wc|]*wB + [|cch|] <= 2*wB - 3). destruct (Z_le_gt_dec ([|wc|]*wB + [|cch|]) (2*wB - 3));trivial. @@ -335,21 +335,21 @@ Section DoubleMul. assert (H5 := Zmult_lt_b _ _ _ (spec_to_Z xl) (spec_to_Z yh)). omega. generalize H3;clear H3;rewrite <- H1. - rewrite Zplus_assoc; rewrite Zpower_2; rewrite Zmult_assoc; - rewrite <- Zmult_plus_distr_l. + rewrite Z.add_assoc; rewrite Z.pow_2_r; rewrite Z.mul_assoc; + rewrite <- Z.mul_add_distr_r. assert (((2 * wB - 4) + 2)*wB <= ([|wc|] * wB + [|cch|])*wB). - apply Zmult_le_compat;zarith. - rewrite Zmult_plus_distr_l in H3. + apply Z.mul_le_mono_nonneg;zarith. + rewrite Z.mul_add_distr_r in H3. intros. assert (U2 := spec_to_Z ccl);omega. generalize (spec_ww_add_c (w_W0 ccl) ll);destruct (ww_add_c (w_W0 ccl) ll) - as [l|l];unfold interp_carry;rewrite spec_w_W0;try rewrite Zmult_1_l; + as [l|l];unfold interp_carry;rewrite spec_w_W0;try rewrite Z.mul_1_l; simpl zn2z_to_Z; try rewrite spec_ww_add;try rewrite spec_ww_add_carry;rewrite spec_w_WW; rewrite Zmod_small;rewrite wwB_wBwB;intros. rewrite H4;ring. rewrite H;apply mult_add_ineq2;zarith. - rewrite Zplus_assoc;rewrite Zmult_plus_distr_l. - rewrite Zmult_1_l;rewrite <- Zplus_assoc;rewrite H4;ring. - repeat rewrite <- Zplus_assoc;rewrite H;apply mult_add_ineq2;zarith. + rewrite Z.add_assoc;rewrite Z.mul_add_distr_r. + rewrite Z.mul_1_l;rewrite <- Z.add_assoc;rewrite H4;ring. + repeat rewrite <- Z.add_assoc;rewrite H;apply mult_add_ineq2;zarith. Qed. Lemma spec_double_mul_c : forall cross:w->w->w->w->zn2z w -> zn2z w -> w*zn2z w, @@ -361,7 +361,7 @@ Section DoubleMul. forall x y, [||double_mul_c cross x y||] = [[x]] * [[y]]. Proof. intros cross Hcross x y;destruct x as [ |xh xl];simpl;trivial. - destruct y as [ |yh yl];simpl. rewrite Zmult_0_r;trivial. + destruct y as [ |yh yl];simpl. rewrite Z.mul_0_r;trivial. assert (H1:= spec_w_mul_c xh yh);assert (H2:= spec_w_mul_c xl yl). generalize (Hcross _ _ _ _ _ _ H1 H2). destruct (cross xh xl yh yl (w_mul_c xh yh) (w_mul_c xl yl)) as (wc,cc). @@ -382,7 +382,7 @@ Section DoubleMul. Lemma spec_w_2: [|w_2|] = 2. unfold w_2; rewrite spec_w_add; rewrite spec_w_1; simpl. apply Zmod_small; split; auto with zarith. - rewrite <- (Zpower_1_r 2); unfold base; apply Zpower_lt_monotone; auto with zarith. + rewrite <- (Z.pow_1_r 2); unfold base; apply Zpower_lt_monotone; auto with zarith. Qed. Lemma kara_prod_aux : forall xh xl yh yl, @@ -401,19 +401,19 @@ Section DoubleMul. assert (Hyh := (spec_to_Z yh)); assert (Hyl := (spec_to_Z yl)). generalize (spec_ww_add_c hh ll); case (ww_add_c hh ll); intros z Hz; rewrite <- Hz; unfold interp_carry; assert (Hz1 := (spec_ww_to_Z z)). - rewrite spec_w_compare; case Zcompare_spec; intros Hxlh; + rewrite spec_w_compare; case Z.compare_spec; intros Hxlh; try rewrite Hxlh; try rewrite spec_w_0; try (ring; fail). - rewrite spec_w_compare; case Zcompare_spec; intros Hylh. + rewrite spec_w_compare; case Z.compare_spec; intros Hylh. rewrite Hylh; rewrite spec_w_0; try (ring; fail). rewrite spec_w_0; try (ring; fail). repeat (rewrite spec_ww_sub || rewrite spec_w_sub || rewrite spec_w_mul_c). repeat rewrite Zmod_small; auto with zarith; try (ring; fail). split; auto with zarith. simpl in Hz; rewrite Hz; rewrite H; rewrite H0. - rewrite kara_prod_aux; apply Zplus_le_0_compat; apply Zmult_le_0_compat; auto with zarith. - apply Zle_lt_trans with ([[z]]-0); auto with zarith. - unfold Zminus; apply Zplus_le_compat_l; apply Zle_left_rev; simpl; rewrite Zopp_involutive. - apply Zmult_le_0_compat; auto with zarith. + rewrite kara_prod_aux; apply Z.add_nonneg_nonneg; apply Z.mul_nonneg_nonneg; auto with zarith. + apply Z.le_lt_trans with ([[z]]-0); auto with zarith. + unfold Z.sub; apply Z.add_le_mono_l; apply Z.le_0_sub; simpl; rewrite Z.opp_involutive. + apply Z.mul_nonneg_nonneg; auto with zarith. match goal with |- context[ww_add_c ?x ?y] => generalize (spec_ww_add_c x y); case (ww_add_c x y); try rewrite spec_w_0; intros z1 Hz2 @@ -423,7 +423,7 @@ Section DoubleMul. rewrite spec_w_1; unfold interp_carry in Hz2; rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c). repeat rewrite Zmod_small; auto with zarith; try (ring; fail). - rewrite spec_w_compare; case Zcompare_spec; intros Hylh. + rewrite spec_w_compare; case Z.compare_spec; intros Hylh. rewrite Hylh; rewrite spec_w_0; try (ring; fail). match goal with |- context[ww_add_c ?x ?y] => generalize (spec_ww_add_c x y); case (ww_add_c x y); try rewrite spec_w_0; @@ -442,15 +442,15 @@ Section DoubleMul. replace ((x - y) * (z - t)) with ((y - x) * (t - z)); [idtac | ring] end. simpl in Hz; rewrite Hz; rewrite H; rewrite H0. - rewrite kara_prod_aux; apply Zplus_le_0_compat; apply Zmult_le_0_compat; auto with zarith. - apply Zle_lt_trans with ([[z]]-0); auto with zarith. - unfold Zminus; apply Zplus_le_compat_l; apply Zle_left_rev; simpl; rewrite Zopp_involutive. - apply Zmult_le_0_compat; auto with zarith. + rewrite kara_prod_aux; apply Z.add_nonneg_nonneg; apply Z.mul_nonneg_nonneg; auto with zarith. + apply Z.le_lt_trans with ([[z]]-0); auto with zarith. + unfold Z.sub; apply Z.add_le_mono_l; apply Z.le_0_sub; simpl; rewrite Z.opp_involutive. + apply Z.mul_nonneg_nonneg; auto with zarith. (** there is a carry in hh + ll **) - rewrite Zmult_1_l. - rewrite spec_w_compare; case Zcompare_spec; intros Hxlh; + rewrite Z.mul_1_l. + rewrite spec_w_compare; case Z.compare_spec; intros Hxlh; try rewrite Hxlh; try rewrite spec_w_1; try (ring; fail). - rewrite spec_w_compare; case Zcompare_spec; intros Hylh; + rewrite spec_w_compare; case Z.compare_spec; intros Hylh; try rewrite Hylh; try rewrite spec_w_1; try (ring; fail). match goal with |- context[ww_sub_c ?x ?y] => generalize (spec_ww_sub_c x y); case (ww_sub_c x y); try rewrite spec_w_1; @@ -458,7 +458,7 @@ Section DoubleMul. end. simpl in Hz2; rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c). repeat rewrite Zmod_small; auto with zarith; try (ring; fail). - rewrite spec_w_0; rewrite Zmult_0_l; rewrite Zplus_0_l. + rewrite spec_w_0; rewrite Z.mul_0_l; rewrite Z.add_0_l. generalize Hz2; clear Hz2; unfold interp_carry. repeat (rewrite spec_w_sub || rewrite spec_w_mul_c). repeat rewrite Zmod_small; auto with zarith; try (ring; fail). @@ -469,11 +469,11 @@ Section DoubleMul. simpl in Hz2; rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c). repeat rewrite Zmod_small; auto with zarith; try (ring; fail). rewrite spec_w_2; unfold interp_carry in Hz2. - apply trans_equal with (wwB + (1 * wwB + [[z1]])). + transitivity (wwB + (1 * wwB + [[z1]])). ring. rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c). repeat rewrite Zmod_small; auto with zarith; try (ring; fail). - rewrite spec_w_compare; case Zcompare_spec; intros Hylh; + rewrite spec_w_compare; case Z.compare_spec; intros Hylh; try rewrite Hylh; try rewrite spec_w_1; try (ring; fail). match goal with |- context[ww_add_c ?x ?y] => generalize (spec_ww_add_c x y); case (ww_add_c x y); try rewrite spec_w_1; @@ -482,7 +482,7 @@ Section DoubleMul. simpl in Hz2; rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c). repeat rewrite Zmod_small; auto with zarith; try (ring; fail). rewrite spec_w_2; unfold interp_carry in Hz2. - apply trans_equal with (wwB + (1 * wwB + [[z1]])). + transitivity (wwB + (1 * wwB + [[z1]])). ring. rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c). repeat rewrite Zmod_small; auto with zarith; try (ring; fail). @@ -492,7 +492,7 @@ Section DoubleMul. end. simpl in Hz2; rewrite Hz2; repeat (rewrite spec_w_sub || rewrite spec_w_mul_c). repeat rewrite Zmod_small; auto with zarith; try (ring; fail). - rewrite spec_w_0; rewrite Zmult_0_l; rewrite Zplus_0_l. + rewrite spec_w_0; rewrite Z.mul_0_l; rewrite Z.add_0_l. match goal with |- context[(?x - ?y) * (?z - ?t)] => replace ((x - y) * (z - t)) with ((y - x) * (t - z)); [idtac | ring] end. @@ -513,7 +513,7 @@ Section DoubleMul. rewrite <- wwB_wBwB;intros H1 H2. assert (H3 := wB_pos w_digits). assert (2*wB <= wwB). - rewrite wwB_wBwB; rewrite Zpower_2; apply Zmult_le_compat;zarith. + rewrite wwB_wBwB; rewrite Z.pow_2_r; apply Z.mul_le_mono_nonneg;zarith. omega. Qed. @@ -537,14 +537,14 @@ Section DoubleMul. assert (U1:= lt_0_wwB w_digits). intros x y; case x; auto; intros xh xl. case y; auto. - simpl; rewrite Zmult_0_r; rewrite Zmod_small; auto with zarith. + simpl; rewrite Z.mul_0_r; rewrite Zmod_small; auto with zarith. intros yh yl;simpl. repeat (rewrite spec_ww_add || rewrite spec_w_W0 || rewrite spec_w_mul_c || rewrite spec_w_add || rewrite spec_w_mul). rewrite <- Zplus_mod; auto with zarith. - repeat (rewrite Zmult_plus_distr_l || rewrite Zmult_plus_distr_r). + repeat (rewrite Z.mul_add_distr_r || rewrite Z.mul_add_distr_l). rewrite <- Zmult_mod_distr_r; auto with zarith. - rewrite <- Zpower_2; rewrite <- wwB_wBwB; auto with zarith. + rewrite <- Z.pow_2_r; rewrite <- wwB_wBwB; auto with zarith. rewrite Zplus_mod; auto with zarith. rewrite Zmod_mod; auto with zarith. rewrite <- Zplus_mod; auto with zarith. @@ -564,10 +564,10 @@ Section DoubleMul. apply (spec_mul_aux xh xl xh xl wc cc);trivial. generalize Heq (spec_ww_add_c (w_mul_c xh xl) (w_mul_c xh xl));clear Heq. rewrite spec_w_mul_c;destruct (ww_add_c (w_mul_c xh xl) (w_mul_c xh xl)); - unfold interp_carry;try rewrite Zmult_1_l;intros Heq Heq';inversion Heq; - rewrite (Zmult_comm [|xl|]);subst. - rewrite spec_w_0;rewrite Zmult_0_l;rewrite Zplus_0_l;trivial. - rewrite spec_w_1;rewrite Zmult_1_l;rewrite <- wwB_wBwB;trivial. + unfold interp_carry;try rewrite Z.mul_1_l;intros Heq Heq';inversion Heq; + rewrite (Z.mul_comm [|xl|]);subst. + rewrite spec_w_0;rewrite Z.mul_0_l;rewrite Z.add_0_l;trivial. + rewrite spec_w_1;rewrite Z.mul_1_l;rewrite <- wwB_wBwB;trivial. Qed. Section DoubleMulAddn1Proof. @@ -589,8 +589,8 @@ Section DoubleMul. assert(H:=IHn xl y r);destruct (double_mul_add_n1 w_mul_add n xl y r)as(rl,l). assert(U:=IHn xh y rl);destruct(double_mul_add_n1 w_mul_add n xh y rl)as(rh,h). rewrite <- double_wB_wwB. rewrite spec_double_WW;simpl;trivial. - rewrite Zmult_plus_distr_l;rewrite <- Zplus_assoc;rewrite <- H. - rewrite Zmult_assoc;rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. + rewrite Z.mul_add_distr_r;rewrite <- Z.add_assoc;rewrite <- H. + rewrite Z.mul_assoc;rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r. rewrite U;ring. Qed. @@ -604,9 +604,9 @@ Section DoubleMul. destruct (w_mul_c x y) as [ |h l];simpl;rewrite <- H. rewrite spec_w_0;trivial. assert (U:=spec_w_add_c l r);destruct (w_add_c l r) as [lr|lr];unfold - interp_carry in U;try rewrite Zmult_1_l in H;simpl. + interp_carry in U;try rewrite Z.mul_1_l in H;simpl. rewrite U;ring. rewrite spec_w_succ. rewrite Zmod_small. - rewrite <- Zplus_assoc;rewrite <- U;ring. + rewrite <- Z.add_assoc;rewrite <- U;ring. simpl in H;assert (H1:= Zmult_lt_b _ _ _ (spec_to_Z x) (spec_to_Z y)). rewrite <- H in H1. assert (H2:=spec_to_Z h);split;zarith. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v index b073d6be..40556c4a 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -219,7 +219,7 @@ Section DoubleSqrt. Variable spec_w_is_even : forall x, if w_is_even x then [|x|] mod 2 = 0 else [|x|] mod 2 = 1. Variable spec_w_compare : forall x y, - w_compare x y = Zcompare [|x|] [|y|]. + w_compare x y = Z.compare [|x|] [|y|]. Variable spec_w_sub : forall x y, [|w_sub x y|] = ([|x|] - [|y|]) mod wB. Variable spec_w_square_c : forall x, [[ w_square_c x]] = [|x|] * [|x|]. Variable spec_w_div21 : forall a1 a2 b, @@ -232,7 +232,7 @@ Section DoubleSqrt. [|p|] <= Zpos w_digits -> [| w_add_mul_div p x y |] = ([|x|] * (2 ^ [|p|]) + - [|y|] / (Zpower 2 ((Zpos w_digits) - [|p|]))) mod wB. + [|y|] / (Z.pow 2 ((Zpos w_digits) - [|p|]))) mod wB. Variable spec_ww_add_mul_div : forall x y p, [[p]] <= Zpos (xO w_digits) -> [[ ww_add_mul_div p x y ]] = @@ -251,7 +251,7 @@ Section DoubleSqrt. Variable spec_ww_pred : forall x, [[ww_pred x]] = ([[x]] - 1) mod wwB. Variable spec_ww_add_c : forall x y, [+[ww_add_c x y]] = [[x]] + [[y]]. Variable spec_ww_compare : forall x y, - ww_compare x y = Zcompare [[x]] [[y]]. + ww_compare x y = Z.compare [[x]] [[y]]. Variable spec_ww_head0 : forall x, 0 < [[x]] -> wwB/ 2 <= 2 ^ [[ww_head0 x]] * [[x]] < wwB. Variable spec_low: forall x, [|low x|] = [[x]] mod wB. @@ -272,10 +272,9 @@ intros x; case x; simpl ww_is_even. unfold base. rewrite Zplus_mod; auto with zarith. rewrite (fun x y => (Zdivide_mod (x * y))); auto with zarith. - rewrite Zplus_0_l; rewrite Zmod_mod; auto with zarith. + rewrite Z.add_0_l; rewrite Zmod_mod; auto with zarith. apply spec_w_is_even; auto with zarith. - apply Zdivide_mult_r; apply Zpower_divide; auto with zarith. - red; simpl; auto. + apply Z.divide_mul_r; apply Zpower_divide; auto with zarith. Qed. @@ -286,10 +285,10 @@ intros x; case x; simpl ww_is_even. intros a1 a2 b Hb; unfold w_div21c. assert (H: 0 < [|b|]); auto with zarith. assert (U := wB_pos w_digits). - apply Zlt_le_trans with (2 := Hb); auto with zarith. - apply Zlt_le_trans with 1; auto with zarith. + apply Z.lt_le_trans with (2 := Hb); auto with zarith. + apply Z.lt_le_trans with 1; auto with zarith. apply Zdiv_le_lower_bound; auto with zarith. - rewrite !spec_w_compare. repeat case Zcompare_spec. + rewrite !spec_w_compare. repeat case Z.compare_spec. intros H1 H2; split. unfold interp_carry; autorewrite with w_rewrite rm10; auto with zarith. rewrite H1; rewrite H2; ring. @@ -308,7 +307,7 @@ intros x; case x; simpl ww_is_even. rewrite Zmod_small; auto with zarith. split; auto with zarith. assert ([|a2|] < 2 * [|b|]); auto with zarith. - apply Zlt_le_trans with (2 * (wB / 2)); auto with zarith. + apply Z.lt_le_trans with (2 * (wB / 2)); auto with zarith. rewrite wB_div_2; auto. intros H1. match goal with |- context[w_div21 ?y ?z ?t] => @@ -321,7 +320,7 @@ intros x; case x; simpl ww_is_even. rewrite spec_w_sub; auto with zarith. rewrite Zmod_small; auto with zarith. assert ([|a1|] < 2 * [|b|]); auto with zarith. - apply Zlt_le_trans with (2 * (wB / 2)); auto with zarith. + apply Z.lt_le_trans with (2 * (wB / 2)); auto with zarith. rewrite wB_div_2; auto. destruct (spec_to_Z a1);auto with zarith. destruct (spec_to_Z a1);auto with zarith. @@ -333,11 +332,11 @@ intros x; case x; simpl ww_is_even. intros w0 w1; replace [+|C1 w0|] with (wB + [|w0|]). rewrite Zmod_small; auto with zarith. intros (H3, H4); split; auto. - rewrite Zmult_plus_distr_l. - rewrite <- Zplus_assoc; rewrite <- H3; ring. + rewrite Z.mul_add_distr_r. + rewrite <- Z.add_assoc; rewrite <- H3; ring. split; auto with zarith. assert ([|a1|] < 2 * [|b|]); auto with zarith. - apply Zlt_le_trans with (2 * (wB / 2)); auto with zarith. + apply Z.lt_le_trans with (2 * (wB / 2)); auto with zarith. rewrite wB_div_2; auto. destruct (spec_to_Z a1);auto with zarith. destruct (spec_to_Z a1);auto with zarith. @@ -355,14 +354,14 @@ intros x; case x; simpl ww_is_even. rewrite spec_pred; rewrite spec_w_zdigits. rewrite Zmod_small; auto with zarith. split; auto with zarith. - apply Zlt_le_trans with (Zpos w_digits); auto with zarith. + apply Z.lt_le_trans with (Zpos w_digits); auto with zarith. unfold base; apply Zpower2_le_lin; auto with zarith. rewrite spec_w_add_mul_div; auto with zarith. autorewrite with w_rewrite rm10. match goal with |- context[?X - ?Y] => replace (X - Y) with 1 end. - rewrite Zpower_1_r; rewrite Zmod_small; auto with zarith. + rewrite Z.pow_1_r; rewrite Zmod_small; auto with zarith. destruct (spec_to_Z w1) as [H1 H2];auto with zarith. split; auto with zarith. apply Zdiv_lt_upper_bound; auto with zarith. @@ -377,15 +376,15 @@ intros x; case x; simpl ww_is_even. rewrite spec_pred; rewrite spec_w_zdigits. rewrite Zmod_small; auto with zarith. split; auto with zarith. - apply Zlt_le_trans with (Zpos w_digits); auto with zarith. + apply Z.lt_le_trans with (Zpos w_digits); auto with zarith. unfold base; apply Zpower2_le_lin; auto with zarith. autorewrite with w_rewrite rm10; auto with zarith. match goal with |- context[?X - ?Y] => replace (X - Y) with 1 end; rewrite Hp; try ring. - rewrite Zpos_minus; auto with zarith. - rewrite Zmax_right; auto with zarith. - rewrite Zpower_1_r; rewrite Zmod_small; auto with zarith. + rewrite Pos2Z.inj_sub_max; auto with zarith. + rewrite Z.max_r; auto with zarith. + rewrite Z.pow_1_r; rewrite Zmod_small; auto with zarith. destruct (spec_to_Z w1) as [H1 H2];auto with zarith. split; auto with zarith. unfold base. @@ -393,14 +392,14 @@ intros x; case x; simpl ww_is_even. assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith; rewrite <- (tmp X); clear tmp end. - rewrite Zpower_exp; try rewrite Zpower_1_r; auto with zarith. + rewrite Zpower_exp; try rewrite Z.pow_1_r; auto with zarith. assert (tmp: forall p, 1 + (p -1) - 1 = p - 1); auto with zarith; rewrite tmp; clear tmp; auto with zarith. match goal with |- ?X + ?Y < _ => assert (Y < X); auto with zarith end. apply Zdiv_lt_upper_bound; auto with zarith. - pattern 2 at 2; rewrite <- Zpower_1_r; rewrite <- Zpower_exp; + pattern 2 at 2; rewrite <- Z.pow_1_r; rewrite <- Zpower_exp; auto with zarith. assert (tmp: forall p, (p - 1) + 1 = p); auto with zarith; rewrite tmp; clear tmp; auto with zarith. @@ -410,8 +409,8 @@ intros x; case x; simpl ww_is_even. [|w_add_mul_div w_1 w w_0|] = 2 * [|w|] mod wB. intros w1. autorewrite with w_rewrite rm10; auto with zarith. - rewrite Zpower_1_r; auto with zarith. - rewrite Zmult_comm; auto. + rewrite Z.pow_1_r; auto with zarith. + rewrite Z.mul_comm; auto. Qed. Theorem ww_add_mult_mult_2: forall w, @@ -420,8 +419,8 @@ intros x; case x; simpl ww_is_even. rewrite spec_ww_add_mul_div; auto with zarith. autorewrite with w_rewrite rm10. rewrite spec_w_0W; rewrite spec_w_1. - rewrite Zpower_1_r; auto with zarith. - rewrite Zmult_comm; auto. + rewrite Z.pow_1_r; auto with zarith. + rewrite Z.mul_comm; auto. rewrite spec_w_0W; rewrite spec_w_1; auto with zarith. red; simpl; intros; discriminate. Qed. @@ -432,18 +431,18 @@ intros x; case x; simpl ww_is_even. intros w1. rewrite spec_ww_add_mul_div; auto with zarith. rewrite spec_w_0W; rewrite spec_w_1; auto with zarith. - rewrite Zpower_1_r; auto with zarith. + rewrite Z.pow_1_r; auto with zarith. f_equal; auto. - rewrite Zmult_comm; f_equal; auto. + rewrite Z.mul_comm; f_equal; auto. autorewrite with w_rewrite rm10. unfold ww_digits, base. - apply sym_equal; apply Zdiv_unique with (r := 2 ^ (Zpos (ww_digits w_digits) - 1) -1); + symmetry; apply Zdiv_unique with (r := 2 ^ (Zpos (ww_digits w_digits) - 1) -1); auto with zarith. unfold ww_digits; split; auto with zarith. match goal with |- 0 <= ?X - 1 => assert (0 < X); auto with zarith end. - apply Zpower_gt_0; auto with zarith. + apply Z.pow_pos_nonneg; auto with zarith. match goal with |- 0 <= ?X - 1 => assert (0 < X); auto with zarith; red; reflexivity end. @@ -453,7 +452,7 @@ intros x; case x; simpl ww_is_even. assert (tmp: forall p, p + p = 2 * p); auto with zarith; rewrite tmp; clear tmp. f_equal; auto. - pattern 2 at 2; rewrite <- Zpower_1_r; rewrite <- Zpower_exp; + pattern 2 at 2; rewrite <- Z.pow_1_r; rewrite <- Zpower_exp; auto with zarith. assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith; rewrite tmp; clear tmp; auto. @@ -466,7 +465,7 @@ intros x; case x; simpl ww_is_even. Theorem Zplus_mod_one: forall a1 b1, 0 < b1 -> (a1 + b1) mod b1 = a1 mod b1. intros a1 b1 H; rewrite Zplus_mod; auto with zarith. - rewrite Z_mod_same; try rewrite Zplus_0_r; auto with zarith. + rewrite Z_mod_same; try rewrite Z.add_0_r; auto with zarith. apply Zmod_mod; auto. Qed. @@ -481,8 +480,8 @@ intros x; case x; simpl ww_is_even. intros a1 a2 b H. assert (HH: 0 < [|b|]); auto with zarith. assert (U := wB_pos w_digits). - apply Zlt_le_trans with (2 := H); auto with zarith. - apply Zlt_le_trans with 1; auto with zarith. + apply Z.lt_le_trans with (2 := H); auto with zarith. + apply Z.lt_le_trans with 1; auto with zarith. apply Zdiv_le_lower_bound; auto with zarith. unfold w_div2s; case a1; intros w0 H0. match goal with |- context[w_div21c ?y ?z ?t] => @@ -528,10 +527,10 @@ intros x; case x; simpl ww_is_even. match goal with |- context[_ ^ ?X] => assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith; rewrite <- (tmp X); clear tmp; rewrite Zpower_exp; - try rewrite Zpower_1_r; auto with zarith + try rewrite Z.pow_1_r; auto with zarith end. - rewrite Zpos_minus; auto with zarith. - rewrite Zmax_right; auto with zarith. + rewrite Pos2Z.inj_sub_max; auto with zarith. + rewrite Z.max_r; auto with zarith. ring. repeat rewrite C0_id. rewrite spec_w_add_c; auto with zarith. @@ -545,10 +544,10 @@ intros x; case x; simpl ww_is_even. match goal with |- context[_ ^ ?X] => assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith; rewrite <- (tmp X); clear tmp; rewrite Zpower_exp; - try rewrite Zpower_1_r; auto with zarith + try rewrite Z.pow_1_r; auto with zarith end. - rewrite Zpos_minus; auto with zarith. - rewrite Zmax_right; auto with zarith. + rewrite Pos2Z.inj_sub_max; auto with zarith. + rewrite Z.max_r; auto with zarith. ring. repeat rewrite C1_plus_wB in H0. rewrite C1_plus_wB. @@ -570,7 +569,7 @@ intros x; case x; simpl ww_is_even. rewrite add_mult_div_2_plus_1. replace (wB + [|w0|]) with ([|b|] + ([|w0|] - [|b|] + wB)); auto with zarith. - rewrite Zmult_plus_distr_l; rewrite <- Zplus_assoc. + rewrite Z.mul_add_distr_r; rewrite <- Z.add_assoc. rewrite Hw1. pattern [|w2|] at 1; rewrite (Z_div_mod_eq [|w2|] 2); auto with zarith. @@ -578,10 +577,10 @@ intros x; case x; simpl ww_is_even. match goal with |- context[_ ^ ?X] => assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith; rewrite <- (tmp X); clear tmp; rewrite Zpower_exp; - try rewrite Zpower_1_r; auto with zarith + try rewrite Z.pow_1_r; auto with zarith end. - rewrite Zpos_minus; auto with zarith. - rewrite Zmax_right; auto with zarith. + rewrite Pos2Z.inj_sub_max; auto with zarith. + rewrite Z.max_r; auto with zarith. ring. repeat rewrite C0_id. rewrite add_mult_div_2_plus_1. @@ -589,7 +588,7 @@ intros x; case x; simpl ww_is_even. intros H1; split; auto with zarith. replace (wB + [|w0|]) with ([|b|] + ([|w0|] - [|b|] + wB)); auto with zarith. - rewrite Zmult_plus_distr_l; rewrite <- Zplus_assoc. + rewrite Z.mul_add_distr_r; rewrite <- Z.add_assoc. rewrite Hw1. pattern [|w2|] at 1; rewrite (Z_div_mod_eq [|w2|] 2); auto with zarith. @@ -597,10 +596,10 @@ intros x; case x; simpl ww_is_even. match goal with |- context[_ ^ ?X] => assert (tmp: forall p, 1 + (p - 1) = p); auto with zarith; rewrite <- (tmp X); clear tmp; rewrite Zpower_exp; - try rewrite Zpower_1_r; auto with zarith + try rewrite Z.pow_1_r; auto with zarith end. - rewrite Zpos_minus; auto with zarith. - rewrite Zmax_right; auto with zarith. + rewrite Pos2Z.inj_sub_max; auto with zarith. + rewrite Z.max_r; auto with zarith. ring. split; auto with zarith. destruct (spec_to_Z b);auto with zarith. @@ -620,7 +619,7 @@ intros x; case x; simpl ww_is_even. rewrite add_mult_div_2. replace (wB + [|w0|]) with ([|b|] + ([|w0|] - [|b|] + wB)); auto with zarith. - rewrite Zmult_plus_distr_l; rewrite <- Zplus_assoc. + rewrite Z.mul_add_distr_r; rewrite <- Z.add_assoc. rewrite Hw1. pattern [|w2|] at 1; rewrite (Z_div_mod_eq [|w2|] 2); auto with zarith. @@ -631,7 +630,7 @@ intros x; case x; simpl ww_is_even. rewrite add_mult_div_2. replace (wB + [|w0|]) with ([|b|] + ([|w0|] - [|b|] + wB)); auto with zarith. - rewrite Zmult_plus_distr_l; rewrite <- Zplus_assoc. + rewrite Z.mul_add_distr_r; rewrite <- Z.add_assoc. rewrite Hw1. pattern [|w2|] at 1; rewrite (Z_div_mod_eq [|w2|] 2); auto with zarith. @@ -652,20 +651,20 @@ intros x; case x; simpl ww_is_even. rewrite <- Zpower_exp; auto with zarith. f_equal; auto with zarith. rewrite H. - rewrite (fun x => (Zmult_comm 4 (2 ^x))). + rewrite (fun x => (Z.mul_comm 4 (2 ^x))). rewrite Z_div_mult; auto with zarith. Qed. Theorem Zsquare_mult: forall p, p ^ 2 = p * p. intros p; change 2 with (1 + 1); rewrite Zpower_exp; - try rewrite Zpower_1_r; auto with zarith. + try rewrite Z.pow_1_r; auto with zarith. Qed. Theorem Zsquare_pos: forall p, 0 <= p ^ 2. - intros p; case (Zle_or_lt 0 p); intros H1. - rewrite Zsquare_mult; apply Zmult_le_0_compat; auto with zarith. + intros p; case (Z.le_gt_cases 0 p); intros H1. + rewrite Zsquare_mult; apply Z.mul_nonneg_nonneg; auto with zarith. rewrite Zsquare_mult; replace (p * p) with ((- p) * (- p)); try ring. - apply Zmult_le_0_compat; auto with zarith. + apply Z.mul_nonneg_nonneg; auto with zarith. Qed. Lemma spec_split: forall x, @@ -676,13 +675,12 @@ intros x; case x; simpl ww_is_even. Theorem mult_wwB: forall x y, [|x|] * [|y|] < wwB. Proof. - intros x y; rewrite wwB_wBwB; rewrite Zpower_2. + intros x y; rewrite wwB_wBwB; rewrite Z.pow_2_r. generalize (spec_to_Z x); intros U. generalize (spec_to_Z y); intros U1. - apply Zle_lt_trans with ((wB -1 ) * (wB - 1)); auto with zarith. - apply Zmult_le_compat; auto with zarith. - repeat (rewrite Zmult_minus_distr_r || rewrite Zmult_minus_distr_l); - auto with zarith. + apply Z.le_lt_trans with ((wB -1 ) * (wB - 1)); auto with zarith. + apply Z.mul_le_mono_nonneg; auto with zarith. + rewrite ?Z.mul_sub_distr_l, ?Z.mul_sub_distr_r; auto with zarith. Qed. Hint Resolve mult_wwB. @@ -697,22 +695,22 @@ intros x; case x; simpl ww_is_even. end; simpl fst; simpl snd. intros w0 w1 Hw0 w2 w3 Hw1. assert (U: wB/4 <= [|w2|]). - case (Zle_or_lt (wB / 4) [|w2|]); auto; intros H1. - contradict H; apply Zlt_not_le. - rewrite wwB_wBwB; rewrite Zpower_2. - pattern wB at 1; rewrite <- wB_div_4; rewrite <- Zmult_assoc; - rewrite Zmult_comm. + case (Z.le_gt_cases (wB / 4) [|w2|]); auto; intros H1. + contradict H; apply Z.lt_nge. + rewrite wwB_wBwB; rewrite Z.pow_2_r. + pattern wB at 1; rewrite <- wB_div_4; rewrite <- Z.mul_assoc; + rewrite Z.mul_comm. rewrite Z_div_mult; auto with zarith. rewrite <- Hw1. match goal with |- _ < ?X => - pattern X; rewrite <- Zplus_0_r; apply beta_lex_inv; + pattern X; rewrite <- Z.add_0_r; apply beta_lex_inv; auto with zarith end. destruct (spec_to_Z w3);auto with zarith. generalize (@spec_w_sqrt2 w2 w3 U); case (w_sqrt2 w2 w3). intros w4 c (H1, H2). assert (U1: wB/2 <= [|w4|]). - case (Zle_or_lt (wB/2) [|w4|]); auto with zarith. + case (Z.le_gt_cases (wB/2) [|w4|]); auto with zarith. intros U1. assert (U2 : [|w4|] <= wB/2 -1); auto with zarith. assert (U3 : [|w4|] ^ 2 <= wB/4 * wB - wB + 1); auto with zarith. @@ -720,19 +718,19 @@ intros x; case x; simpl ww_is_even. rewrite Zsquare_mult; replace Y with ((wB/2 - 1) * (wB/2 -1)) end. - apply Zmult_le_compat; auto with zarith. + apply Z.mul_le_mono_nonneg; auto with zarith. destruct (spec_to_Z w4);auto with zarith. destruct (spec_to_Z w4);auto with zarith. pattern wB at 4 5; rewrite <- wB_div_2. - rewrite Zmult_assoc. + rewrite Z.mul_assoc. replace ((wB / 4) * 2) with (wB / 2). ring. pattern wB at 1; rewrite <- wB_div_4. change 4 with (2 * 2). - rewrite <- Zmult_assoc; rewrite (Zmult_comm 2). + rewrite <- Z.mul_assoc; rewrite (Z.mul_comm 2). rewrite Z_div_mult; try ring; auto with zarith. assert (U4 : [+|c|] <= wB -2); auto with zarith. - apply Zle_trans with (1 := H2). + apply Z.le_trans with (1 := H2). match goal with |- ?X <= ?Y => replace Y with (2 * (wB/ 2 - 1)); auto with zarith end. @@ -741,10 +739,10 @@ intros x; case x; simpl ww_is_even. assert (U5: X < wB / 4 * wB) end. rewrite H1; auto with zarith. - contradict U; apply Zlt_not_le. - apply Zmult_lt_reg_r with wB; auto with zarith. + contradict U; apply Z.lt_nge. + apply Z.mul_lt_mono_pos_r with wB; auto with zarith. destruct (spec_to_Z w4);auto with zarith. - apply Zle_lt_trans with (2 := U5). + apply Z.le_lt_trans with (2 := U5). unfold ww_to_Z, zn2z_to_Z. destruct (spec_to_Z w3);auto with zarith. generalize (@spec_w_div2s c w0 w4 U1 H2). @@ -766,7 +764,7 @@ intros x; case x; simpl ww_is_even. unfold ww_to_Z, zn2z_to_Z in H1; rewrite H1. rewrite <- Hw0. match goal with |- (?X ^2 + ?Y) * wwB + (?Z * wB + ?T) = ?U => - apply trans_equal with ((X * wB) ^ 2 + (Y * wB + Z) * wB + T) + transitivity ((X * wB) ^ 2 + (Y * wB + Z) * wB + T) end. repeat rewrite Zsquare_mult. rewrite wwB_wBwB; ring. @@ -779,17 +777,17 @@ intros x; case x; simpl ww_is_even. match goal with |- ?X - ?Y * ?Y <= _ => assert (V := Zsquare_pos Y); rewrite Zsquare_mult in V; - apply Zle_trans with X; auto with zarith; + apply Z.le_trans with X; auto with zarith; clear V end. match goal with |- ?X * wB + ?Y <= 2 * (?Z * wB + ?T) => - apply Zle_trans with ((2 * Z - 1) * wB + wB); auto with zarith + apply Z.le_trans with ((2 * Z - 1) * wB + wB); auto with zarith end. destruct (spec_to_Z w1);auto with zarith. match goal with |- ?X <= _ => replace X with (2 * [|w4|] * wB); auto with zarith end. - rewrite Zmult_plus_distr_r; rewrite Zmult_assoc. + rewrite Z.mul_add_distr_l; rewrite Z.mul_assoc. destruct (spec_to_Z w5); auto with zarith. ring. intros z; replace [-[C1 z]] with (- wwB + [[z]]). @@ -815,7 +813,7 @@ intros x; case x; simpl ww_is_even. unfold ww_to_Z, zn2z_to_Z in H1; rewrite H1. rewrite <- Hw0. match goal with |- (?X ^2 + ?Y) * wwB + (?Z * wB + ?T) = ?U => - apply trans_equal with ((X * wB) ^ 2 + (Y * wB + Z) * wB + T) + transitivity ((X * wB) ^ 2 + (Y * wB + Z) * wB + T) end. repeat rewrite Zsquare_mult. rewrite wwB_wBwB; ring. @@ -828,11 +826,11 @@ intros x; case x; simpl ww_is_even. destruct (spec_ww_to_Z w_digits w_to_Z spec_to_Z z);auto with zarith. assert (V1 := spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW w4 w5)). assert (0 < [[WW w4 w5]]); auto with zarith. - apply Zlt_le_trans with (wB/ 2 * wB + 0); auto with zarith. - autorewrite with rm10; apply Zmult_lt_0_compat; auto with zarith. - apply Zmult_lt_reg_r with 2; auto with zarith. + apply Z.lt_le_trans with (wB/ 2 * wB + 0); auto with zarith. + autorewrite with rm10; apply Z.mul_pos_pos; auto with zarith. + apply Z.mul_lt_mono_pos_r with 2; auto with zarith. autorewrite with rm10. - rewrite Zmult_comm; rewrite wB_div_2; auto with zarith. + rewrite Z.mul_comm; rewrite wB_div_2; auto with zarith. case (spec_to_Z w5);auto with zarith. case (spec_to_Z w5);auto with zarith. simpl. @@ -840,11 +838,11 @@ intros x; case x; simpl ww_is_even. assert (V1 := spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW w4 w5)); auto with zarith. split; auto with zarith. assert (wwB <= 2 * [[WW w4 w5]]); auto with zarith. - apply Zle_trans with (2 * ([|w4|] * wB)). - rewrite wwB_wBwB; rewrite Zpower_2. - rewrite Zmult_assoc; apply Zmult_le_compat_r; auto with zarith. - rewrite <- wB_div_2; auto with zarith. + apply Z.le_trans with (2 * ([|w4|] * wB)). + rewrite wwB_wBwB; rewrite Z.pow_2_r. + rewrite Z.mul_assoc; apply Z.mul_le_mono_nonneg_r; auto with zarith. assert (V2 := spec_to_Z w5);auto with zarith. + rewrite <- wB_div_2; auto with zarith. simpl ww_to_Z; assert (V2 := spec_to_Z w5);auto with zarith. assert (V1 := spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW w4 w5)); auto with zarith. intros z1; change [-[C1 z1]] with (-wwB + [[z1]]). @@ -856,21 +854,21 @@ intros x; case x; simpl ww_is_even. rewrite ww_add_mult_mult_2. rename V1 into VV1. assert (VV2: 0 < [[WW w4 w5]]); auto with zarith. - apply Zlt_le_trans with (wB/ 2 * wB + 0); auto with zarith. - autorewrite with rm10; apply Zmult_lt_0_compat; auto with zarith. - apply Zmult_lt_reg_r with 2; auto with zarith. + apply Z.lt_le_trans with (wB/ 2 * wB + 0); auto with zarith. + autorewrite with rm10; apply Z.mul_pos_pos; auto with zarith. + apply Z.mul_lt_mono_pos_r with 2; auto with zarith. autorewrite with rm10. - rewrite Zmult_comm; rewrite wB_div_2; auto with zarith. + rewrite Z.mul_comm; rewrite wB_div_2; auto with zarith. assert (VV3 := spec_to_Z w5);auto with zarith. assert (VV3 := spec_to_Z w5);auto with zarith. simpl. assert (VV3 := spec_to_Z w5);auto with zarith. assert (VV3: wwB <= 2 * [[WW w4 w5]]); auto with zarith. - apply Zle_trans with (2 * ([|w4|] * wB)). - rewrite wwB_wBwB; rewrite Zpower_2. - rewrite Zmult_assoc; apply Zmult_le_compat_r; auto with zarith. - rewrite <- wB_div_2; auto with zarith. + apply Z.le_trans with (2 * ([|w4|] * wB)). + rewrite wwB_wBwB; rewrite Z.pow_2_r. + rewrite Z.mul_assoc; apply Z.mul_le_mono_nonneg_r; auto with zarith. case (spec_to_Z w5);auto with zarith. + rewrite <- wB_div_2; auto with zarith. simpl ww_to_Z; assert (V4 := spec_to_Z w5);auto with zarith. rewrite <- Zmod_unique with (q := 1) (r := -wwB + 2 * [[WW w4 w5]]); auto with zarith. @@ -892,7 +890,7 @@ intros x; case x; simpl ww_is_even. rewrite <- Hw0. split. match goal with |- (?X ^2 + ?Y) * wwB + (?Z * wB + ?T) = ?U => - apply trans_equal with ((X * wB) ^ 2 + (Y * wB + Z) * wB + T) + transitivity ((X * wB) ^ 2 + (Y * wB + Z) * wB + T) end. repeat rewrite Zsquare_mult. rewrite wwB_wBwB; ring. @@ -905,17 +903,17 @@ intros x; case x; simpl ww_is_even. assert (V2 := spec_ww_to_Z w_digits w_to_Z spec_to_Z z);auto with zarith. assert (V3 := spec_ww_to_Z w_digits w_to_Z spec_to_Z z1);auto with zarith. split; auto with zarith. - rewrite (Zplus_comm (-wwB)); rewrite <- Zplus_assoc. + rewrite (Z.add_comm (-wwB)); rewrite <- Z.add_assoc. rewrite H5. match goal with |- 0 <= ?X + (?Y - ?Z) => - apply Zle_trans with (X - Z); auto with zarith + apply Z.le_trans with (X - Z); auto with zarith end. 2: generalize (spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW w6 w1)); unfold ww_to_Z; auto with zarith. rewrite V1. match goal with |- 0 <= ?X - 1 - ?Y => assert (Y < X); auto with zarith end. - apply Zlt_le_trans with wwB; auto with zarith. + apply Z.lt_le_trans with wwB; auto with zarith. intros (H3, H4). match goal with |- context [ww_sub_c ?y ?z] => generalize (spec_ww_sub_c y z); case (ww_sub_c y z) @@ -933,7 +931,7 @@ intros x; case x; simpl ww_is_even. unfold ww_to_Z, zn2z_to_Z in H1; rewrite H1. rewrite <- Hw0. match goal with |- (?X ^2 + ?Y) * wwB + (?Z * wB + ?T) = ?U => - apply trans_equal with ((X * wB) ^ 2 + (Y * wB + Z) * wB + T) + transitivity ((X * wB) ^ 2 + (Y * wB + Z) * wB + T) end. repeat rewrite Zsquare_mult. rewrite wwB_wBwB; ring. @@ -945,27 +943,27 @@ intros x; case x; simpl ww_is_even. simpl ww_to_Z. rewrite H5. simpl ww_to_Z. - rewrite wwB_wBwB; rewrite Zpower_2. + rewrite wwB_wBwB; rewrite Z.pow_2_r. match goal with |- ?X * ?Y + (?Z * ?Y + ?T - ?U) <= _ => - apply Zle_trans with (X * Y + (Z * Y + T - 0)); + apply Z.le_trans with (X * Y + (Z * Y + T - 0)); auto with zarith end. assert (V := Zsquare_pos [|w5|]); rewrite Zsquare_mult in V; auto with zarith. autorewrite with rm10. match goal with |- _ <= 2 * (?U * ?V + ?W) => - apply Zle_trans with (2 * U * V + 0); + apply Z.le_trans with (2 * U * V + 0); auto with zarith end. match goal with |- ?X * ?Y + (?Z * ?Y + ?T) <= _ => replace (X * Y + (Z * Y + T)) with ((X + Z) * Y + T); try ring end. - apply Zlt_le_weak; apply beta_lex_inv; auto with zarith. + apply Z.lt_le_incl; apply beta_lex_inv; auto with zarith. destruct (spec_to_Z w1);auto with zarith. destruct (spec_to_Z w5);auto with zarith. - rewrite Zmult_plus_distr_r; auto with zarith. - rewrite Zmult_assoc; auto with zarith. + rewrite Z.mul_add_distr_l; auto with zarith. + rewrite Z.mul_assoc; auto with zarith. intros z; replace [-[C1 z]] with (- wwB + [[z]]). 2: simpl; case wwB; auto with zarith. intros H5; rewrite spec_w_square_c in H5; @@ -984,7 +982,7 @@ intros x; case x; simpl ww_is_even. rewrite <- Hw0. split. match goal with |- (?X ^2 + ?Y) * wwB + (?Z * wB + ?T) = ?U => - apply trans_equal with ((X * wB) ^ 2 + (Y * wB + Z) * wB + T) + transitivity ((X * wB) ^ 2 + (Y * wB + Z) * wB + T) end. repeat rewrite Zsquare_mult. rewrite wwB_wBwB; ring. @@ -995,40 +993,38 @@ intros x; case x; simpl ww_is_even. repeat rewrite Zsquare_mult; ring. rewrite V. simpl ww_to_Z. - rewrite wwB_wBwB; rewrite Zpower_2. + rewrite wwB_wBwB; rewrite Z.pow_2_r. match goal with |- (?Z * ?Y + ?T - ?U) + ?X * ?Y <= _ => - apply Zle_trans with ((Z * Y + T - 0) + X * Y); + apply Z.le_trans with ((Z * Y + T - 0) + X * Y); auto with zarith end. assert (V1 := Zsquare_pos [|w5|]); rewrite Zsquare_mult in V1; auto with zarith. autorewrite with rm10. match goal with |- _ <= 2 * (?U * ?V + ?W) => - apply Zle_trans with (2 * U * V + 0); + apply Z.le_trans with (2 * U * V + 0); auto with zarith end. match goal with |- (?Z * ?Y + ?T) + ?X * ?Y <= _ => replace ((Z * Y + T) + X * Y) with ((X + Z) * Y + T); try ring end. - apply Zlt_le_weak; apply beta_lex_inv; auto with zarith. + apply Z.lt_le_incl; apply beta_lex_inv; auto with zarith. destruct (spec_to_Z w1);auto with zarith. destruct (spec_to_Z w5);auto with zarith. - rewrite Zmult_plus_distr_r; auto with zarith. - rewrite Zmult_assoc; auto with zarith. - case Zle_lt_or_eq with (1 := H2); clear H2; intros H2. + rewrite Z.mul_add_distr_l; auto with zarith. + rewrite Z.mul_assoc; auto with zarith. + Z.le_elim H2. intros c1 (H3, H4). - match type of H3 with ?X = ?Y => - absurd (X < Y) - end. - apply Zle_not_lt; rewrite <- H3; auto with zarith. - rewrite Zmult_plus_distr_l. - apply Zlt_le_trans with ((2 * [|w4|]) * wB + 0); + match type of H3 with ?X = ?Y => absurd (X < Y) end. + apply Z.le_ngt; rewrite <- H3; auto with zarith. + rewrite Z.mul_add_distr_r. + apply Z.lt_le_trans with ((2 * [|w4|]) * wB + 0); auto with zarith. apply beta_lex_inv; auto with zarith. destruct (spec_to_Z w0);auto with zarith. assert (V1 := spec_to_Z w5);auto with zarith. - rewrite (Zmult_comm wB); auto with zarith. + rewrite (Z.mul_comm wB); auto with zarith. assert (0 <= [|w5|] * (2 * [|w4|])); auto with zarith. intros c1 (H3, H4); rewrite H2 in H3. match type of H3 with ?X + ?Y = (?Z + ?T) * ?U + ?V => @@ -1038,20 +1034,19 @@ intros x; case x; simpl ww_is_even. end. assert (V1 := spec_to_Z w0);auto with zarith. assert (V2 := spec_to_Z w5);auto with zarith. - case (Zle_lt_or_eq 0 [|w5|]); auto with zarith; intros V3. - match type of VV with ?X = ?Y => - absurd (X < Y) - end. - apply Zle_not_lt; rewrite <- VV; auto with zarith. - apply Zlt_le_trans with wB; auto with zarith. + case V2; intros V3 _. + Z.le_elim V3; auto with zarith. + match type of VV with ?X = ?Y => absurd (X < Y) end. + apply Z.le_ngt; rewrite <- VV; auto with zarith. + apply Z.lt_le_trans with wB; auto with zarith. match goal with |- _ <= ?X + _ => - apply Zle_trans with X; auto with zarith + apply Z.le_trans with X; auto with zarith end. match goal with |- _ <= _ * ?X => - apply Zle_trans with (1 * X); auto with zarith + apply Z.le_trans with (1 * X); auto with zarith end. autorewrite with rm10. - rewrite <- wB_div_2; apply Zmult_le_compat_l; auto with zarith. + rewrite <- wB_div_2; apply Z.mul_le_mono_nonneg_l; auto with zarith. rewrite <- V3 in VV; generalize VV; autorewrite with rm10; clear VV; intros VV. rewrite spec_ww_add_c; auto with zarith. @@ -1067,7 +1062,7 @@ intros x; case x; simpl ww_is_even. simpl ww_to_Z in H1; rewrite H1. rewrite <- Hw0. match goal with |- (?X ^2 + ?Y) * wwB + (?Z * wB + ?T) = ?U => - apply trans_equal with ((X * wB) ^ 2 + (Y * wB + Z) * wB + T) + transitivity ((X * wB) ^ 2 + (Y * wB + Z) * wB + T) end. repeat rewrite Zsquare_mult. rewrite wwB_wBwB; ring. @@ -1079,41 +1074,41 @@ intros x; case x; simpl ww_is_even. simpl ww_to_Z; unfold ww_to_Z. rewrite spec_w_Bm1; auto with zarith. split. - rewrite wwB_wBwB; rewrite Zpower_2. + rewrite wwB_wBwB; rewrite Z.pow_2_r. match goal with |- _ <= -?X + (2 * (?Z * ?T + ?U) + ?V) => assert (X <= 2 * Z * T); auto with zarith end. - apply Zmult_le_compat_r; auto with zarith. - rewrite <- wB_div_2; apply Zmult_le_compat_l; auto with zarith. - rewrite Zmult_plus_distr_r; auto with zarith. - rewrite Zmult_assoc; auto with zarith. + apply Z.mul_le_mono_nonneg_r; auto with zarith. + rewrite <- wB_div_2; apply Z.mul_le_mono_nonneg_l; auto with zarith. + rewrite Z.mul_add_distr_l; auto with zarith. + rewrite Z.mul_assoc; auto with zarith. match goal with |- _ + ?X < _ => replace X with ((2 * (([|w4|]) + 1) * wB) - 1); try ring end. assert (2 * ([|w4|] + 1) * wB <= 2 * wwB); auto with zarith. - rewrite <- Zmult_assoc; apply Zmult_le_compat_l; auto with zarith. - rewrite wwB_wBwB; rewrite Zpower_2. - apply Zmult_le_compat_r; auto with zarith. + rewrite <- Z.mul_assoc; apply Z.mul_le_mono_nonneg_l; auto with zarith. + rewrite wwB_wBwB; rewrite Z.pow_2_r. + apply Z.mul_le_mono_nonneg_r; auto with zarith. case (spec_to_Z w4);auto with zarith. Qed. Lemma spec_ww_is_zero: forall x, if ww_is_zero x then [[x]] = 0 else 0 < [[x]]. intro x; unfold ww_is_zero. - rewrite spec_ww_compare. case Zcompare_spec; + rewrite spec_ww_compare. case Z.compare_spec; auto with zarith. simpl ww_to_Z. assert (V4 := spec_ww_to_Z w_digits w_to_Z spec_to_Z x);auto with zarith. Qed. Lemma wwB_4_2: 2 * (wwB / 4) = wwB/ 2. - pattern wwB at 1; rewrite wwB_wBwB; rewrite Zpower_2. + pattern wwB at 1; rewrite wwB_wBwB; rewrite Z.pow_2_r. rewrite <- wB_div_2. match goal with |- context[(2 * ?X) * (2 * ?Z)] => replace ((2 * X) * (2 * Z)) with ((X * Z) * 4); try ring end. rewrite Z_div_mult; auto with zarith. - rewrite Zmult_assoc; rewrite wB_div_2. + rewrite Z.mul_assoc; rewrite wB_div_2. rewrite wwB_div_2; ring. Qed. @@ -1129,10 +1124,10 @@ Qed. intros H2. generalize (spec_ww_head0 x H2); case (ww_head0 x); autorewrite with rm10. intros (H3, H4); split; auto with zarith. - apply Zle_trans with (2 := H3). + apply Z.le_trans with (2 := H3). apply Zdiv_le_compat_l; auto with zarith. intros xh xl (H3, H4); split; auto with zarith. - apply Zle_trans with (2 := H3). + apply Z.le_trans with (2 := H3). apply Zdiv_le_compat_l; auto with zarith. intros H1. case (spec_to_w_Z (ww_head0 x)); intros Hv1 Hv2. @@ -1156,24 +1151,24 @@ Qed. case (spec_ww_head0 x); auto; intros Hv3 Hv4. assert (Hu: forall u, 0 < u -> 2 * 2 ^ (u - 1) = 2 ^u). intros u Hu. - pattern 2 at 1; rewrite <- Zpower_1_r. + pattern 2 at 1; rewrite <- Z.pow_1_r. rewrite <- Zpower_exp; auto with zarith. ring_simplify (1 + (u - 1)); auto with zarith. split; auto with zarith. - apply Zmult_le_reg_r with 2; auto with zarith. - repeat rewrite (fun x => Zmult_comm x 2). + apply Z.mul_le_mono_pos_r with 2; auto with zarith. + repeat rewrite (fun x => Z.mul_comm x 2). rewrite wwB_4_2. - rewrite Zmult_assoc; rewrite Hu; auto with zarith. - apply Zle_lt_trans with (2 * 2 ^ ([[ww_head0 x]] - 1) * [[x]]); auto with zarith; + rewrite Z.mul_assoc; rewrite Hu; auto with zarith. + apply Z.le_lt_trans with (2 * 2 ^ ([[ww_head0 x]] - 1) * [[x]]); auto with zarith; rewrite Hu; auto with zarith. - apply Zmult_le_compat_r; auto with zarith. + apply Z.mul_le_mono_nonneg_r; auto with zarith. apply Zpower_le_monotone; auto with zarith. Qed. Theorem wwB_4_wB_4: wwB / 4 = wB / 4 * wB. - apply sym_equal; apply Zdiv_unique with 0; - auto with zarith. - rewrite Zmult_assoc; rewrite wB_div_4; auto with zarith. + Proof. + symmetry; apply Zdiv_unique with 0; auto with zarith. + rewrite Z.mul_assoc; rewrite wB_div_4; auto with zarith. rewrite wwB_wBwB; ring. Qed. @@ -1182,10 +1177,10 @@ Qed. assert (U := wB_pos w_digits). intro x; unfold ww_sqrt. generalize (spec_ww_is_zero x); case (ww_is_zero x). - simpl ww_to_Z; simpl Zpower; unfold Zpower_pos; simpl; + simpl ww_to_Z; simpl Z.pow; unfold Z.pow_pos; simpl; auto with zarith. intros H1. - rewrite spec_ww_compare. case Zcompare_spec; + rewrite spec_ww_compare. case Z.compare_spec; simpl ww_to_Z; autorewrite with rm10. generalize H1; case x. intros HH; contradict HH; simpl ww_to_Z; auto with zarith. @@ -1203,7 +1198,7 @@ Qed. intros w3 (H6, H7); rewrite H6. assert (V1 := spec_to_Z w3);auto with zarith. split; auto with zarith. - apply Zle_lt_trans with ([|w2|] ^2 + 2 * [|w2|]); auto with zarith. + apply Z.le_lt_trans with ([|w2|] ^2 + 2 * [|w2|]); auto with zarith. match goal with |- ?X < ?Z => replace Z with (X + 1); auto with zarith end. @@ -1211,7 +1206,7 @@ Qed. intros w3 (H6, H7); rewrite H6. assert (V1 := spec_to_Z w3);auto with zarith. split; auto with zarith. - apply Zle_lt_trans with ([|w2|] ^2 + 2 * [|w2|]); auto with zarith. + apply Z.le_lt_trans with ([|w2|] ^2 + 2 * [|w2|]); auto with zarith. match goal with |- ?X < ?Z => replace Z with (X + 1); auto with zarith end. @@ -1221,42 +1216,42 @@ Qed. case (spec_ww_head1 x); intros Hp1 Hp2. generalize (Hp2 H1); clear Hp2; intros Hp2. assert (Hv2: [[ww_head1 x]] <= Zpos (xO w_digits)). - case (Zle_or_lt (Zpos (xO w_digits)) [[ww_head1 x]]); auto with zarith; intros HH1. + case (Z.le_gt_cases (Zpos (xO w_digits)) [[ww_head1 x]]); auto with zarith; intros HH1. case Hp2; intros _ HH2; contradict HH2. - apply Zle_not_lt; unfold base. - apply Zle_trans with (2 ^ [[ww_head1 x]]). + apply Z.le_ngt; unfold base. + apply Z.le_trans with (2 ^ [[ww_head1 x]]). apply Zpower_le_monotone; auto with zarith. pattern (2 ^ [[ww_head1 x]]) at 1; - rewrite <- (Zmult_1_r (2 ^ [[ww_head1 x]])). - apply Zmult_le_compat_l; auto with zarith. + rewrite <- (Z.mul_1_r (2 ^ [[ww_head1 x]])). + apply Z.mul_le_mono_nonneg_l; auto with zarith. generalize (spec_ww_add_mul_div x W0 (ww_head1 x) Hv2); case ww_add_mul_div. simpl ww_to_Z; autorewrite with w_rewrite rm10. rewrite Zmod_small; auto with zarith. - intros H2; case (Zmult_integral _ _ (sym_equal H2)); clear H2; intros H2. - rewrite H2; unfold Zpower, Zpower_pos; simpl; auto with zarith. + intros H2. symmetry in H2. rewrite Z.mul_eq_0 in H2. destruct H2 as [H2|H2]. + rewrite H2; unfold Z.pow, Z.pow_pos; simpl; auto with zarith. match type of H2 with ?X = ?Y => absurd (Y < X); try (rewrite H2; auto with zarith; fail) end. - apply Zpower_gt_0; auto with zarith. + apply Z.pow_pos_nonneg; auto with zarith. split; auto with zarith. - case Hp2; intros _ tmp; apply Zle_lt_trans with (2 := tmp); + case Hp2; intros _ tmp; apply Z.le_lt_trans with (2 := tmp); clear tmp. - rewrite Zmult_comm; apply Zmult_le_compat_r; auto with zarith. + rewrite Z.mul_comm; apply Z.mul_le_mono_nonneg_r; auto with zarith. assert (Hv0: [[ww_head1 x]] = 2 * ([[ww_head1 x]]/2)). pattern [[ww_head1 x]] at 1; rewrite (Z_div_mod_eq [[ww_head1 x]] 2); auto with zarith. generalize (spec_ww_is_even (ww_head1 x)); rewrite Hp1; - intros tmp; rewrite tmp; rewrite Zplus_0_r; auto. + intros tmp; rewrite tmp; rewrite Z.add_0_r; auto. intros w0 w1; autorewrite with w_rewrite rm10. rewrite Zmod_small; auto with zarith. - 2: rewrite Zmult_comm; auto with zarith. + 2: rewrite Z.mul_comm; auto with zarith. intros H2. assert (V: wB/4 <= [|w0|]). apply beta_lex with 0 [|w1|] wB; auto with zarith; autorewrite with rm10. simpl ww_to_Z in H2; rewrite H2. rewrite <- wwB_4_wB_4; auto with zarith. - rewrite Zmult_comm; auto with zarith. + rewrite Z.mul_comm; auto with zarith. assert (V1 := spec_to_Z w1);auto with zarith. generalize (@spec_w_sqrt2 w0 w1 V);auto with zarith. case (w_sqrt2 w0 w1); intros w2 c. @@ -1267,13 +1262,13 @@ Qed. rewrite spec_ww_pred; rewrite spec_ww_zdigits. rewrite Zmod_small; auto with zarith. split; auto with zarith. - apply Zlt_le_trans with (Zpos (xO w_digits)); auto with zarith. + apply Z.lt_le_trans with (Zpos (xO w_digits)); auto with zarith. unfold base; apply Zpower2_le_lin; auto with zarith. assert (Hv4: [[ww_head1 x]]/2 < wB). - apply Zle_lt_trans with (Zpos w_digits). - apply Zmult_le_reg_r with 2; auto with zarith. - repeat rewrite (fun x => Zmult_comm x 2). - rewrite <- Hv0; rewrite <- Zpos_xO; auto. + apply Z.le_lt_trans with (Zpos w_digits). + apply Z.mul_le_mono_pos_r with 2; auto with zarith. + repeat rewrite (fun x => Z.mul_comm x 2). + rewrite <- Hv0; rewrite <- Pos2Z.inj_xO; auto. unfold base; apply Zpower2_lt_lin; auto with zarith. assert (Hv5: [[(ww_add_mul_div (ww_pred ww_zdigits) W0 (ww_head1 x))]] = [[ww_head1 x]]/2). @@ -1281,12 +1276,12 @@ Qed. simpl ww_to_Z; autorewrite with rm10. rewrite Hv3. ring_simplify (Zpos (xO w_digits) - (Zpos (xO w_digits) - 1)). - rewrite Zpower_1_r. + rewrite Z.pow_1_r. rewrite Zmod_small; auto with zarith. split; auto with zarith. - apply Zlt_le_trans with (1 := Hv4); auto with zarith. + apply Z.lt_le_trans with (1 := Hv4); auto with zarith. unfold base; apply Zpower_le_monotone; auto with zarith. - split; unfold ww_digits; try rewrite Zpos_xO; auto with zarith. + split; unfold ww_digits; try rewrite Pos2Z.inj_xO; auto with zarith. rewrite Hv3; auto with zarith. assert (Hv6: [|low(ww_add_mul_div (ww_pred ww_zdigits) W0 (ww_head1 x))|] = [[ww_head1 x]]/2). @@ -1302,13 +1297,13 @@ Qed. rewrite Zmod_small. simpl ww_to_Z in H2; rewrite H2; auto with zarith. intros (H4, H5); split. - apply Zmult_le_reg_r with (2 ^ [[ww_head1 x]]); auto with zarith. + apply Z.mul_le_mono_pos_r with (2 ^ [[ww_head1 x]]); auto with zarith. rewrite H4. - apply Zle_trans with ([|w2|] ^ 2); auto with zarith. - rewrite Zmult_comm. + apply Z.le_trans with ([|w2|] ^ 2); auto with zarith. + rewrite Z.mul_comm. pattern [[ww_head1 x]] at 1; rewrite Hv0; auto with zarith. - rewrite (Zmult_comm 2); rewrite Zpower_mult; + rewrite (Z.mul_comm 2); rewrite Z.pow_mul_r; auto with zarith. assert (tmp: forall p q, p ^ 2 * q ^ 2 = (p * q) ^2); try (intros; repeat rewrite Zsquare_mult; ring); @@ -1324,17 +1319,17 @@ Qed. case (Z_mod_lt [|w2|] (2 ^ ([[ww_head1 x]] / 2))); auto with zarith. case c; unfold interp_carry; autorewrite with rm10; intros w3; assert (V3 := spec_to_Z w3);auto with zarith. - apply Zmult_lt_reg_r with (2 ^ [[ww_head1 x]]); auto with zarith. + apply Z.mul_lt_mono_pos_r with (2 ^ [[ww_head1 x]]); auto with zarith. rewrite H4. - apply Zle_lt_trans with ([|w2|] ^ 2 + 2 * [|w2|]); auto with zarith. - apply Zlt_le_trans with (([|w2|] + 1) ^ 2); auto with zarith. + apply Z.le_lt_trans with ([|w2|] ^ 2 + 2 * [|w2|]); auto with zarith. + apply Z.lt_le_trans with (([|w2|] + 1) ^ 2); auto with zarith. match goal with |- ?X < ?Y => replace Y with (X + 1); auto with zarith end. repeat rewrite (Zsquare_mult); ring. - rewrite Zmult_comm. + rewrite Z.mul_comm. pattern [[ww_head1 x]] at 1; rewrite Hv0. - rewrite (Zmult_comm 2); rewrite Zpower_mult; + rewrite (Z.mul_comm 2); rewrite Z.pow_mul_r; auto with zarith. assert (tmp: forall p q, p ^ 2 * q ^ 2 = (p * q) ^2); try (intros; repeat rewrite Zsquare_mult; ring); @@ -1343,20 +1338,20 @@ Qed. split; auto with zarith. pattern [|w2|] at 1; rewrite (Z_div_mod_eq [|w2|] (2 ^ ([[ww_head1 x]]/2))); auto with zarith. - rewrite <- Zplus_assoc; rewrite Zmult_plus_distr_r. - autorewrite with rm10; apply Zplus_le_compat_l; auto with zarith. + rewrite <- Z.add_assoc; rewrite Z.mul_add_distr_l. + autorewrite with rm10; apply Z.add_le_mono_l; auto with zarith. case (Z_mod_lt [|w2|] (2 ^ ([[ww_head1 x]]/2))); auto with zarith. split; auto with zarith. - apply Zle_lt_trans with ([|w2|]); auto with zarith. + apply Z.le_lt_trans with ([|w2|]); auto with zarith. apply Zdiv_le_upper_bound; auto with zarith. pattern [|w2|] at 1; replace [|w2|] with ([|w2|] * 2 ^0); auto with zarith. - apply Zmult_le_compat_l; auto with zarith. + apply Z.mul_le_mono_nonneg_l; auto with zarith. apply Zpower_le_monotone; auto with zarith. - rewrite Zpower_0_r; autorewrite with rm10; auto. + rewrite Z.pow_0_r; autorewrite with rm10; auto. split; auto with zarith. - rewrite Hv0 in Hv2; rewrite (Zpos_xO w_digits) in Hv2; auto with zarith. - apply Zle_lt_trans with (Zpos w_digits); auto with zarith. + rewrite Hv0 in Hv2; rewrite (Pos2Z.inj_xO w_digits) in Hv2; auto with zarith. + apply Z.le_lt_trans with (Zpos w_digits); auto with zarith. unfold base; apply Zpower2_lt_lin; auto with zarith. rewrite spec_w_sub; auto with zarith. rewrite Hv6; rewrite spec_w_zdigits; auto with zarith. @@ -1364,10 +1359,10 @@ Qed. rewrite Zmod_small; auto with zarith. split; auto with zarith. assert ([[ww_head1 x]]/2 <= Zpos w_digits); auto with zarith. - apply Zmult_le_reg_r with 2; auto with zarith. - repeat rewrite (fun x => Zmult_comm x 2). - rewrite <- Hv0; rewrite <- Zpos_xO; auto with zarith. - apply Zle_lt_trans with (Zpos w_digits); auto with zarith. + apply Z.mul_le_mono_pos_r with 2; auto with zarith. + repeat rewrite (fun x => Z.mul_comm x 2). + rewrite <- Hv0; rewrite <- Pos2Z.inj_xO; auto with zarith. + apply Z.le_lt_trans with (Zpos w_digits); auto with zarith. unfold base; apply Zpower2_lt_lin; auto with zarith. Qed. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleSub.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleSub.v index e63e20c6..799c4e42 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleSub.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleSub.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -195,9 +195,9 @@ Section DoubleSub. Lemma spec_ww_opp_c : forall x, [-[ww_opp_c x]] = -[[x]]. Proof. destruct x as [ |xh xl];simpl. reflexivity. - rewrite Zopp_plus_distr;generalize (spec_opp_c xl);destruct (w_opp_c xl) + rewrite Z.opp_add_distr;generalize (spec_opp_c xl);destruct (w_opp_c xl) as [l|l];intros H;unfold interp_carry in H;rewrite <- H; - rewrite Zopp_mult_distr_l. + rewrite <- Z.mul_opp_l. assert ([|l|] = 0). assert (H1:= spec_to_Z l);assert (H2 := spec_to_Z xl);omega. rewrite H0;generalize (spec_opp_c xh);destruct (w_opp_c xh) @@ -213,13 +213,13 @@ Section DoubleSub. Lemma spec_ww_opp : forall x, [[ww_opp x]] = (-[[x]]) mod wwB. Proof. destruct x as [ |xh xl];simpl. reflexivity. - rewrite Zopp_plus_distr;rewrite Zopp_mult_distr_l. + rewrite Z.opp_add_distr, <- Z.mul_opp_l. generalize (spec_opp_c xl);destruct (w_opp_c xl) as [l|l];intros H;unfold interp_carry in H;rewrite <- H;simpl ww_to_Z. - rewrite spec_w_0;rewrite Zplus_0_r;rewrite wwB_wBwB. + rewrite spec_w_0;rewrite Z.add_0_r;rewrite wwB_wBwB. assert ([|l|] = 0). assert (H1:= spec_to_Z l);assert (H2 := spec_to_Z xl);omega. - rewrite H0;rewrite Zplus_0_r; rewrite Zpower_2; + rewrite H0;rewrite Z.add_0_r; rewrite Z.pow_2_r; rewrite Zmult_mod_distr_r;try apply lt_0_wB. rewrite spec_opp;trivial. apply Zmod_unique with (q:= -1). @@ -240,7 +240,7 @@ Section DoubleSub. simpl ww_to_Z;replace (([|xh|]*wB+[|xl|])-1) with ([|xh|]*wB+([|xl|]-1)). 2:ring. generalize (spec_pred_c xl);destruct (w_pred_c xl) as [l|l]; intros H;unfold interp_carry in H;rewrite <- H. simpl;apply spec_w_WW. - rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. + rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r. assert ([|l|] = wB - 1). assert (H1:= spec_to_Z l);assert (H2 := spec_to_Z xl);omega. rewrite H0;change ([|xh|] + -1) with ([|xh|] - 1). @@ -263,7 +263,7 @@ Section DoubleSub. generalize (spec_sub_c xh yh);destruct (w_sub_c xh yh) as [h|h];intros H1; unfold interp_carry in H1;rewrite <- H1;unfold interp_carry; try rewrite spec_w_WW;simpl ww_to_Z;try rewrite wwB_wBwB;ring. - rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. + rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r. change ([|xh|] - [|yh|] + -1) with ([|xh|] - [|yh|] - 1). generalize (spec_sub_carry_c xh yh);destruct (w_sub_carry_c xh yh) as [h|h]; intros H1;unfold interp_carry in *;rewrite <- H1;simpl ww_to_Z; @@ -274,7 +274,7 @@ Section DoubleSub. forall x y, [-[ww_sub_carry_c x y]] = [[x]] - [[y]] - 1. Proof. destruct y as [ |yh yl];simpl. - unfold Zminus;simpl;rewrite Zplus_0_r;exact (spec_ww_pred_c x). + unfold Z.sub;simpl;rewrite Z.add_0_r;exact (spec_ww_pred_c x). destruct x as [ |xh xl]. unfold interp_carry;rewrite spec_w_WW;simpl ww_to_Z;rewrite wwB_wBwB; repeat rewrite spec_opp_carry;ring. @@ -286,7 +286,7 @@ Section DoubleSub. generalize (spec_sub_c xh yh);destruct (w_sub_c xh yh) as [h|h];intros H1; unfold interp_carry in H1;rewrite <- H1;unfold interp_carry; try rewrite spec_w_WW;simpl ww_to_Z;try rewrite wwB_wBwB;ring. - rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. + rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r. change ([|xh|] - [|yh|] + -1) with ([|xh|] - [|yh|] - 1). generalize (spec_sub_carry_c xh yh);destruct (w_sub_carry_c xh yh) as [h|h]; intros H1;unfold interp_carry in *;rewrite <- H1;try rewrite spec_w_WW; @@ -303,7 +303,7 @@ Section DoubleSub. unfold interp_carry in H;rewrite <- H;simpl ww_to_Z. rewrite Zmod_small. apply spec_w_WW. exact (spec_ww_to_Z w_digits w_to_Z spec_to_Z (WW xh l)). - rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. + rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r. change ([|xh|] + -1) with ([|xh|] - 1). assert ([|l|] = wB - 1). assert (H1:= spec_to_Z l);assert (H2:= spec_to_Z xl);omega. @@ -322,7 +322,7 @@ Section DoubleSub. unfold interp_carry in H;rewrite <- H. rewrite spec_w_WW;rewrite (mod_wwB w_digits w_to_Z spec_to_Z). rewrite spec_sub;trivial. - simpl ww_to_Z;rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. + simpl ww_to_Z;rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r. rewrite (mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_sub_carry;trivial. Qed. @@ -341,7 +341,7 @@ Section DoubleSub. generalize (spec_sub_carry_c xl yl);destruct (w_sub_carry_c xl yl)as[l|l]; intros H;unfold interp_carry in H;rewrite <- H;rewrite spec_w_WW. rewrite (mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_sub;trivial. - rewrite Zplus_assoc;rewrite <- Zmult_plus_distr_l. + rewrite Z.add_assoc;rewrite <- Z.mul_add_distr_r. rewrite (mod_wwB w_digits w_to_Z spec_to_Z);rewrite spec_sub_carry;trivial. Qed. diff --git a/theories/Numbers/Cyclic/DoubleCyclic/DoubleType.v b/theories/Numbers/Cyclic/DoubleCyclic/DoubleType.v index a274b839..ce1c0bef 100644 --- a/theories/Numbers/Cyclic/DoubleCyclic/DoubleType.v +++ b/theories/Numbers/Cyclic/DoubleCyclic/DoubleType.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -13,7 +13,7 @@ Set Implicit Arguments. Require Import ZArith. Local Open Scope Z_scope. -Definition base digits := Zpower 2 (Zpos digits). +Definition base digits := Z.pow 2 (Zpos digits). Section Carry. diff --git a/theories/Numbers/Cyclic/Int31/Cyclic31.v b/theories/Numbers/Cyclic/Int31/Cyclic31.v index 2dd1c3ee..385217d0 100644 --- a/theories/Numbers/Cyclic/Int31/Cyclic31.v +++ b/theories/Numbers/Cyclic/Int31/Cyclic31.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -368,7 +368,7 @@ Section Basics. (** Variant of [phi] via [recrbis] *) Let Phi := fun b (_:int31) => - match b with D0 => Zdouble | D1 => Zdouble_plus_one end. + match b with D0 => Z.double | D1 => Z.succ_double end. Definition phibis_aux n x := recrbis_aux n _ Z0 Phi x. @@ -381,7 +381,7 @@ Section Basics. (** Recursive equations satisfied by [phi] *) Lemma phi_eqn1 : forall x, firstr x = D0 -> - phi x = Zdouble (phi (shiftr x)). + phi x = Z.double (phi (shiftr x)). Proof. intros. case_eq (iszero x); intros. @@ -391,7 +391,7 @@ Section Basics. Qed. Lemma phi_eqn2 : forall x, firstr x = D1 -> - phi x = Zdouble_plus_one (phi (shiftr x)). + phi x = Z.succ_double (phi (shiftr x)). Proof. intros. case_eq (iszero x); intros. @@ -401,7 +401,7 @@ Section Basics. Qed. Lemma phi_twice_firstl : forall x, firstl x = D0 -> - phi (twice x) = Zdouble (phi x). + phi (twice x) = Z.double (phi x). Proof. intros. rewrite phi_eqn1; auto; [ | destruct x; auto ]. @@ -410,7 +410,7 @@ Section Basics. Qed. Lemma phi_twice_plus_one_firstl : forall x, firstl x = D0 -> - phi (twice_plus_one x) = Zdouble_plus_one (phi x). + phi (twice_plus_one x) = Z.succ_double (phi x). Proof. intros. rewrite phi_eqn2; auto; [ | destruct x; auto ]. @@ -430,13 +430,13 @@ Section Basics. unfold phibis_aux, recrbis_aux; fold recrbis_aux; fold (phibis_aux n (shiftr x)). destruct (firstr x). - specialize IHn with (shiftr x); rewrite Zdouble_mult; omega. - specialize IHn with (shiftr x); rewrite Zdouble_plus_one_mult; omega. + specialize IHn with (shiftr x); rewrite Z.double_spec; omega. + specialize IHn with (shiftr x); rewrite Z.succ_double_spec; omega. Qed. Lemma phibis_aux_bounded : forall n x, n <= size -> - (phibis_aux n (nshiftr (size-n) x) < 2 ^ (Z_of_nat n))%Z. + (phibis_aux n (nshiftr (size-n) x) < 2 ^ (Z.of_nat n))%Z. Proof. induction n. simpl; unfold phibis_aux; simpl; auto with zarith. @@ -450,13 +450,13 @@ Section Basics. assert (H1 : n <= size) by omega. specialize (IHn x H1). set (y:=phibis_aux n (nshiftr (size - n) x)) in *. - rewrite inj_S, Zpower_Zsucc; auto with zarith. + rewrite Nat2Z.inj_succ, Z.pow_succ_r; auto with zarith. case_eq (firstr (nshiftr (size - S n) x)); intros. - rewrite Zdouble_mult; auto with zarith. - rewrite Zdouble_plus_one_mult; auto with zarith. + rewrite Z.double_spec; auto with zarith. + rewrite Z.succ_double_spec; auto with zarith. Qed. - Lemma phi_bounded : forall x, (0 <= phi x < 2 ^ (Z_of_nat size))%Z. + Lemma phi_bounded : forall x, (0 <= phi x < 2 ^ (Z.of_nat size))%Z. Proof. intros. rewrite <- phibis_aux_equiv. @@ -468,32 +468,32 @@ Section Basics. Lemma phibis_aux_lowerbound : forall n x, firstr (nshiftr n x) = D1 -> - (2 ^ Z_of_nat n <= phibis_aux (S n) x)%Z. + (2 ^ Z.of_nat n <= phibis_aux (S n) x)%Z. Proof. induction n. intros. unfold nshiftr in H; simpl in *. unfold phibis_aux, recrbis_aux. - rewrite H, Zdouble_plus_one_mult; omega. + rewrite H, Z.succ_double_spec; omega. intros. remember (S n) as m. unfold phibis_aux, recrbis_aux; fold recrbis_aux; fold (phibis_aux m (shiftr x)). subst m. - rewrite inj_S, Zpower_Zsucc; auto with zarith. - assert (2^(Z_of_nat n) <= phibis_aux (S n) (shiftr x))%Z. + rewrite Nat2Z.inj_succ, Z.pow_succ_r; auto with zarith. + assert (2^(Z.of_nat n) <= phibis_aux (S n) (shiftr x))%Z. apply IHn. rewrite <- nshiftr_S_tail; auto. destruct (firstr x). - change (Zdouble (phibis_aux (S n) (shiftr x))) with + change (Z.double (phibis_aux (S n) (shiftr x))) with (2*(phibis_aux (S n) (shiftr x)))%Z. omega. - rewrite Zdouble_plus_one_mult; omega. + rewrite Z.succ_double_spec; omega. Qed. Lemma phi_lowerbound : - forall x, firstl x = D1 -> (2^(Z_of_nat (pred size)) <= phi x)%Z. + forall x, firstl x = D1 -> (2^(Z.of_nat (pred size)) <= phi x)%Z. Proof. intros. generalize (phibis_aux_lowerbound (pred size) x). @@ -776,7 +776,7 @@ Section Basics. (** First, recursive equations *) Lemma phi_inv_double_plus_one : forall z, - phi_inv (Zdouble_plus_one z) = twice_plus_one (phi_inv z). + phi_inv (Z.succ_double z) = twice_plus_one (phi_inv z). Proof. destruct z; simpl; auto. induction p; simpl. @@ -788,20 +788,20 @@ Section Basics. Qed. Lemma phi_inv_double : forall z, - phi_inv (Zdouble z) = twice (phi_inv z). + phi_inv (Z.double z) = twice (phi_inv z). Proof. destruct z; simpl; auto. rewrite incr_twice_plus_one; auto. Qed. Lemma phi_inv_incr : forall z, - phi_inv (Zsucc z) = incr (phi_inv z). + phi_inv (Z.succ z) = incr (phi_inv z). Proof. destruct z. simpl; auto. simpl; auto. induction p; simpl; auto. - rewrite Pplus_one_succ_r, IHp, incr_twice_plus_one; auto. + rewrite <- Pos.add_1_r, IHp, incr_twice_plus_one; auto. rewrite incr_twice; auto. simpl; auto. destruct p; simpl; auto. @@ -908,15 +908,15 @@ Section Basics. Local Open Scope Z_scope. Lemma p2ibis_spec : forall n p, (n<=size)%nat -> - Zpos p = (Z_of_N (fst (p2ibis n p)))*2^(Z_of_nat n) + + Zpos p = (Z.of_N (fst (p2ibis n p)))*2^(Z.of_nat n) + phi (snd (p2ibis n p)). Proof. induction n; intros. - simpl; rewrite Pmult_1_r; auto. - replace (2^(Z_of_nat (S n)))%Z with (2*2^(Z_of_nat n))%Z by - (rewrite <- Zpower_Zsucc, <- Zpos_P_of_succ_nat; + simpl; rewrite Pos.mul_1_r; auto. + replace (2^(Z.of_nat (S n)))%Z with (2*2^(Z.of_nat n))%Z by + (rewrite <- Z.pow_succ_r, <- Zpos_P_of_succ_nat; auto with zarith). - rewrite (Zmult_comm 2). + rewrite (Z.mul_comm 2). assert (n<=size)%nat by omega. destruct p; simpl; [ | | auto]; specialize (IHn p H0); @@ -924,13 +924,13 @@ Section Basics. destruct (p2ibis n p) as (r,i); simpl in *; intros. change (Zpos p~1) with (2*Zpos p + 1)%Z. - rewrite phi_twice_plus_one_firstl, Zdouble_plus_one_mult. + rewrite phi_twice_plus_one_firstl, Z.succ_double_spec. rewrite IHn; ring. apply (nshiftr_0_firstl n); auto; try omega. change (Zpos p~0) with (2*Zpos p)%Z. rewrite phi_twice_firstl. - change (Zdouble (phi i)) with (2*(phi i))%Z. + change (Z.double (phi i)) with (2*(phi i))%Z. rewrite IHn; ring. apply (nshiftr_0_firstl n); auto; try omega. Qed. @@ -956,12 +956,12 @@ Section Basics. for the positive case. *) Lemma phi_phi_inv_positive : forall p, - phi (phi_inv_positive p) = (Zpos p) mod (2^(Z_of_nat size)). + phi (phi_inv_positive p) = (Zpos p) mod (2^(Z.of_nat size)). Proof. intros. replace (phi_inv_positive p) with (snd (p2ibis size p)). rewrite (p2ibis_spec size p) by auto. - rewrite Zplus_comm, Z_mod_plus. + rewrite Z.add_comm, Z_mod_plus. symmetry; apply Zmod_small. apply phi_bounded. auto with zarith. @@ -978,7 +978,7 @@ Section Basics. Proof. intros. unfold mul31. - rewrite <- Zdouble_mult, <- phi_twice_firstl, phi_inv_phi; auto. + rewrite <- Z.double_spec, <- phi_twice_firstl, phi_inv_phi; auto. Qed. Lemma double_twice_plus_one_firstl : forall x, firstl x = D0 -> @@ -987,7 +987,7 @@ Section Basics. intros. rewrite double_twice_firstl; auto. unfold add31. - rewrite phi_twice_firstl, <- Zdouble_plus_one_mult, + rewrite phi_twice_firstl, <- Z.succ_double_spec, <- phi_twice_plus_one_firstl, phi_inv_phi; auto. Qed. @@ -1016,7 +1016,7 @@ Section Basics. Qed. Lemma positive_to_int31_spec : forall p, - Zpos p = (Z_of_N (fst (positive_to_int31 p)))*2^(Z_of_nat size) + + Zpos p = (Z.of_N (fst (positive_to_int31 p)))*2^(Z.of_nat size) + phi (snd (positive_to_int31 p)). Proof. unfold positive_to_int31. @@ -1029,43 +1029,43 @@ Section Basics. [phi o twice] and so one. *) Lemma phi_twice : forall x, - phi (twice x) = (Zdouble (phi x)) mod 2^(Z_of_nat size). + phi (twice x) = (Z.double (phi x)) mod 2^(Z.of_nat size). Proof. intros. pattern x at 1; rewrite <- (phi_inv_phi x). rewrite <- phi_inv_double. - assert (0 <= Zdouble (phi x)). - rewrite Zdouble_mult; generalize (phi_bounded x); omega. - destruct (Zdouble (phi x)). + assert (0 <= Z.double (phi x)). + rewrite Z.double_spec; generalize (phi_bounded x); omega. + destruct (Z.double (phi x)). simpl; auto. apply phi_phi_inv_positive. compute in H; elim H; auto. Qed. Lemma phi_twice_plus_one : forall x, - phi (twice_plus_one x) = (Zdouble_plus_one (phi x)) mod 2^(Z_of_nat size). + phi (twice_plus_one x) = (Z.succ_double (phi x)) mod 2^(Z.of_nat size). Proof. intros. pattern x at 1; rewrite <- (phi_inv_phi x). rewrite <- phi_inv_double_plus_one. - assert (0 <= Zdouble_plus_one (phi x)). - rewrite Zdouble_plus_one_mult; generalize (phi_bounded x); omega. - destruct (Zdouble_plus_one (phi x)). + assert (0 <= Z.succ_double (phi x)). + rewrite Z.succ_double_spec; generalize (phi_bounded x); omega. + destruct (Z.succ_double (phi x)). simpl; auto. apply phi_phi_inv_positive. compute in H; elim H; auto. Qed. Lemma phi_incr : forall x, - phi (incr x) = (Zsucc (phi x)) mod 2^(Z_of_nat size). + phi (incr x) = (Z.succ (phi x)) mod 2^(Z.of_nat size). Proof. intros. pattern x at 1; rewrite <- (phi_inv_phi x). rewrite <- phi_inv_incr. - assert (0 <= Zsucc (phi x)). - change (Zsucc (phi x)) with ((phi x)+1)%Z; + assert (0 <= Z.succ (phi x)). + change (Z.succ (phi x)) with ((phi x)+1)%Z; generalize (phi_bounded x); omega. - destruct (Zsucc (phi x)). + destruct (Z.succ (phi x)). simpl; auto. apply phi_phi_inv_positive. compute in H; elim H; auto. @@ -1075,7 +1075,7 @@ Section Basics. in the negative case *) Lemma phi_phi_inv_negative : - forall p, phi (incr (complement_negative p)) = (Zneg p) mod 2^(Z_of_nat size). + forall p, phi (incr (complement_negative p)) = (Zneg p) mod 2^(Z.of_nat size). Proof. induction p. @@ -1083,21 +1083,21 @@ Section Basics. rewrite phi_incr in IHp. rewrite incr_twice, phi_twice_plus_one. remember (phi (complement_negative p)) as q. - rewrite Zdouble_plus_one_mult. - replace (2*q+1) with (2*(Zsucc q)-1) by omega. + rewrite Z.succ_double_spec. + replace (2*q+1) with (2*(Z.succ q)-1) by omega. rewrite <- Zminus_mod_idemp_l, <- Zmult_mod_idemp_r, IHp. rewrite Zmult_mod_idemp_r, Zminus_mod_idemp_l; auto with zarith. simpl complement_negative. rewrite incr_twice_plus_one, phi_twice. remember (phi (incr (complement_negative p))) as q. - rewrite Zdouble_mult, IHp, Zmult_mod_idemp_r; auto with zarith. + rewrite Z.double_spec, IHp, Zmult_mod_idemp_r; auto with zarith. simpl; auto. Qed. Lemma phi_phi_inv : - forall z, phi (phi_inv z) = z mod 2 ^ (Z_of_nat size). + forall z, phi (phi_inv z) = z mod 2 ^ (Z.of_nat size). Proof. destruct z. simpl; auto. @@ -1167,7 +1167,7 @@ Section Int31_Specs. Notation "[| x |]" := (phi x) (at level 0, x at level 99). - Local Notation wB := (2 ^ (Z_of_nat size)). + Local Notation wB := (2 ^ (Z.of_nat size)). Lemma wB_pos : wB > 0. Proof. @@ -1221,14 +1221,14 @@ Section Int31_Specs. set (X:=[|x|]) in *; set (Y:=[|y|]) in *; clearbody X Y. assert ((X+Y) mod wB ?= X+Y <> Eq -> [+|C1 (phi_inv (X+Y))|] = X+Y). - unfold interp_carry; rewrite phi_phi_inv, Zcompare_Eq_iff_eq; intros. + unfold interp_carry; rewrite phi_phi_inv, Z.compare_eq_iff; intros. destruct (Z_lt_le_dec (X+Y) wB). contradict H1; auto using Zmod_small with zarith. rewrite <- (Z_mod_plus_full (X+Y) (-1) wB). rewrite Zmod_small; romega. - generalize (Zcompare_Eq_eq ((X+Y) mod wB) (X+Y)); intros Heq. - destruct Zcompare; intros; + generalize (Z.compare_eq ((X+Y) mod wB) (X+Y)); intros Heq. + destruct Z.compare; intros; [ rewrite phi_phi_inv; auto | now apply H1 | now apply H1]. Qed. @@ -1245,14 +1245,14 @@ Section Int31_Specs. set (X:=[|x|]) in *; set (Y:=[|y|]) in *; clearbody X Y. assert ((X+Y+1) mod wB ?= X+Y+1 <> Eq -> [+|C1 (phi_inv (X+Y+1))|] = X+Y+1). - unfold interp_carry; rewrite phi_phi_inv, Zcompare_Eq_iff_eq; intros. + unfold interp_carry; rewrite phi_phi_inv, Z.compare_eq_iff; intros. destruct (Z_lt_le_dec (X+Y+1) wB). contradict H1; auto using Zmod_small with zarith. rewrite <- (Z_mod_plus_full (X+Y+1) (-1) wB). rewrite Zmod_small; romega. - generalize (Zcompare_Eq_eq ((X+Y+1) mod wB) (X+Y+1)); intros Heq. - destruct Zcompare; intros; + generalize (Z.compare_eq ((X+Y+1) mod wB) (X+Y+1)); intros Heq. + destruct Z.compare; intros; [ rewrite phi_phi_inv; auto | now apply H1 | now apply H1]. Qed. @@ -1284,14 +1284,14 @@ Section Int31_Specs. set (X:=[|x|]) in *; set (Y:=[|y|]) in *; clearbody X Y. assert ((X-Y) mod wB ?= X-Y <> Eq -> [-|C1 (phi_inv (X-Y))|] = X-Y). - unfold interp_carry; rewrite phi_phi_inv, Zcompare_Eq_iff_eq; intros. + unfold interp_carry; rewrite phi_phi_inv, Z.compare_eq_iff; intros. destruct (Z_lt_le_dec (X-Y) 0). rewrite <- (Z_mod_plus_full (X-Y) 1 wB). rewrite Zmod_small; romega. contradict H1; apply Zmod_small; romega. - generalize (Zcompare_Eq_eq ((X-Y) mod wB) (X-Y)); intros Heq. - destruct Zcompare; intros; + generalize (Z.compare_eq ((X-Y) mod wB) (X-Y)); intros Heq. + destruct Z.compare; intros; [ rewrite phi_phi_inv; auto | now apply H1 | now apply H1]. Qed. @@ -1303,14 +1303,14 @@ Section Int31_Specs. set (X:=[|x|]) in *; set (Y:=[|y|]) in *; clearbody X Y. assert ((X-Y-1) mod wB ?= X-Y-1 <> Eq -> [-|C1 (phi_inv (X-Y-1))|] = X-Y-1). - unfold interp_carry; rewrite phi_phi_inv, Zcompare_Eq_iff_eq; intros. + unfold interp_carry; rewrite phi_phi_inv, Z.compare_eq_iff; intros. destruct (Z_lt_le_dec (X-Y-1) 0). rewrite <- (Z_mod_plus_full (X-Y-1) 1 wB). rewrite Zmod_small; romega. contradict H1; apply Zmod_small; romega. - generalize (Zcompare_Eq_eq ((X-Y-1) mod wB) (X-Y-1)); intros Heq. - destruct Zcompare; intros; + generalize (Z.compare_eq ((X-Y-1) mod wB) (X-Y-1)); intros Heq. + destruct Z.compare; intros; [ rewrite phi_phi_inv; auto | now apply H1 | now apply H1]. Qed. @@ -1386,7 +1386,7 @@ Section Int31_Specs. apply Zmod_small. generalize (phi_bounded x)(phi_bounded y); intros. change (wB^2) with (wB * wB). - auto using Zmult_lt_compat with zarith. + auto using Z.mul_lt_mono_nonneg with zarith. Qed. Lemma spec_mul : forall x y, [|x*y|] = ([|x|] * [|y|]) mod wB. @@ -1412,29 +1412,26 @@ Section Int31_Specs. generalize (phi_bounded a1)(phi_bounded a2)(phi_bounded b); intros. assert ([|b|]>0) by (auto with zarith). generalize (Z_div_mod (phi2 a1 a2) [|b|] H4) (Z_div_pos (phi2 a1 a2) [|b|] H4). - unfold Zdiv; destruct (Zdiv_eucl (phi2 a1 a2) [|b|]); simpl. + unfold Z.div; destruct (Z.div_eucl (phi2 a1 a2) [|b|]); simpl. rewrite ?phi_phi_inv. destruct 1; intros. unfold phi2 in *. change base with wB; change base with wB in H5. - change (Zpower_pos 2 31) with wB; change (Zpower_pos 2 31) with wB in H. - rewrite H5, Zmult_comm. + change (Z.pow_pos 2 31) with wB; change (Z.pow_pos 2 31) with wB in H. + rewrite H5, Z.mul_comm. replace (z0 mod wB) with z0 by (symmetry; apply Zmod_small; omega). replace (z mod wB) with z; auto with zarith. symmetry; apply Zmod_small. split. apply H7; change base with wB; auto with zarith. - apply Zmult_gt_0_lt_reg_r with [|b|]. - omega. - rewrite Zmult_comm. - apply Zle_lt_trans with ([|b|]*z+z0). - omega. + apply Z.mul_lt_mono_pos_r with [|b|]; [omega| ]. + rewrite Z.mul_comm. + apply Z.le_lt_trans with ([|b|]*z+z0); [omega| ]. rewrite <- H5. - apply Zle_lt_trans with ([|a1|]*wB+(wB-1)). - omega. + apply Z.le_lt_trans with ([|a1|]*wB+(wB-1)); [omega | ]. replace ([|a1|]*wB+(wB-1)) with (wB*([|a1|]+1)-1) by ring. assert (wB*([|a1|]+1) <= wB*[|b|]); try omega. - apply Zmult_le_compat; omega. + apply Z.mul_le_mono_nonneg; omega. Qed. Lemma spec_div : forall a b, 0 < [|b|] -> @@ -1445,20 +1442,20 @@ Section Int31_Specs. unfold div31; intros. assert ([|b|]>0) by (auto with zarith). generalize (Z_div_mod [|a|] [|b|] H0) (Z_div_pos [|a|] [|b|] H0). - unfold Zdiv; destruct (Zdiv_eucl [|a|] [|b|]); simpl. + unfold Z.div; destruct (Z.div_eucl [|a|] [|b|]); simpl. rewrite ?phi_phi_inv. destruct 1; intros. - rewrite H1, Zmult_comm. + rewrite H1, Z.mul_comm. generalize (phi_bounded a)(phi_bounded b); intros. replace (z0 mod wB) with z0 by (symmetry; apply Zmod_small; omega). replace (z mod wB) with z; auto with zarith. symmetry; apply Zmod_small. split; auto with zarith. - apply Zle_lt_trans with [|a|]; auto with zarith. + apply Z.le_lt_trans with [|a|]; auto with zarith. rewrite H1. - apply Zle_trans with ([|b|]*z); try omega. - rewrite <- (Zmult_1_l z) at 1. - apply Zmult_le_compat; auto with zarith. + apply Z.le_trans with ([|b|]*z); try omega. + rewrite <- (Z.mul_1_l z) at 1. + apply Z.mul_le_mono_nonneg; auto with zarith. Qed. Lemma spec_mod : forall a b, 0 < [|b|] -> @@ -1466,9 +1463,9 @@ Section Int31_Specs. Proof. unfold div31; intros. assert ([|b|]>0) by (auto with zarith). - unfold Zmod. + unfold Z.modulo. generalize (Z_div_mod [|a|] [|b|] H0). - destruct (Zdiv_eucl [|a|] [|b|]); simpl. + destruct (Z.div_eucl [|a|] [|b|]); simpl. rewrite ?phi_phi_inv. destruct 1; intros. generalize (phi_bounded b); intros. @@ -1506,12 +1503,12 @@ Section Int31_Specs. destruct [|b|]. unfold size; auto with zarith. intros (_,H). - cut (Psize p <= size)%nat; [ omega | rewrite <- Zpower2_Psize; auto]. + cut (Pos.size_nat p <= size)%nat; [ omega | rewrite <- Zpower2_Psize; auto]. intros (H,_); compute in H; elim H; auto. Qed. Lemma iter_int31_iter_nat : forall A f i a, - iter_int31 i A f a = iter_nat (Zabs_nat [|i|]) A f a. + iter_int31 i A f a = iter_nat (Z.abs_nat [|i|]) A f a. Proof. intros. unfold iter_int31. @@ -1528,15 +1525,15 @@ Section Int31_Specs. rewrite <- iter_nat_plus. f_equal. - rewrite Zdouble_mult, Zmult_comm, <- Zplus_diag_eq_mult_2. - symmetry; apply Zabs_nat_Zplus; auto with zarith. + rewrite Z.double_spec, <- Z.add_diag. + symmetry; apply Zabs2Nat.inj_add; auto with zarith. - change (iter_nat (S (Zabs_nat z + Zabs_nat z)) A f a = - iter_nat (Zabs_nat (Zdouble_plus_one z)) A f a); f_equal. - rewrite Zdouble_plus_one_mult, Zmult_comm, <- Zplus_diag_eq_mult_2. - rewrite Zabs_nat_Zplus; auto with zarith. - rewrite Zabs_nat_Zplus; auto with zarith. - change (Zabs_nat 1) with 1%nat; omega. + change (iter_nat (S (Z.abs_nat z + Z.abs_nat z)) A f a = + iter_nat (Z.abs_nat (Z.succ_double z)) A f a); f_equal. + rewrite Z.succ_double_spec, <- Z.add_diag. + rewrite Zabs2Nat.inj_add; auto with zarith. + rewrite Zabs2Nat.inj_add; auto with zarith. + change (Z.abs_nat 1) with 1%nat; omega. Qed. Fixpoint addmuldiv31_alt n i j := @@ -1546,12 +1543,12 @@ Section Int31_Specs. end. Lemma addmuldiv31_equiv : forall p x y, - addmuldiv31 p x y = addmuldiv31_alt (Zabs_nat [|p|]) x y. + addmuldiv31 p x y = addmuldiv31_alt (Z.abs_nat [|p|]) x y. Proof. intros. unfold addmuldiv31. rewrite iter_int31_iter_nat. - set (n:=Zabs_nat [|p|]); clearbody n; clear p. + set (n:=Z.abs_nat [|p|]); clearbody n; clear p. revert x y; induction n. simpl; auto. intros. @@ -1566,21 +1563,21 @@ Section Int31_Specs. Proof. intros. rewrite addmuldiv31_equiv. - assert ([|p|] = Z_of_nat (Zabs_nat [|p|])). - rewrite inj_Zabs_nat; symmetry; apply Zabs_eq. + assert ([|p|] = Z.of_nat (Z.abs_nat [|p|])). + rewrite Zabs2Nat.id_abs; symmetry; apply Z.abs_eq. destruct (phi_bounded p); auto. - rewrite H0; rewrite H0 in H; clear H0; rewrite Zabs_nat_Z_of_nat. - set (n := Zabs_nat [|p|]) in *; clearbody n. + rewrite H0; rewrite H0 in H; clear H0; rewrite Zabs2Nat.id. + set (n := Z.abs_nat [|p|]) in *; clearbody n. assert (n <= 31)%nat. - rewrite inj_le_iff; auto with zarith. + rewrite Nat2Z.inj_le; auto with zarith. clear p H; revert x y. induction n. simpl; intros. - change (Zpower_pos 2 31) with (2^31). - rewrite Zmult_1_r. + change (Z.pow_pos 2 31) with (2^31). + rewrite Z.mul_1_r. replace ([|y|] / 2^31) with 0. - rewrite Zplus_0_r. + rewrite Z.add_0_r. symmetry; apply Zmod_small; apply phi_bounded. symmetry; apply Zdiv_small; apply phi_bounded. @@ -1588,43 +1585,43 @@ Section Int31_Specs. rewrite IHn; [ | omega ]. case_eq (firstl y); intros. - rewrite phi_twice, Zdouble_mult. + rewrite phi_twice, Z.double_spec. rewrite phi_twice_firstl; auto. - change (Zdouble [|y|]) with (2*[|y|]). - rewrite inj_S, Zpower_Zsucc; auto with zarith. + change (Z.double [|y|]) with (2*[|y|]). + rewrite Nat2Z.inj_succ, Z.pow_succ_r; auto with zarith. rewrite Zplus_mod; rewrite Zmult_mod_idemp_l; rewrite <- Zplus_mod. f_equal. - apply Zplus_eq_compat. + f_equal. ring. - replace (31-Z_of_nat n) with (Zsucc(31-Zsucc(Z_of_nat n))) by ring. - rewrite Zpower_Zsucc, <- Zdiv_Zdiv; auto with zarith. - rewrite Zmult_comm, Z_div_mult; auto with zarith. + replace (31-Z.of_nat n) with (Z.succ(31-Z.succ(Z.of_nat n))) by ring. + rewrite Z.pow_succ_r, <- Zdiv_Zdiv; auto with zarith. + rewrite Z.mul_comm, Z_div_mult; auto with zarith. - rewrite phi_twice_plus_one, Zdouble_plus_one_mult. + rewrite phi_twice_plus_one, Z.succ_double_spec. rewrite phi_twice; auto. - change (Zdouble [|y|]) with (2*[|y|]). - rewrite inj_S, Zpower_Zsucc; auto with zarith. + change (Z.double [|y|]) with (2*[|y|]). + rewrite Nat2Z.inj_succ, Z.pow_succ_r; auto with zarith. rewrite Zplus_mod; rewrite Zmult_mod_idemp_l; rewrite <- Zplus_mod. - rewrite Zmult_plus_distr_l, Zmult_1_l, <- Zplus_assoc. + rewrite Z.mul_add_distr_r, Z.mul_1_l, <- Z.add_assoc. + f_equal. f_equal. - apply Zplus_eq_compat. ring. assert ((2*[|y|]) mod wB = 2*[|y|] - wB). clear - H. symmetry. apply Zmod_unique with 1; [ | ring ]. generalize (phi_lowerbound _ H) (phi_bounded y). - set (wB' := 2^Z_of_nat (pred size)). + set (wB' := 2^Z.of_nat (pred size)). replace wB with (2*wB'); [ omega | ]. - unfold wB'. rewrite <- Zpower_Zsucc, <- inj_S by (auto with zarith). + unfold wB'. rewrite <- Z.pow_succ_r, <- Nat2Z.inj_succ by (auto with zarith). f_equal. rewrite H1. - replace wB with (2^(Z_of_nat n)*2^(31-Z_of_nat n)) by + replace wB with (2^(Z.of_nat n)*2^(31-Z.of_nat n)) by (rewrite <- Zpower_exp; auto with zarith; f_equal; unfold size; ring). - unfold Zminus; rewrite Zopp_mult_distr_l. + unfold Z.sub; rewrite <- Z.mul_opp_l. rewrite Z_div_plus; auto with zarith. ring_simplify. - replace (31+-Z_of_nat n) with (Zsucc(31-Zsucc(Z_of_nat n))) by ring. - rewrite Zpower_Zsucc, <- Zdiv_Zdiv; auto with zarith. - rewrite Zmult_comm, Z_div_mult; auto with zarith. + replace (31+-Z.of_nat n) with (Z.succ(31-Z.succ(Z.of_nat n))) by ring. + rewrite Z.pow_succ_r, <- Zdiv_Zdiv; auto with zarith. + rewrite Z.mul_comm, Z_div_mult; auto with zarith. Qed. Lemma spec_pos_mod : forall w p, @@ -1637,25 +1634,25 @@ Section Int31_Specs. generalize (phi_bounded w). symmetry; apply Zmod_small. split; auto with zarith. - apply Zlt_le_trans with wB; auto with zarith. + apply Z.lt_le_trans with wB; auto with zarith. apply Zpower_le_monotone; auto with zarith. intros. case_eq ([|p|] ?= 31); intros; - [ apply H; rewrite (Zcompare_Eq_eq _ _ H0); auto with zarith | | + [ apply H; rewrite (Z.compare_eq _ _ H0); auto with zarith | | apply H; change ([|p|]>31)%Z in H0; auto with zarith ]. change ([|p|]<31) in H0. rewrite spec_add_mul_div by auto with zarith. - change [|0|] with 0%Z; rewrite Zmult_0_l, Zplus_0_l. + change [|0|] with 0%Z; rewrite Z.mul_0_l, Z.add_0_l. generalize (phi_bounded p)(phi_bounded w); intros. assert (31-[|p|]<wB). - apply Zle_lt_trans with 31%Z; auto with zarith. + apply Z.le_lt_trans with 31%Z; auto with zarith. compute; auto. assert ([|31-p|]=31-[|p|]). unfold sub31; rewrite phi_phi_inv. change [|31|] with 31%Z. apply Zmod_small; auto with zarith. rewrite spec_add_mul_div by (rewrite H4; auto with zarith). - change [|0|] with 0%Z; rewrite Zdiv_0_l, Zplus_0_r. + change [|0|] with 0%Z; rewrite Zdiv_0_l, Z.add_0_r. rewrite H4. apply shift_unshift_mod_2; auto with zarith. Qed. @@ -1682,7 +1679,7 @@ Section Int31_Specs. end. Lemma head031_equiv : - forall x, [|head031 x|] = Z_of_nat (head031_alt size x). + forall x, [|head031 x|] = Z.of_nat (head031_alt size x). Proof. intros. case_eq (iszero x); intros. @@ -1690,7 +1687,7 @@ Section Int31_Specs. simpl; auto. unfold head031, recl. - change On with (phi_inv (Z_of_nat (31-size))). + change On with (phi_inv (Z.of_nat (31-size))). replace (head031_alt size x) with (head031_alt size x + (31 - size))%nat by auto. assert (size <= 31)%nat by auto with arith. @@ -1700,12 +1697,12 @@ Section Int31_Specs. unfold recl_aux; fold recl_aux. unfold head031_alt; fold head031_alt. rewrite H. - assert ([|phi_inv (Z_of_nat (31-S n))|] = Z_of_nat (31 - S n)). + assert ([|phi_inv (Z.of_nat (31-S n))|] = Z.of_nat (31 - S n)). rewrite phi_phi_inv. apply Zmod_small. split. - change 0 with (Z_of_nat O); apply inj_le; omega. - apply Zle_lt_trans with (Z_of_nat 31). + change 0 with (Z.of_nat O); apply inj_le; omega. + apply Z.le_lt_trans with (Z.of_nat 31). apply inj_le; omega. compute; auto. case_eq (firstl x); intros; auto. @@ -1718,7 +1715,7 @@ Section Int31_Specs. f_equal. change [|In|] with 1. replace (31-n)%nat with (S (31 - S n))%nat by omega. - rewrite inj_S; ring. + rewrite Nat2Z.inj_succ; ring. clear - H H2. rewrite (sneakr_shiftl x) in H. @@ -1747,16 +1744,16 @@ Section Int31_Specs. revert x H H0. unfold size at 2 5. induction size. - simpl Z_of_nat. + simpl Z.of_nat. intros. compute in H0; rewrite H0 in H; discriminate. intros. simpl head031_alt. case_eq (firstl x); intros. - rewrite (inj_S (head031_alt n (shiftl x))), Zpower_Zsucc; auto with zarith. - rewrite <- Zmult_assoc, Zmult_comm, <- Zmult_assoc, <-(Zmult_comm 2). - rewrite <- Zdouble_mult, <- (phi_twice_firstl _ H1). + rewrite (Nat2Z.inj_succ (head031_alt n (shiftl x))), Z.pow_succ_r; auto with zarith. + rewrite <- Z.mul_assoc, Z.mul_comm, <- Z.mul_assoc, <-(Z.mul_comm 2). + rewrite <- Z.double_spec, <- (phi_twice_firstl _ H1). apply IHn. rewrite phi_nz; rewrite phi_nz in H; contradict H. @@ -1765,9 +1762,9 @@ Section Int31_Specs. rewrite <- nshiftl_S_tail; auto. - change (2^(Z_of_nat 0)) with 1; rewrite Zmult_1_l. + change (2^(Z.of_nat 0)) with 1; rewrite Z.mul_1_l. generalize (phi_bounded x); unfold size; split; auto with zarith. - change (2^(Z_of_nat 31)/2) with (2^(Z_of_nat (pred size))). + change (2^(Z.of_nat 31)/2) with (2^(Z.of_nat (pred size))). apply phi_lowerbound; auto. Qed. @@ -1790,7 +1787,7 @@ Section Int31_Specs. end. Lemma tail031_equiv : - forall x, [|tail031 x|] = Z_of_nat (tail031_alt size x). + forall x, [|tail031 x|] = Z.of_nat (tail031_alt size x). Proof. intros. case_eq (iszero x); intros. @@ -1798,7 +1795,7 @@ Section Int31_Specs. simpl; auto. unfold tail031, recr. - change On with (phi_inv (Z_of_nat (31-size))). + change On with (phi_inv (Z.of_nat (31-size))). replace (tail031_alt size x) with (tail031_alt size x + (31 - size))%nat by auto. assert (size <= 31)%nat by auto with arith. @@ -1808,12 +1805,12 @@ Section Int31_Specs. unfold recr_aux; fold recr_aux. unfold tail031_alt; fold tail031_alt. rewrite H. - assert ([|phi_inv (Z_of_nat (31-S n))|] = Z_of_nat (31 - S n)). + assert ([|phi_inv (Z.of_nat (31-S n))|] = Z.of_nat (31 - S n)). rewrite phi_phi_inv. apply Zmod_small. split. - change 0 with (Z_of_nat O); apply inj_le; omega. - apply Zle_lt_trans with (Z_of_nat 31). + change 0 with (Z.of_nat O); apply inj_le; omega. + apply Z.le_lt_trans with (Z.of_nat 31). apply inj_le; omega. compute; auto. case_eq (firstr x); intros; auto. @@ -1826,7 +1823,7 @@ Section Int31_Specs. f_equal. change [|In|] with 1. replace (31-n)%nat with (S (31 - S n))%nat by omega. - rewrite inj_S; ring. + rewrite Nat2Z.inj_succ; ring. clear - H H2. rewrite (sneakl_shiftr x) in H. @@ -1844,14 +1841,14 @@ Section Int31_Specs. apply nshiftr_size. revert x H H0. induction size. - simpl Z_of_nat. + simpl Z.of_nat. intros. compute in H0; rewrite H0 in H; discriminate. intros. simpl tail031_alt. case_eq (firstr x); intros. - rewrite (inj_S (tail031_alt n (shiftr x))), Zpower_Zsucc; auto with zarith. + rewrite (Nat2Z.inj_succ (tail031_alt n (shiftr x))), Z.pow_succ_r; auto with zarith. destruct (IHn (shiftr x)) as (y & Hy1 & Hy2). rewrite phi_nz; rewrite phi_nz in H; contradict H. @@ -1861,13 +1858,13 @@ Section Int31_Specs. exists y; split; auto. rewrite phi_eqn1; auto. - rewrite Zdouble_mult, Hy2; ring. + rewrite Z.double_spec, Hy2; ring. exists [|shiftr x|]. split. generalize (phi_bounded (shiftr x)); auto with zarith. rewrite phi_eqn2; auto. - rewrite Zdouble_plus_one_mult; simpl; ring. + rewrite Z.succ_double_spec; simpl; ring. Qed. (* Sqrt *) @@ -1886,30 +1883,30 @@ Section Int31_Specs. Proof. intros Hj; generalize Hj k; pattern j; apply natlike_ind; auto; clear k j Hj. - intros _ k Hk; repeat rewrite Zplus_0_l. - apply Zmult_le_0_compat; generalize (Z_div_pos k 2); auto with zarith. + intros _ k Hk; repeat rewrite Z.add_0_l. + apply Z.mul_nonneg_nonneg; generalize (Z_div_pos k 2); auto with zarith. intros j Hj Hrec _ k Hk; pattern k; apply natlike_ind; auto; clear k Hk. - rewrite Zmult_0_r, Zplus_0_r, Zplus_0_l. - generalize (sqr_pos (Zsucc j / 2)) (quotient_by_2 (Zsucc j)); - unfold Zsucc. - rewrite Zpower_2, Zmult_plus_distr_l; repeat rewrite Zmult_plus_distr_r. + rewrite Z.mul_0_r, Z.add_0_r, Z.add_0_l. + generalize (sqr_pos (Z.succ j / 2)) (quotient_by_2 (Z.succ j)); + unfold Z.succ. + rewrite Z.pow_2_r, Z.mul_add_distr_r; repeat rewrite Z.mul_add_distr_l. auto with zarith. intros k Hk _. - replace ((Zsucc j + Zsucc k) / 2) with ((j + k)/2 + 1). + replace ((Z.succ j + Z.succ k) / 2) with ((j + k)/2 + 1). generalize (Hrec Hj k Hk) (quotient_by_2 (j + k)). - unfold Zsucc; repeat rewrite Zpower_2; - repeat rewrite Zmult_plus_distr_l; repeat rewrite Zmult_plus_distr_r. - repeat rewrite Zmult_1_l; repeat rewrite Zmult_1_r. + unfold Z.succ; repeat rewrite Z.pow_2_r; + repeat rewrite Z.mul_add_distr_r; repeat rewrite Z.mul_add_distr_l. + repeat rewrite Z.mul_1_l; repeat rewrite Z.mul_1_r. auto with zarith. - rewrite Zplus_comm, <- Z_div_plus_full_l; auto with zarith. - apply f_equal2 with (f := Zdiv); auto with zarith. + rewrite Z.add_comm, <- Z_div_plus_full_l; auto with zarith. + apply f_equal2 with (f := Z.div); auto with zarith. Qed. Lemma sqrt_main i j: 0 <= i -> 0 < j -> i < ((j + (i/j))/2 + 1) ^ 2. Proof. intros Hi Hj. assert (Hij: 0 <= i/j) by (apply Z_div_pos; auto with zarith). - apply Zlt_le_trans with (2 := sqrt_main_trick _ _ (Zlt_le_weak _ _ Hj) Hij). + apply Z.lt_le_trans with (2 := sqrt_main_trick _ _ (Z.lt_le_incl _ _ Hj) Hij). pattern i at 1; rewrite (Z_div_mod_eq i j); case (Z_mod_lt i j); auto with zarith. Qed. @@ -1919,48 +1916,34 @@ Section Int31_Specs. assert (H1: 0 <= i - 2) by auto with zarith. assert (H2: 1 <= (i / 2) ^ 2); auto with zarith. replace i with (1* 2 + (i - 2)); auto with zarith. - rewrite Zpower_2, Z_div_plus_full_l; auto with zarith. + rewrite Z.pow_2_r, Z_div_plus_full_l; auto with zarith. generalize (sqr_pos ((i - 2)/ 2)) (Z_div_pos (i - 2) 2). - rewrite Zmult_plus_distr_l; repeat rewrite Zmult_plus_distr_r. + rewrite Z.mul_add_distr_r; repeat rewrite Z.mul_add_distr_l. auto with zarith. generalize (quotient_by_2 i). - rewrite Zpower_2 in H2 |- *; - repeat (rewrite Zmult_plus_distr_l || - rewrite Zmult_plus_distr_r || - rewrite Zmult_1_l || rewrite Zmult_1_r). + rewrite Z.pow_2_r in H2 |- *; + repeat (rewrite Z.mul_add_distr_r || + rewrite Z.mul_add_distr_l || + rewrite Z.mul_1_l || rewrite Z.mul_1_r). auto with zarith. Qed. Lemma sqrt_test_true i j: 0 <= i -> 0 < j -> i/j >= j -> j ^ 2 <= i. Proof. - intros Hi Hj Hd; rewrite Zpower_2. - apply Zle_trans with (j * (i/j)); auto with zarith. + intros Hi Hj Hd; rewrite Z.pow_2_r. + apply Z.le_trans with (j * (i/j)); auto with zarith. apply Z_mult_div_ge; auto with zarith. Qed. Lemma sqrt_test_false i j: 0 <= i -> 0 < j -> i/j < j -> (j + (i/j))/2 < j. Proof. - intros Hi Hj H; case (Zle_or_lt j ((j + (i/j))/2)); auto. - intros H1; contradict H; apply Zle_not_lt. + intros Hi Hj H; case (Z.le_gt_cases j ((j + (i/j))/2)); auto. + intros H1; contradict H; apply Z.le_ngt. assert (2 * j <= j + (i/j)); auto with zarith. - apply Zle_trans with (2 * ((j + (i/j))/2)); auto with zarith. + apply Z.le_trans with (2 * ((j + (i/j))/2)); auto with zarith. apply Z_mult_div_ge; auto with zarith. Qed. - (* George's trick *) - Inductive ZcompareSpec (i j: Z): comparison -> Prop := - ZcompareSpecEq: i = j -> ZcompareSpec i j Eq - | ZcompareSpecLt: i < j -> ZcompareSpec i j Lt - | ZcompareSpecGt: j < i -> ZcompareSpec i j Gt. - - Lemma Zcompare_spec i j: ZcompareSpec i j (i ?= j). - Proof. - case_eq (Zcompare i j); intros H. - apply ZcompareSpecEq; apply Zcompare_Eq_eq; auto. - apply ZcompareSpecLt; auto. - apply ZcompareSpecGt; apply Zgt_lt; auto. - Qed. - Lemma sqrt31_step_def rec i j: sqrt31_step rec i j = match (fst (i/j) ?= j)%int31 with @@ -1987,65 +1970,66 @@ Section Int31_Specs. [|rec i j1|] ^ 2 <= [|i|] < ([|rec i j1|] + 1) ^ 2) -> [|sqrt31_step rec i j|] ^ 2 <= [|i|] < ([|sqrt31_step rec i j|] + 1) ^ 2. Proof. - assert (Hp2: 0 < [|2|]) by exact (refl_equal Lt). + assert (Hp2: 0 < [|2|]) by exact (eq_refl Lt). intros Hi Hj Hij H31 Hrec; rewrite sqrt31_step_def. rewrite spec_compare, div31_phi; auto. - case Zcompare_spec; auto; intros Hc; + case Z.compare_spec; auto; intros Hc; try (split; auto; apply sqrt_test_true; auto with zarith; fail). apply Hrec; repeat rewrite div31_phi; auto with zarith. replace [|(j + fst (i / j)%int31)|] with ([|j|] + [|i|] / [|j|]). split. - case (Zle_lt_or_eq 1 [|j|]); auto with zarith; intros Hj1. + apply Z.le_succ_l in Hj. change (1 <= [|j|]) in Hj. + Z.le_elim Hj. replace ([|j|] + [|i|]/[|j|]) with (1 * 2 + (([|j|] - 2) + [|i|] / [|j|])); try ring. rewrite Z_div_plus_full_l; auto with zarith. assert (0 <= [|i|]/ [|j|]) by (apply Z_div_pos; auto with zarith). assert (0 <= ([|j|] - 2 + [|i|] / [|j|]) / [|2|]) ; auto with zarith. - rewrite <- Hj1, Zdiv_1_r. + rewrite <- Hj, Zdiv_1_r. replace (1 + [|i|])%Z with (1 * 2 + ([|i|] - 1))%Z; try ring. rewrite Z_div_plus_full_l; auto with zarith. assert (0 <= ([|i|] - 1) /2)%Z by (apply Z_div_pos; auto with zarith). change ([|2|]) with 2%Z; auto with zarith. apply sqrt_test_false; auto with zarith. rewrite spec_add, div31_phi; auto. - apply sym_equal; apply Zmod_small. + symmetry; apply Zmod_small. split; auto with zarith. replace [|j + fst (i / j)%int31|] with ([|j|] + [|i|] / [|j|]). apply sqrt_main; auto with zarith. rewrite spec_add, div31_phi; auto. - apply sym_equal; apply Zmod_small. + symmetry; apply Zmod_small. split; auto with zarith. Qed. Lemma iter31_sqrt_correct n rec i j: 0 < [|i|] -> 0 < [|j|] -> - [|i|] < ([|j|] + 1) ^ 2 -> 2 * [|j|] < 2 ^ (Z_of_nat size) -> - (forall j1, 0 < [|j1|] -> 2^(Z_of_nat n) + [|j1|] <= [|j|] -> - [|i|] < ([|j1|] + 1) ^ 2 -> 2 * [|j1|] < 2 ^ (Z_of_nat size) -> + [|i|] < ([|j|] + 1) ^ 2 -> 2 * [|j|] < 2 ^ (Z.of_nat size) -> + (forall j1, 0 < [|j1|] -> 2^(Z.of_nat n) + [|j1|] <= [|j|] -> + [|i|] < ([|j1|] + 1) ^ 2 -> 2 * [|j1|] < 2 ^ (Z.of_nat size) -> [|rec i j1|] ^ 2 <= [|i|] < ([|rec i j1|] + 1) ^ 2) -> [|iter31_sqrt n rec i j|] ^ 2 <= [|i|] < ([|iter31_sqrt n rec i j|] + 1) ^ 2. Proof. revert rec i j; elim n; unfold iter31_sqrt; fold iter31_sqrt; clear n. intros rec i j Hi Hj Hij H31 Hrec; apply sqrt31_step_correct; auto with zarith. intros; apply Hrec; auto with zarith. - rewrite Zpower_0_r; auto with zarith. + rewrite Z.pow_0_r; auto with zarith. intros n Hrec rec i j Hi Hj Hij H31 HHrec. apply sqrt31_step_correct; auto. intros j1 Hj1 Hjp1; apply Hrec; auto with zarith. intros j2 Hj2 H2j2 Hjp2 Hj31; apply Hrec; auto with zarith. intros j3 Hj3 Hpj3. apply HHrec; auto. - rewrite inj_S, Zpower_Zsucc. - apply Zle_trans with (2 ^Z_of_nat n + [|j2|]); auto with zarith. - apply Zle_0_nat. + rewrite Nat2Z.inj_succ, Z.pow_succ_r. + apply Z.le_trans with (2 ^Z.of_nat n + [|j2|]); auto with zarith. + apply Nat2Z.is_nonneg. Qed. Lemma spec_sqrt : forall x, [|sqrt31 x|] ^ 2 <= [|x|] < ([|sqrt31 x|] + 1) ^ 2. Proof. intros i; unfold sqrt31. - rewrite spec_compare. case Zcompare_spec; change [|1|] with 1; + rewrite spec_compare. case Z.compare_spec; change [|1|] with 1; intros Hi; auto with zarith. - repeat rewrite Zpower_2; auto with zarith. + repeat rewrite Z.pow_2_r; auto with zarith. apply iter31_sqrt_correct; auto with zarith. rewrite div31_phi; change ([|2|]) with 2; auto with zarith. replace ([|i|]) with (1 * 2 + ([|i|] - 2))%Z; try ring. @@ -2054,18 +2038,18 @@ Section Int31_Specs. rewrite div31_phi; change ([|2|]) with 2; auto with zarith. apply sqrt_init; auto. rewrite div31_phi; change ([|2|]) with 2; auto with zarith. - apply Zle_lt_trans with ([|i|]). + apply Z.le_lt_trans with ([|i|]). apply Z_mult_div_ge; auto with zarith. case (phi_bounded i); auto. - intros j2 H1 H2; contradict H2; apply Zlt_not_le. + intros j2 H1 H2; contradict H2; apply Z.lt_nge. rewrite div31_phi; change ([|2|]) with 2; auto with zarith. - apply Zle_lt_trans with ([|i|]); auto with zarith. + apply Z.le_lt_trans with ([|i|]); auto with zarith. assert (0 <= [|i|]/2)%Z by (apply Z_div_pos; auto with zarith). - apply Zle_trans with (2 * ([|i|]/2)); auto with zarith. + apply Z.le_trans with (2 * ([|i|]/2)); auto with zarith. apply Z_mult_div_ge; auto with zarith. case (phi_bounded i); unfold size; auto with zarith. change [|0|] with 0; auto with zarith. - case (phi_bounded i); repeat rewrite Zpower_2; auto with zarith. + case (phi_bounded i); repeat rewrite Z.pow_2_r; auto with zarith. Qed. Lemma sqrt312_step_def rec ih il j: @@ -2095,10 +2079,10 @@ Section Int31_Specs. case (phi_bounded il); intros Hbil _. case (phi_bounded ih); intros Hbih Hbih1. assert (([|ih|] < [|j|] + 1)%Z); auto with zarith. - apply Zlt_square_simpl; auto with zarith. - repeat rewrite <-Zpower_2; apply Zle_lt_trans with (2 := H1). - apply Zle_trans with ([|ih|] * base)%Z; unfold phi2, base; - try rewrite Zpower_2; auto with zarith. + apply Z.square_lt_simpl_nonneg; auto with zarith. + repeat rewrite <-Z.pow_2_r; apply Z.le_lt_trans with (2 := H1). + apply Z.le_trans with ([|ih|] * base)%Z; unfold phi2, base; + try rewrite Z.pow_2_r; auto with zarith. Qed. Lemma div312_phi ih il j: (2^30 <= [|j|] -> [|ih|] < [|j|] -> @@ -2108,7 +2092,7 @@ Section Int31_Specs. generalize (spec_div21 ih il j Hj Hj1). case div3121; intros q r (Hq, Hr). apply Zdiv_unique with (phi r); auto with zarith. - simpl fst; apply trans_equal with (1 := Hq); ring. + simpl fst; apply eq_trans with (1 := Hq); ring. Qed. Lemma sqrt312_step_correct rec ih il j: @@ -2118,32 +2102,33 @@ Section Int31_Specs. [|sqrt312_step rec ih il j|] ^ 2 <= phi2 ih il < ([|sqrt312_step rec ih il j|] + 1) ^ 2. Proof. - assert (Hp2: (0 < [|2|])%Z) by exact (refl_equal Lt). + assert (Hp2: (0 < [|2|])%Z) by exact (eq_refl Lt). intros Hih Hj Hij Hrec; rewrite sqrt312_step_def. assert (H1: ([|ih|] <= [|j|])%Z) by (apply sqrt312_lower_bound with il; auto). case (phi_bounded ih); intros Hih1 _. case (phi_bounded il); intros Hil1 _. case (phi_bounded j); intros _ Hj1. assert (Hp3: (0 < phi2 ih il)). - unfold phi2; apply Zlt_le_trans with ([|ih|] * base)%Z; auto with zarith. - apply Zmult_lt_0_compat; auto with zarith. - apply Zlt_le_trans with (2:= Hih); auto with zarith. - rewrite spec_compare. case Zcompare_spec; intros Hc1. + unfold phi2; apply Z.lt_le_trans with ([|ih|] * base)%Z; auto with zarith. + apply Z.mul_pos_pos; auto with zarith. + apply Z.lt_le_trans with (2:= Hih); auto with zarith. + rewrite spec_compare. case Z.compare_spec; intros Hc1. split; auto. apply sqrt_test_true; auto. unfold phi2, base; auto with zarith. unfold phi2; rewrite Hc1. assert (0 <= [|il|]/[|j|]) by (apply Z_div_pos; auto with zarith). - rewrite Zmult_comm, Z_div_plus_full_l; unfold base; auto with zarith. - unfold Zpower, Zpower_pos in Hj1; simpl in Hj1; auto with zarith. - case (Zle_or_lt (2 ^ 30) [|j|]); intros Hjj. - rewrite spec_compare; case Zcompare_spec; + rewrite Z.mul_comm, Z_div_plus_full_l; unfold base; auto with zarith. + unfold Z.pow, Z.pow_pos in Hj1; simpl in Hj1; auto with zarith. + case (Z.le_gt_cases (2 ^ 30) [|j|]); intros Hjj. + rewrite spec_compare; case Z.compare_spec; rewrite div312_phi; auto; intros Hc; try (split; auto; apply sqrt_test_true; auto with zarith; fail). apply Hrec. assert (Hf1: 0 <= phi2 ih il/ [|j|]) by (apply Z_div_pos; auto with zarith). - case (Zle_lt_or_eq 1 ([|j|])); auto with zarith; intros Hf2. - 2: contradict Hc; apply Zle_not_lt; rewrite <- Hf2, Zdiv_1_r; auto with zarith. + apply Z.le_succ_l in Hj. change (1 <= [|j|]) in Hj. + Z.le_elim Hj. + 2: contradict Hc; apply Z.le_ngt; rewrite <- Hj, Zdiv_1_r; auto with zarith. assert (Hf3: 0 < ([|j|] + phi2 ih il / [|j|]) / 2). replace ([|j|] + phi2 ih il/ [|j|])%Z with (1 * 2 + (([|j|] - 2) + phi2 ih il / [|j|])); try ring. @@ -2157,9 +2142,9 @@ Section Int31_Specs. rewrite div31_phi; change [|2|] with 2%Z; auto with zarith. intros HH; rewrite HH; clear HH; auto with zarith. rewrite spec_add, div31_phi; change [|2|] with 2%Z; auto. - rewrite Zmult_1_l; intros HH. - rewrite Zplus_comm, <- Z_div_plus_full_l; auto with zarith. - change (phi v30 * 2) with (2 ^ Z_of_nat size). + rewrite Z.mul_1_l; intros HH. + rewrite Z.add_comm, <- Z_div_plus_full_l; auto with zarith. + change (phi v30 * 2) with (2 ^ Z.of_nat size). rewrite HH, Zmod_small; auto with zarith. replace (phi match j +c fst (div3121 ih il j) with @@ -2173,41 +2158,41 @@ Section Int31_Specs. rewrite div31_phi; auto with zarith. intros HH; rewrite HH; auto with zarith. intros HH; rewrite <- HH. - change (1 * 2 ^ Z_of_nat size) with (phi (v30) * 2). + change (1 * 2 ^ Z.of_nat size) with (phi (v30) * 2). rewrite Z_div_plus_full_l; auto with zarith. - rewrite Zplus_comm. + rewrite Z.add_comm. rewrite spec_add, Zmod_small. rewrite div31_phi; auto. split; auto with zarith. case (phi_bounded (fst (r/2)%int31)); case (phi_bounded v30); auto with zarith. rewrite div31_phi; change (phi 2) with 2%Z; auto. - change (2 ^Z_of_nat size) with (base/2 + phi v30). + change (2 ^Z.of_nat size) with (base/2 + phi v30). assert (phi r / 2 < base/2); auto with zarith. - apply Zmult_gt_0_lt_reg_r with 2; auto with zarith. + apply Z.mul_lt_mono_pos_r with 2; auto with zarith. change (base/2 * 2) with base. - apply Zle_lt_trans with (phi r). - rewrite Zmult_comm; apply Z_mult_div_ge; auto with zarith. + apply Z.le_lt_trans with (phi r). + rewrite Z.mul_comm; apply Z_mult_div_ge; auto with zarith. case (phi_bounded r); auto with zarith. - contradict Hij; apply Zle_not_lt. + contradict Hij; apply Z.le_ngt. assert ((1 + [|j|]) <= 2 ^ 30); auto with zarith. - apply Zle_trans with ((2 ^ 30) * (2 ^ 30)); auto with zarith. + apply Z.le_trans with ((2 ^ 30) * (2 ^ 30)); auto with zarith. assert (0 <= 1 + [|j|]); auto with zarith. - apply Zmult_le_compat; auto with zarith. + apply Z.mul_le_mono_nonneg; auto with zarith. change ((2 ^ 30) * (2 ^ 30)) with ((2 ^ 29) * base). - apply Zle_trans with ([|ih|] * base); auto with zarith. + apply Z.le_trans with ([|ih|] * base); auto with zarith. unfold phi2, base; auto with zarith. split; auto. apply sqrt_test_true; auto. unfold phi2, base; auto with zarith. - apply Zle_ge; apply Zle_trans with (([|j|] * base)/[|j|]). - rewrite Zmult_comm, Z_div_mult; auto with zarith. - apply Zge_le; apply Z_div_ge; auto with zarith. + apply Z.le_ge; apply Z.le_trans with (([|j|] * base)/[|j|]). + rewrite Z.mul_comm, Z_div_mult; auto with zarith. + apply Z.ge_le; apply Z_div_ge; auto with zarith. Qed. Lemma iter312_sqrt_correct n rec ih il j: 2^29 <= [|ih|] -> 0 < [|j|] -> phi2 ih il < ([|j|] + 1) ^ 2 -> - (forall j1, 0 < [|j1|] -> 2^(Z_of_nat n) + [|j1|] <= [|j|] -> + (forall j1, 0 < [|j1|] -> 2^(Z.of_nat n) + [|j1|] <= [|j|] -> phi2 ih il < ([|j1|] + 1) ^ 2 -> [|rec ih il j1|] ^ 2 <= phi2 ih il < ([|rec ih il j1|] + 1) ^ 2) -> [|iter312_sqrt n rec ih il j|] ^ 2 <= phi2 ih il @@ -2216,16 +2201,16 @@ Section Int31_Specs. revert rec ih il j; elim n; unfold iter312_sqrt; fold iter312_sqrt; clear n. intros rec ih il j Hi Hj Hij Hrec; apply sqrt312_step_correct; auto with zarith. intros; apply Hrec; auto with zarith. - rewrite Zpower_0_r; auto with zarith. + rewrite Z.pow_0_r; auto with zarith. intros n Hrec rec ih il j Hi Hj Hij HHrec. apply sqrt312_step_correct; auto. intros j1 Hj1 Hjp1; apply Hrec; auto with zarith. intros j2 Hj2 H2j2 Hjp2; apply Hrec; auto with zarith. intros j3 Hj3 Hpj3. apply HHrec; auto. - rewrite inj_S, Zpower_Zsucc. - apply Zle_trans with (2 ^Z_of_nat n + [|j2|])%Z; auto with zarith. - apply Zle_0_nat. + rewrite Nat2Z.inj_succ, Z.pow_succ_r. + apply Z.le_trans with (2 ^Z.of_nat n + [|j2|])%Z; auto with zarith. + apply Nat2Z.is_nonneg. Qed. Lemma spec_sqrt2 : forall x y, @@ -2240,30 +2225,30 @@ Section Int31_Specs. (intros s; ring). assert (Hb: 0 <= base) by (red; intros HH; discriminate). assert (Hi2: phi2 ih il < (phi Tn + 1) ^ 2). - change ((phi Tn + 1) ^ 2) with (2^62). - apply Zle_lt_trans with ((2^31 -1) * base + (2^31 - 1)); auto with zarith. - 2: simpl; unfold Zpower_pos; simpl; auto with zarith. - case (phi_bounded ih); case (phi_bounded il); intros H1 H2 H3 H4. - unfold base, Zpower, Zpower_pos in H2,H4; simpl in H2,H4. - unfold phi2,Zpower, Zpower_pos. simpl Pos.iter; auto with zarith. + { change ((phi Tn + 1) ^ 2) with (2^62). + apply Z.le_lt_trans with ((2^31 -1) * base + (2^31 - 1)); auto with zarith. + 2: simpl; unfold Z.pow_pos; simpl; auto with zarith. + case (phi_bounded ih); case (phi_bounded il); intros H1 H2 H3 H4. + unfold base, Z.pow, Z.pow_pos in H2,H4; simpl in H2,H4. + unfold phi2,Z.pow, Z.pow_pos. simpl Pos.iter; auto with zarith. } case (iter312_sqrt_correct 31 (fun _ _ j => j) ih il Tn); auto with zarith. change [|Tn|] with 2147483647; auto with zarith. intros j1 _ HH; contradict HH. - apply Zlt_not_le. + apply Z.lt_nge. change [|Tn|] with 2147483647; auto with zarith. - change (2 ^ Z_of_nat 31) with 2147483648; auto with zarith. + change (2 ^ Z.of_nat 31) with 2147483648; auto with zarith. case (phi_bounded j1); auto with zarith. set (s := iter312_sqrt 31 (fun _ _ j : int31 => j) ih il Tn). intros Hs1 Hs2. generalize (spec_mul_c s s); case mul31c. simpl zn2z_to_Z; intros HH. assert ([|s|] = 0). - case (Zmult_integral _ _ (sym_equal HH)); auto. - contradict Hs2; apply Zle_not_lt; rewrite H. + { symmetry in HH. rewrite Z.mul_eq_0 in HH. destruct HH; auto. } + contradict Hs2; apply Z.le_ngt; rewrite H. change ((0 + 1) ^ 2) with 1. - apply Zle_trans with (2 ^ Z_of_nat size / 4 * base). + apply Z.le_trans with (2 ^ Z.of_nat size / 4 * base). simpl; auto with zarith. - apply Zle_trans with ([|ih|] * base); auto with zarith. + apply Z.le_trans with ([|ih|] * base); auto with zarith. unfold phi2; case (phi_bounded il); auto with zarith. intros ih1 il1. change [||WW ih1 il1||] with (phi2 ih1 il1). @@ -2271,10 +2256,10 @@ Section Int31_Specs. generalize (spec_sub_c il il1). case sub31c; intros il2 Hil2. simpl interp_carry in Hil2. - rewrite spec_compare; case Zcompare_spec. + rewrite spec_compare; case Z.compare_spec. unfold interp_carry. intros H1; split. - rewrite Zpower_2, <- Hihl1. + rewrite Z.pow_2_r, <- Hihl1. unfold phi2; ring[Hil2 H1]. replace [|il2|] with (phi2 ih il - phi2 ih1 il1). rewrite Hihl1. @@ -2282,109 +2267,111 @@ Section Int31_Specs. unfold phi2; rewrite H1, Hil2; ring. unfold interp_carry. intros H1; contradict Hs1. - apply Zlt_not_le; rewrite Zpower_2, <-Hihl1. + apply Z.lt_nge; rewrite Z.pow_2_r, <-Hihl1. unfold phi2. case (phi_bounded il); intros _ H2. - apply Zlt_le_trans with (([|ih|] + 1) * base + 0). - rewrite Zmult_plus_distr_l, Zplus_0_r; auto with zarith. + apply Z.lt_le_trans with (([|ih|] + 1) * base + 0). + rewrite Z.mul_add_distr_r, Z.add_0_r; auto with zarith. case (phi_bounded il1); intros H3 _. - apply Zplus_le_compat; auto with zarith. - unfold interp_carry; change (1 * 2 ^ Z_of_nat size) with base. - rewrite Zpower_2, <- Hihl1, Hil2. + apply Z.add_le_mono; auto with zarith. + unfold interp_carry; change (1 * 2 ^ Z.of_nat size) with base. + rewrite Z.pow_2_r, <- Hihl1, Hil2. intros H1. - case (Zle_lt_or_eq ([|ih1|] + 1) ([|ih|])); auto with zarith. - intros H2; contradict Hs2; apply Zle_not_lt. + rewrite <- Z.le_succ_l, <- Z.add_1_r in H1. + Z.le_elim H1. + contradict Hs2; apply Z.le_ngt. replace (([|s|] + 1) ^ 2) with (phi2 ih1 il1 + 2 * [|s|] + 1). unfold phi2. case (phi_bounded il); intros Hpil _. assert (Hl1l: [|il1|] <= [|il|]). - case (phi_bounded il2); rewrite Hil2; auto with zarith. + { case (phi_bounded il2); rewrite Hil2; auto with zarith. } assert ([|ih1|] * base + 2 * [|s|] + 1 <= [|ih|] * base); auto with zarith. - case (phi_bounded s); change (2 ^ Z_of_nat size) with base; intros _ Hps. + case (phi_bounded s); change (2 ^ Z.of_nat size) with base; intros _ Hps. case (phi_bounded ih1); intros Hpih1 _; auto with zarith. - apply Zle_trans with (([|ih1|] + 2) * base); auto with zarith. - rewrite Zmult_plus_distr_l. + apply Z.le_trans with (([|ih1|] + 2) * base); auto with zarith. + rewrite Z.mul_add_distr_r. assert (2 * [|s|] + 1 <= 2 * base); auto with zarith. rewrite Hihl1, Hbin; auto. - intros H2; split. - unfold phi2; rewrite <- H2; ring. + split. + unfold phi2; rewrite <- H1; ring. replace (base + ([|il|] - [|il1|])) with (phi2 ih il - ([|s|] * [|s|])). rewrite <-Hbin in Hs2; auto with zarith. - rewrite <- Hihl1; unfold phi2; rewrite <- H2; ring. + rewrite <- Hihl1; unfold phi2; rewrite <- H1; ring. unfold interp_carry in Hil2 |- *. - unfold interp_carry; change (1 * 2 ^ Z_of_nat size) with base. + unfold interp_carry; change (1 * 2 ^ Z.of_nat size) with base. assert (Hsih: [|ih - 1|] = [|ih|] - 1). - rewrite spec_sub, Zmod_small; auto; change [|1|] with 1. - case (phi_bounded ih); intros H1 H2. - generalize Hih; change (2 ^ Z_of_nat size / 4) with 536870912. - split; auto with zarith. - rewrite spec_compare; case Zcompare_spec. + { rewrite spec_sub, Zmod_small; auto; change [|1|] with 1. + case (phi_bounded ih); intros H1 H2. + generalize Hih; change (2 ^ Z.of_nat size / 4) with 536870912. + split; auto with zarith. } + rewrite spec_compare; case Z.compare_spec. rewrite Hsih. intros H1; split. - rewrite Zpower_2, <- Hihl1. + rewrite Z.pow_2_r, <- Hihl1. unfold phi2; rewrite <-H1. - apply trans_equal with ([|ih|] * base + [|il1|] + ([|il|] - [|il1|])). + transitivity ([|ih|] * base + [|il1|] + ([|il|] - [|il1|])). ring. rewrite <-Hil2. - change (2 ^ Z_of_nat size) with base; ring. + change (2 ^ Z.of_nat size) with base; ring. replace [|il2|] with (phi2 ih il - phi2 ih1 il1). rewrite Hihl1. rewrite <-Hbin in Hs2; auto with zarith. unfold phi2. rewrite <-H1. ring_simplify. - apply trans_equal with (base + ([|il|] - [|il1|])). + transitivity (base + ([|il|] - [|il1|])). ring. rewrite <-Hil2. - change (2 ^ Z_of_nat size) with base; ring. + change (2 ^ Z.of_nat size) with base; ring. rewrite Hsih; intros H1. assert (He: [|ih|] = [|ih1|]). - apply Zle_antisym; auto with zarith. - case (Zle_or_lt [|ih1|] [|ih|]); auto; intros H2. - contradict Hs1; apply Zlt_not_le; rewrite Zpower_2, <-Hihl1. - unfold phi2. - case (phi_bounded il); change (2 ^ Z_of_nat size) with base; + { apply Z.le_antisymm; auto with zarith. + case (Z.le_gt_cases [|ih1|] [|ih|]); auto; intros H2. + contradict Hs1; apply Z.lt_nge; rewrite Z.pow_2_r, <-Hihl1. + unfold phi2. + case (phi_bounded il); change (2 ^ Z.of_nat size) with base; intros _ Hpil1. - apply Zlt_le_trans with (([|ih|] + 1) * base). - rewrite Zmult_plus_distr_l, Zmult_1_l; auto with zarith. - case (phi_bounded il1); intros Hpil2 _. - apply Zle_trans with (([|ih1|]) * base); auto with zarith. - rewrite Zpower_2, <-Hihl1; unfold phi2; rewrite <-He. - contradict Hs1; apply Zlt_not_le; rewrite Zpower_2, <-Hihl1. + apply Z.lt_le_trans with (([|ih|] + 1) * base). + rewrite Z.mul_add_distr_r, Z.mul_1_l; auto with zarith. + case (phi_bounded il1); intros Hpil2 _. + apply Z.le_trans with (([|ih1|]) * base); auto with zarith. } + rewrite Z.pow_2_r, <-Hihl1; unfold phi2; rewrite <-He. + contradict Hs1; apply Z.lt_nge; rewrite Z.pow_2_r, <-Hihl1. unfold phi2; rewrite He. assert (phi il - phi il1 < 0); auto with zarith. rewrite <-Hil2. case (phi_bounded il2); auto with zarith. intros H1. - rewrite Zpower_2, <-Hihl1. - case (Zle_lt_or_eq ([|ih1|] + 2) [|ih|]); auto with zarith. - intros H2; contradict Hs2; apply Zle_not_lt. + rewrite Z.pow_2_r, <-Hihl1. + assert (H2 : [|ih1|]+2 <= [|ih|]); auto with zarith. + Z.le_elim H2. + contradict Hs2; apply Z.le_ngt. replace (([|s|] + 1) ^ 2) with (phi2 ih1 il1 + 2 * [|s|] + 1). unfold phi2. assert ([|ih1|] * base + 2 * phi s + 1 <= [|ih|] * base + ([|il|] - [|il1|])); auto with zarith. rewrite <-Hil2. - change (-1 * 2 ^ Z_of_nat size) with (-base). + change (-1 * 2 ^ Z.of_nat size) with (-base). case (phi_bounded il2); intros Hpil2 _. - apply Zle_trans with ([|ih|] * base + - base); auto with zarith. - case (phi_bounded s); change (2 ^ Z_of_nat size) with base; intros _ Hps. + apply Z.le_trans with ([|ih|] * base + - base); auto with zarith. + case (phi_bounded s); change (2 ^ Z.of_nat size) with base; intros _ Hps. assert (2 * [|s|] + 1 <= 2 * base); auto with zarith. - apply Zle_trans with ([|ih1|] * base + 2 * base); auto with zarith. + apply Z.le_trans with ([|ih1|] * base + 2 * base); auto with zarith. assert (Hi: ([|ih1|] + 3) * base <= [|ih|] * base); auto with zarith. - rewrite Zmult_plus_distr_l in Hi; auto with zarith. + rewrite Z.mul_add_distr_r in Hi; auto with zarith. rewrite Hihl1, Hbin; auto. - intros H2; unfold phi2; rewrite <-H2. + unfold phi2; rewrite <-H2. split. replace [|il|] with (([|il|] - [|il1|]) + [|il1|]); try ring. rewrite <-Hil2. - change (-1 * 2 ^ Z_of_nat size) with (-base); ring. + change (-1 * 2 ^ Z.of_nat size) with (-base); ring. replace (base + [|il2|]) with (phi2 ih il - phi2 ih1 il1). rewrite Hihl1. rewrite <-Hbin in Hs2; auto with zarith. unfold phi2; rewrite <-H2. replace [|il|] with (([|il|] - [|il1|]) + [|il1|]); try ring. rewrite <-Hil2. - change (-1 * 2 ^ Z_of_nat size) with (-base); ring. + change (-1 * 2 ^ Z.of_nat size) with (-base); ring. Qed. (** [iszero] *) @@ -2394,7 +2381,7 @@ Qed. clear; unfold ZnZ.eq0; simpl. unfold compare31; simpl; intros. change [|0|] with 0 in H. - apply Zcompare_Eq_eq. + apply Z.compare_eq. now destruct ([|x|] ?= 0). Qed. @@ -2412,7 +2399,7 @@ Qed. destruct H; auto with zarith. replace ([|x|] mod 2) with [|r|]. destruct H; auto with zarith. - case Zcompare_spec; auto with zarith. + case Z.compare_spec; auto with zarith. apply Zmod_unique with [|q|]; auto with zarith. Qed. diff --git a/theories/Numbers/Cyclic/Int31/Int31.v b/theories/Numbers/Cyclic/Int31/Int31.v index 20f750f6..f414663a 100644 --- a/theories/Numbers/Cyclic/Int31/Int31.v +++ b/theories/Numbers/Cyclic/Int31/Int31.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -117,12 +117,12 @@ Definition iszero : int31 -> bool := Eval compute in It seems to work, but later "unfold iszero" takes forever. *) -(** [base] is [2^31], obtained via iterations of [Zdouble]. +(** [base] is [2^31], obtained via iterations of [Z.double]. It can also be seen as the smallest b > 0 s.t. phi_inv b = 0 (see below) *) Definition base := Eval compute in - iter_nat size Z Zdouble 1%Z. + iter_nat size Z Z.double 1%Z. (** * Recursors *) @@ -155,11 +155,11 @@ Definition recr := recr_aux size. (** * Conversions *) -(** From int31 to Z, we simply iterates [Zdouble] or [Zdouble_plus_one]. *) +(** From int31 to Z, we simply iterates [Z.double] or [Z.succ_double]. *) Definition phi : int31 -> Z := recr Z (0%Z) - (fun b _ => match b with D0 => Zdouble | D1 => Zdouble_plus_one end). + (fun b _ => match b with D0 => Z.double | D1 => Z.succ_double end). (** From positive to int31. An abstract definition could be : [ phi_inv (2n) = 2*(phi_inv n) /\ @@ -293,13 +293,13 @@ Notation "n '*c' m" := (mul31c n m) (at level 40, no associativity) : int31_scop (** Division of a double size word modulo [2^31] *) Definition div3121 (nh nl m : int31) := - let (q,r) := Zdiv_eucl (phi2 nh nl) (phi m) in + let (q,r) := Z.div_eucl (phi2 nh nl) (phi m) in (phi_inv q, phi_inv r). (** Division modulo [2^31] *) Definition div31 (n m : int31) := - let (q,r) := Zdiv_eucl (phi n) (phi m) in + let (q,r) := Z.div_eucl (phi n) (phi m) in (phi_inv q, phi_inv r). Notation "n / m" := (div31 n m) : int31_scope. @@ -391,7 +391,7 @@ Eval lazy delta [On In Twon] in | Lt => iter31_sqrt 31 (fun i j => j) i (fst (i/Twon)) end. -Definition v30 := Eval compute in (addmuldiv31 (phi_inv (Z_of_nat size - 1)) In On). +Definition v30 := Eval compute in (addmuldiv31 (phi_inv (Z.of_nat size - 1)) In On). Definition sqrt312_step (rec: int31 -> int31 -> int31 -> int31) (ih il j: int31) := @@ -452,7 +452,7 @@ Definition positive_to_int31 (p:positive) := p2i size p. It is used as default answer for numbers of zeros in [head0] and [tail0] *) -Definition T31 : int31 := Eval compute in phi_inv (Z_of_nat size). +Definition T31 : int31 := Eval compute in phi_inv (Z.of_nat size). Definition head031 (i:int31) := recl _ (fun _ => T31) diff --git a/theories/Numbers/Cyclic/Int31/Ring31.v b/theories/Numbers/Cyclic/Int31/Ring31.v index 23e8bd33..f5a08438 100644 --- a/theories/Numbers/Cyclic/Int31/Ring31.v +++ b/theories/Numbers/Cyclic/Int31/Ring31.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -81,7 +81,7 @@ Qed. Lemma eqb31_eq : forall x y, eqb31 x y = true <-> x=y. Proof. unfold eqb31. intros x y. -rewrite Cyclic31.spec_compare. case Zcompare_spec. +rewrite Cyclic31.spec_compare. case Z.compare_spec. intuition. apply Int31_canonic; auto. intuition; subst; auto with zarith; try discriminate. intuition; subst; auto with zarith; try discriminate. diff --git a/theories/Numbers/Cyclic/ZModulo/ZModulo.v b/theories/Numbers/Cyclic/ZModulo/ZModulo.v index d039fdcb..9e3f4ef4 100644 --- a/theories/Numbers/Cyclic/ZModulo/ZModulo.v +++ b/theories/Numbers/Cyclic/ZModulo/ZModulo.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -76,22 +76,22 @@ Section ZModulo. Qed. Definition of_pos x := - let (q,r) := Zdiv_eucl_POS x wB in (N_of_Z q, r). + let (q,r) := Z.pos_div_eucl x wB in (N_of_Z q, r). Lemma spec_of_pos : forall p, - Zpos p = (Z_of_N (fst (of_pos p)))*wB + [|(snd (of_pos p))|]. + Zpos p = (Z.of_N (fst (of_pos p)))*wB + [|(snd (of_pos p))|]. Proof. intros; unfold of_pos; simpl. generalize (Z_div_mod_POS wB wB_pos p). - destruct (Zdiv_eucl_POS p wB); simpl; destruct 1. + destruct (Z.pos_div_eucl p wB); simpl; destruct 1. unfold to_Z; rewrite Zmod_small; auto. assert (0 <= z). replace z with (Zpos p / wB) by (symmetry; apply Zdiv_unique with z0; auto). apply Z_div_pos; auto with zarith. - replace (Z_of_N (N_of_Z z)) with z by + replace (Z.of_N (N_of_Z z)) with z by (destruct z; simpl; auto; elim H1; auto). - rewrite Zmult_comm; auto. + rewrite Z.mul_comm; auto. Qed. Lemma spec_zdigits : [|zdigits|] = Zpos digits. @@ -118,7 +118,7 @@ Section ZModulo. unfold to_Z, one. apply Zmod_small; split; auto with zarith. unfold wB, base. - apply Zlt_trans with (Zpos digits); auto. + apply Z.lt_trans with (Zpos digits); auto. apply Zpower2_lt_lin; auto with zarith. Qed. @@ -128,14 +128,14 @@ Section ZModulo. apply Zmod_small; split; auto with zarith. unfold wB, base. cut (1 <= 2 ^ Zpos digits); auto with zarith. - apply Zle_trans with (Zpos digits); auto with zarith. + apply Z.le_trans with (Zpos digits); auto with zarith. apply Zpower2_le_lin; auto with zarith. Qed. - Definition compare x y := Zcompare [|x|] [|y|]. + Definition compare x y := Z.compare [|x|] [|y|]. Lemma spec_compare : forall x y, - compare x y = Zcompare [|x|] [|y|]. + compare x y = Z.compare [|x|] [|y|]. Proof. reflexivity. Qed. Definition eq0 x := @@ -183,7 +183,7 @@ Section ZModulo. Qed. Definition succ_c x := - let y := Zsucc x in + let y := Z.succ x in if eq0 y then C1 0 else C0 y. Definition add_c x y := @@ -194,29 +194,28 @@ Section ZModulo. let z := [|x|]+[|y|]+1 in if Z_lt_le_dec z wB then C0 z else C1 (z-wB). - Definition succ := Zsucc. - Definition add := Zplus. + Definition succ := Z.succ. + Definition add := Z.add. Definition add_carry x y := x + y + 1. Lemma Zmod_equal : forall x y z, z>0 -> (x-y) mod z = 0 -> x mod z = y mod z. Proof. intros. - generalize (Z_div_mod_eq (x-y) z H); rewrite H0, Zplus_0_r. + generalize (Z_div_mod_eq (x-y) z H); rewrite H0, Z.add_0_r. remember ((x-y)/z) as k. - intros H1; symmetry in H1; rewrite <- Zeq_plus_swap in H1. - subst x. - rewrite Zplus_comm, Zmult_comm, Z_mod_plus; auto. + rewrite Z.sub_move_r, Z.add_comm, Z.mul_comm. intros ->. + now apply Z_mod_plus. Qed. Lemma spec_succ_c : forall x, [+|succ_c x|] = [|x|] + 1. Proof. - intros; unfold succ_c, to_Z, Zsucc. + intros; unfold succ_c, to_Z, Z.succ. case_eq (eq0 (x+1)); intros; unfold interp_carry. - rewrite Zmult_1_l. + rewrite Z.mul_1_l. replace (wB + 0 mod wB) with wB by auto with zarith. - symmetry; rewrite Zeq_plus_swap. + symmetry. rewrite Z.add_move_r. assert ((x+1) mod wB = 0) by (apply spec_eq0; auto). replace (wB-1) with ((wB-1) mod wB) by (apply Zmod_small; generalize wB_pos; omega). @@ -227,7 +226,7 @@ Section ZModulo. unfold eq0, to_Z in *; now destruct ((x+1) mod wB). assert (x mod wB + 1 <> wB). contradict H0. - rewrite Zeq_plus_swap in H0; simpl in H0. + rewrite Z.add_move_r in H0; simpl in H0. rewrite <- Zplus_mod_idemp_l; rewrite H0. replace (wB-1+1) with wB; auto with zarith; apply Z_mod_same; auto. rewrite <- Zplus_mod_idemp_l. @@ -241,7 +240,7 @@ Section ZModulo. destruct Z_lt_le_dec. apply Zmod_small; generalize (Z_mod_lt x wB wB_pos) (Z_mod_lt y wB wB_pos); omega. - rewrite Zmult_1_l, Zplus_comm, Zeq_plus_swap. + rewrite Z.mul_1_l, Z.add_comm, Z.add_move_r. apply Zmod_small; generalize (Z_mod_lt x wB wB_pos) (Z_mod_lt y wB wB_pos); omega. Qed. @@ -252,14 +251,14 @@ Section ZModulo. destruct Z_lt_le_dec. apply Zmod_small; generalize (Z_mod_lt x wB wB_pos) (Z_mod_lt y wB wB_pos); omega. - rewrite Zmult_1_l, Zplus_comm, Zeq_plus_swap. + rewrite Z.mul_1_l, Z.add_comm, Z.add_move_r. apply Zmod_small; generalize (Z_mod_lt x wB wB_pos) (Z_mod_lt y wB wB_pos); omega. Qed. Lemma spec_succ : forall x, [|succ x|] = ([|x|] + 1) mod wB. Proof. - intros; unfold succ, to_Z, Zsucc. + intros; unfold succ, to_Z, Z.succ. symmetry; apply Zplus_mod_idemp_l. Qed. @@ -288,8 +287,8 @@ Section ZModulo. let z := [|x|]-[|y|]-1 in if Z_lt_le_dec z 0 then C1 (wB+z) else C0 z. - Definition pred := Zpred. - Definition sub := Zminus. + Definition pred := Z.pred. + Definition sub := Z.sub. Definition sub_carry x y := x - y - 1. Lemma spec_pred_c : forall x, [-|pred_c x|] = [|x|] - 1. @@ -337,7 +336,7 @@ Section ZModulo. Lemma spec_pred : forall x, [|pred x|] = ([|x|] - 1) mod wB. Proof. - intros; unfold pred, to_Z, Zpred. + intros; unfold pred, to_Z, Z.pred. rewrite <- Zplus_mod_idemp_l; auto. Qed. @@ -357,19 +356,19 @@ Section ZModulo. Qed. Definition mul_c x y := - let (h,l) := Zdiv_eucl ([|x|]*[|y|]) wB in + let (h,l) := Z.div_eucl ([|x|]*[|y|]) wB in if eq0 h then if eq0 l then W0 else WW h l else WW h l. - Definition mul := Zmult. + Definition mul := Z.mul. Definition square_c x := mul_c x x. Lemma spec_mul_c : forall x y, [|| mul_c x y ||] = [|x|] * [|y|]. Proof. intros; unfold mul_c, zn2z_to_Z. - assert (Zdiv_eucl ([|x|]*[|y|]) wB = (([|x|]*[|y|])/wB,([|x|]*[|y|]) mod wB)). - unfold Zmod, Zdiv; destruct Zdiv_eucl; auto. - generalize (Z_div_mod ([|x|]*[|y|]) wB wB_pos); destruct Zdiv_eucl as (h,l). + assert (Z.div_eucl ([|x|]*[|y|]) wB = (([|x|]*[|y|])/wB,([|x|]*[|y|]) mod wB)). + unfold Z.modulo, Z.div; destruct Z.div_eucl; auto. + generalize (Z_div_mod ([|x|]*[|y|]) wB wB_pos); destruct Z.div_eucl as (h,l). destruct 1; injection H; clear H; intros. rewrite H0. assert ([|l|] = l). @@ -380,7 +379,7 @@ Section ZModulo. split. apply Z_div_pos; auto with zarith. apply Zdiv_lt_upper_bound; auto with zarith. - apply Zmult_lt_compat; auto with zarith. + apply Z.mul_lt_mono_nonneg; auto with zarith. clear H H0 H1 H2. case_eq (eq0 h); simpl; intros. case_eq (eq0 l); simpl; intros. @@ -399,7 +398,7 @@ Section ZModulo. intros x; exact (spec_mul_c x x). Qed. - Definition div x y := Zdiv_eucl [|x|] [|y|]. + Definition div x y := Z.div_eucl [|x|] [|y|]. Lemma spec_div : forall a b, 0 < [|b|] -> let (q,r) := div a b in @@ -408,10 +407,10 @@ Section ZModulo. Proof. intros; unfold div. assert ([|b|]>0) by auto with zarith. - assert (Zdiv_eucl [|a|] [|b|] = ([|a|]/[|b|], [|a|] mod [|b|])). - unfold Zmod, Zdiv; destruct Zdiv_eucl; auto. + assert (Z.div_eucl [|a|] [|b|] = ([|a|]/[|b|], [|a|] mod [|b|])). + unfold Z.modulo, Z.div; destruct Z.div_eucl; auto. generalize (Z_div_mod [|a|] [|b|] H0). - destruct Zdiv_eucl as (q,r); destruct 1; intros. + destruct Z.div_eucl as (q,r); destruct 1; intros. injection H1; clear H1; intros. assert ([|r|]=r). apply Zmod_small; generalize (Z_mod_lt b wB wB_pos); fold [|b|]; @@ -422,10 +421,10 @@ Section ZModulo. split. apply Z_div_pos; auto with zarith. apply Zdiv_lt_upper_bound; auto with zarith. - apply Zlt_le_trans with (wB*1). - rewrite Zmult_1_r; auto with zarith. - apply Zmult_le_compat; generalize wB_pos; auto with zarith. - rewrite H5, H6; rewrite Zmult_comm; auto with zarith. + apply Z.lt_le_trans with (wB*1). + rewrite Z.mul_1_r; auto with zarith. + apply Z.mul_le_mono_nonneg; generalize wB_pos; auto with zarith. + rewrite H5, H6; rewrite Z.mul_comm; auto with zarith. Qed. Definition div_gt := div. @@ -458,28 +457,28 @@ Section ZModulo. intros; apply spec_modulo; auto. Qed. - Definition gcd x y := Zgcd [|x|] [|y|]. - Definition gcd_gt x y := Zgcd [|x|] [|y|]. + Definition gcd x y := Z.gcd [|x|] [|y|]. + Definition gcd_gt x y := Z.gcd [|x|] [|y|]. - Lemma Zgcd_bound : forall a b, 0<=a -> 0<=b -> Zgcd a b <= Zmax a b. + Lemma Zgcd_bound : forall a b, 0<=a -> 0<=b -> Z.gcd a b <= Z.max a b. Proof. intros. generalize (Zgcd_is_gcd a b); inversion_clear 1. destruct H2 as (q,H2); destruct H3 as (q',H3); clear H4. - assert (H4:=Zgcd_is_pos a b). - destruct (Z_eq_dec (Zgcd a b) 0). + assert (H4:=Z.gcd_nonneg a b). + destruct (Z.eq_dec (Z.gcd a b) 0). rewrite e; generalize (Zmax_spec a b); omega. assert (0 <= q). - apply Zmult_le_reg_r with (Zgcd a b); auto with zarith. - destruct (Z_eq_dec q 0). + apply Z.mul_le_mono_pos_r with (Z.gcd a b); auto with zarith. + destruct (Z.eq_dec q 0). subst q; simpl in *; subst a; simpl; auto. generalize (Zmax_spec 0 b) (Zabs_spec b); omega. - apply Zle_trans with a. + apply Z.le_trans with a. rewrite H2 at 2. - rewrite <- (Zmult_1_l (Zgcd a b)) at 1. - apply Zmult_le_compat; auto with zarith. + rewrite <- (Z.mul_1_l (Z.gcd a b)) at 1. + apply Z.mul_le_mono_nonneg; auto with zarith. generalize (Zmax_spec a b); omega. Qed. @@ -488,12 +487,12 @@ Section ZModulo. intros; unfold gcd. generalize (Z_mod_lt a wB wB_pos)(Z_mod_lt b wB wB_pos); intros. fold [|a|] in *; fold [|b|] in *. - replace ([|Zgcd [|a|] [|b|]|]) with (Zgcd [|a|] [|b|]). + replace ([|Z.gcd [|a|] [|b|]|]) with (Z.gcd [|a|] [|b|]). apply Zgcd_is_gcd. symmetry; apply Zmod_small. split. - apply Zgcd_is_pos. - apply Zle_lt_trans with (Zmax [|a|] [|b|]). + apply Z.gcd_nonneg. + apply Z.le_lt_trans with (Z.max [|a|] [|b|]). apply Zgcd_bound; auto with zarith. generalize (Zmax_spec [|a|] [|b|]); omega. Qed. @@ -505,7 +504,7 @@ Section ZModulo. Qed. Definition div21 a1 a2 b := - Zdiv_eucl ([|a1|]*wB+[|a2|]) [|b|]. + Z.div_eucl ([|a1|]*wB+[|a2|]) [|b|]. Lemma spec_div21 : forall a1 a2 b, wB/2 <= [|b|] -> @@ -519,10 +518,10 @@ Section ZModulo. generalize (Z_mod_lt a2 wB wB_pos); fold [|a2|]; intros. assert ([|b|]>0) by auto with zarith. remember ([|a1|]*wB+[|a2|]) as a. - assert (Zdiv_eucl a [|b|] = (a/[|b|], a mod [|b|])). - unfold Zmod, Zdiv; destruct Zdiv_eucl; auto. + assert (Z.div_eucl a [|b|] = (a/[|b|], a mod [|b|])). + unfold Z.modulo, Z.div; destruct Z.div_eucl; auto. generalize (Z_div_mod a [|b|] H3). - destruct Zdiv_eucl as (q,r); destruct 1; intros. + destruct Z.div_eucl as (q,r); destruct 1; intros. injection H4; clear H4; intros. assert ([|r|]=r). apply Zmod_small; generalize (Z_mod_lt b wB wB_pos); fold [|b|]; @@ -536,8 +535,8 @@ Section ZModulo. apply Zdiv_lt_upper_bound; auto with zarith. subst a. replace (wB*[|b|]) with (([|b|]-1)*wB + wB) by ring. - apply Zlt_le_trans with ([|a1|]*wB+wB); auto with zarith. - rewrite H8, H9; rewrite Zmult_comm; auto with zarith. + apply Z.lt_le_trans with ([|a1|]*wB+wB); auto with zarith. + rewrite H8, H9; rewrite Z.mul_comm; auto with zarith. Qed. Definition add_mul_div p x y := @@ -560,17 +559,17 @@ Section ZModulo. generalize (Z_mod_lt [|w|] (2 ^ [|p|])); intros. split. destruct H; auto with zarith. - apply Zle_lt_trans with [|w|]; auto with zarith. + apply Z.le_lt_trans with [|w|]; auto with zarith. apply Zmod_le; auto with zarith. Qed. Definition is_even x := - if Z_eq_dec ([|x|] mod 2) 0 then true else false. + if Z.eq_dec ([|x|] mod 2) 0 then true else false. Lemma spec_is_even : forall x, if is_even x then [|x|] mod 2 = 0 else [|x|] mod 2 = 1. Proof. - intros; unfold is_even; destruct Z_eq_dec; auto. + intros; unfold is_even; destruct Z.eq_dec; auto. generalize (Z_mod_lt [|x|] 2); omega. Qed. @@ -580,12 +579,12 @@ Section ZModulo. Proof. intros. unfold sqrt. - repeat rewrite Zpower_2. + repeat rewrite Z.pow_2_r. replace [|Z.sqrt [|x|]|] with (Z.sqrt [|x|]). apply Z.sqrt_spec; auto with zarith. symmetry; apply Zmod_small. split. apply Z.sqrt_nonneg; auto. - apply Zle_lt_trans with [|x|]; auto. + apply Z.le_lt_trans with [|x|]; auto. apply Z.sqrt_le_lin; auto. Qed. @@ -616,22 +615,22 @@ Section ZModulo. destruct (Z_lt_le_dec s wB); auto. assert (wB * wB <= Zpos p). rewrite U. - apply Zle_trans with (s*s); try omega. - apply Zmult_le_compat; generalize wB_pos; auto with zarith. + apply Z.le_trans with (s*s); try omega. + apply Z.mul_le_mono_nonneg; generalize wB_pos; auto with zarith. assert (Zpos p < wB*wB). rewrite Heqz. replace (wB*wB) with ((wB-1)*wB+wB) by ring. - apply Zplus_le_lt_compat; auto with zarith. - apply Zmult_le_compat; auto with zarith. + apply Z.add_le_lt_mono; auto with zarith. + apply Z.mul_le_mono_nonneg; auto with zarith. generalize (spec_to_Z x); auto with zarith. generalize wB_pos; auto with zarith. omega. replace [|s|] with s by (symmetry; apply Zmod_small; auto with zarith). destruct Z_lt_le_dec; unfold interp_carry. replace [|r|] with r by (symmetry; apply Zmod_small; auto with zarith). - rewrite Zpower_2; auto with zarith. + rewrite Z.pow_2_r; auto with zarith. replace [|r-wB|] with (r-wB) by (symmetry; apply Zmod_small; auto with zarith). - rewrite Zpower_2; omega. + rewrite Z.pow_2_r; omega. assert (0<=Zneg p). rewrite Heqz; generalize wB_pos; auto with zarith. @@ -667,15 +666,15 @@ Section ZModulo. cut (log_inf x < p - 1); [omega| ]. apply IHx. change (Zpos x~1) with (2*(Zpos x)+1) in H. - replace p with (Zsucc (p-1)) in H; auto with zarith. - rewrite Zpower_Zsucc in H; auto with zarith. + replace p with (Z.succ (p-1)) in H; auto with zarith. + rewrite Z.pow_succ_r in H; auto with zarith. assert (0 < p) by (destruct p; compute; auto with zarith; discriminate). cut (log_inf x < p - 1); [omega| ]. apply IHx. change (Zpos x~0) with (2*(Zpos x)) in H. - replace p with (Zsucc (p-1)) in H; auto with zarith. - rewrite Zpower_Zsucc in H; auto with zarith. + replace p with (Z.succ (p-1)) in H; auto with zarith. + rewrite Z.pow_succ_r in H; auto with zarith. simpl; intros; destruct p; compute; auto with zarith. Qed. @@ -696,27 +695,27 @@ Section ZModulo. unfold zdigits. unfold wB, base in *. apply log_inf_bounded; auto with zarith. - apply Zlt_trans with zdigits. + apply Z.lt_trans with zdigits. omega. unfold zdigits, wB, base; apply Zpower2_lt_lin; auto with zarith. unfold to_Z; rewrite (Zmod_small _ _ H3). destruct H2. split. - apply Zle_trans with (2^(zdigits - log_inf p - 1)*(2^log_inf p)). + apply Z.le_trans with (2^(zdigits - log_inf p - 1)*(2^log_inf p)). apply Zdiv_le_upper_bound; auto with zarith. rewrite <- Zpower_exp; auto with zarith. - rewrite Zmult_comm; rewrite <- Zpower_Zsucc; auto with zarith. - replace (Zsucc (zdigits - log_inf p -1 +log_inf p)) with zdigits + rewrite Z.mul_comm; rewrite <- Z.pow_succ_r; auto with zarith. + replace (Z.succ (zdigits - log_inf p -1 +log_inf p)) with zdigits by ring. unfold wB, base, zdigits; auto with zarith. - apply Zmult_le_compat; auto with zarith. + apply Z.mul_le_mono_nonneg; auto with zarith. - apply Zlt_le_trans - with (2^(zdigits - log_inf p - 1)*(2^(Zsucc (log_inf p)))). - apply Zmult_lt_compat_l; auto with zarith. + apply Z.lt_le_trans + with (2^(zdigits - log_inf p - 1)*(2^(Z.succ (log_inf p)))). + apply Z.mul_lt_mono_pos_l; auto with zarith. rewrite <- Zpower_exp; auto with zarith. - replace (zdigits - log_inf p -1 +Zsucc (log_inf p)) with zdigits + replace (zdigits - log_inf p -1 +Z.succ (log_inf p)) with zdigits by ring. unfold wB, base, zdigits; auto with zarith. Qed. @@ -739,18 +738,18 @@ Section ZModulo. assert (d <> xH). intro; subst. compute in H; destruct p; discriminate. - assert (Zsucc (Zpos (Ppred d)) = Zpos d). + assert (Z.succ (Zpos (Pos.pred d)) = Zpos d). simpl; f_equal. - rewrite <- Pplus_one_succ_r. - destruct (Psucc_pred d); auto. + rewrite Pos.add_1_r. + destruct (Pos.succ_pred_or d); auto. rewrite H1 in H0; elim H0; auto. - assert (Ptail p < Zpos (Ppred d)). + assert (Ptail p < Zpos (Pos.pred d)). apply IHp. - apply Zmult_lt_reg_r with 2; auto with zarith. - rewrite (Zmult_comm (Zpos p)). + apply Z.mul_lt_mono_pos_r with 2; auto with zarith. + rewrite (Z.mul_comm (Zpos p)). change (2 * Zpos p) with (Zpos p~0). - rewrite Zmult_comm. - rewrite <- Zpower_Zsucc; auto with zarith. + rewrite Z.mul_comm. + rewrite <- Z.pow_succ_r; auto with zarith. rewrite H1; auto. rewrite <- H1; omega. Qed. @@ -779,20 +778,20 @@ Section ZModulo. apply Zmod_small. split; auto. unfold wB, base in *. - apply Zlt_trans with (Zpos digits). + apply Z.lt_trans with (Zpos digits). apply Ptail_bounded; auto with zarith. apply Zpower2_lt_lin; auto with zarith. rewrite H1. clear; induction p. - exists (Zpos p); simpl; rewrite Pmult_1_r; auto with zarith. + exists (Zpos p); simpl; rewrite Pos.mul_1_r; auto with zarith. destruct IHp as (y & Yp & Ye). exists y. split; auto. change (Zpos p~0) with (2*Zpos p). rewrite Ye. - change (Ptail p~0) with (Zsucc (Ptail p)). - rewrite Zpower_Zsucc; auto; ring. + change (Ptail p~0) with (Z.succ (Ptail p)). + rewrite Z.pow_succ_r; auto; ring. exists 0; simpl; auto with zarith. Qed. diff --git a/theories/Numbers/Integer/Abstract/ZAdd.v b/theories/Numbers/Integer/Abstract/ZAdd.v index 647ab0ac..ac113dfd 100644 --- a/theories/Numbers/Integer/Abstract/ZAdd.v +++ b/theories/Numbers/Integer/Abstract/ZAdd.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZAddOrder.v b/theories/Numbers/Integer/Abstract/ZAddOrder.v index 423cdf58..06ac0ba0 100644 --- a/theories/Numbers/Integer/Abstract/ZAddOrder.v +++ b/theories/Numbers/Integer/Abstract/ZAddOrder.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZAxioms.v b/theories/Numbers/Integer/Abstract/ZAxioms.v index fd20ce72..f2947c30 100644 --- a/theories/Numbers/Integer/Abstract/ZAxioms.v +++ b/theories/Numbers/Integer/Abstract/ZAxioms.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZBase.v b/theories/Numbers/Integer/Abstract/ZBase.v index 51054852..bc78a4b9 100644 --- a/theories/Numbers/Integer/Abstract/ZBase.v +++ b/theories/Numbers/Integer/Abstract/ZBase.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZBits.v b/theories/Numbers/Integer/Abstract/ZBits.v index 92afbcb5..1d410a02 100644 --- a/theories/Numbers/Integer/Abstract/ZBits.v +++ b/theories/Numbers/Integer/Abstract/ZBits.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -292,7 +292,7 @@ Proof. Qed. (** Hence the number of bits of [a] is [1+log2 a] - (see [Psize] and [Psize_pos]). + (see [Pos.size_nat] and [Pos.size]). *) (** For negative numbers, things are the other ways around: diff --git a/theories/Numbers/Integer/Abstract/ZDivEucl.v b/theories/Numbers/Integer/Abstract/ZDivEucl.v index fe951a75..dd8aa100 100644 --- a/theories/Numbers/Integer/Abstract/ZDivEucl.v +++ b/theories/Numbers/Integer/Abstract/ZDivEucl.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZDivFloor.v b/theories/Numbers/Integer/Abstract/ZDivFloor.v index 14003d89..2ccc79e9 100644 --- a/theories/Numbers/Integer/Abstract/ZDivFloor.v +++ b/theories/Numbers/Integer/Abstract/ZDivFloor.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -16,7 +16,7 @@ Require Import ZAxioms ZMulOrder ZSgnAbs NZDiv. [a = bq+r /\ 0 <= |r| < |b| /\ Sign(r) = Sign(b)] - This is the convention followed historically by [Zdiv] in Coq, and + This is the convention followed historically by [Z.div] in Coq, and corresponds to convention "F" in the following paper: R. Boute, "The Euclidean definition of the functions div and mod", diff --git a/theories/Numbers/Integer/Abstract/ZDivTrunc.v b/theories/Numbers/Integer/Abstract/ZDivTrunc.v index bd8b6ce2..d69d0e10 100644 --- a/theories/Numbers/Integer/Abstract/ZDivTrunc.v +++ b/theories/Numbers/Integer/Abstract/ZDivTrunc.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZGcd.v b/theories/Numbers/Integer/Abstract/ZGcd.v index 404fc0c4..feac10b3 100644 --- a/theories/Numbers/Integer/Abstract/ZGcd.v +++ b/theories/Numbers/Integer/Abstract/ZGcd.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZLcm.v b/theories/Numbers/Integer/Abstract/ZLcm.v index 06af04d1..45da2dee 100644 --- a/theories/Numbers/Integer/Abstract/ZLcm.v +++ b/theories/Numbers/Integer/Abstract/ZLcm.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZLt.v b/theories/Numbers/Integer/Abstract/ZLt.v index 3a8e1f38..96be5811 100644 --- a/theories/Numbers/Integer/Abstract/ZLt.v +++ b/theories/Numbers/Integer/Abstract/ZLt.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZMaxMin.v b/theories/Numbers/Integer/Abstract/ZMaxMin.v index 4e653fee..dc7598e3 100644 --- a/theories/Numbers/Integer/Abstract/ZMaxMin.v +++ b/theories/Numbers/Integer/Abstract/ZMaxMin.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZMul.v b/theories/Numbers/Integer/Abstract/ZMul.v index 36f9c3d5..c5fbd450 100644 --- a/theories/Numbers/Integer/Abstract/ZMul.v +++ b/theories/Numbers/Integer/Abstract/ZMul.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZMulOrder.v b/theories/Numbers/Integer/Abstract/ZMulOrder.v index d0d64faa..8edf97f4 100644 --- a/theories/Numbers/Integer/Abstract/ZMulOrder.v +++ b/theories/Numbers/Integer/Abstract/ZMulOrder.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZParity.v b/theories/Numbers/Integer/Abstract/ZParity.v index b364ec3f..13541309 100644 --- a/theories/Numbers/Integer/Abstract/ZParity.v +++ b/theories/Numbers/Integer/Abstract/ZParity.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZPow.v b/theories/Numbers/Integer/Abstract/ZPow.v index 53d84dce..d30cea33 100644 --- a/theories/Numbers/Integer/Abstract/ZPow.v +++ b/theories/Numbers/Integer/Abstract/ZPow.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -18,6 +18,17 @@ Module Type ZPowProp Include NZPowProp A A B. +(** A particular case of [pow_add_r], with no precondition *) + +Lemma pow_twice_r a b : a^(2*b) == a^b * a^b. +Proof. + rewrite two_succ. nzsimpl. + destruct (le_gt_cases 0 b). + - now rewrite pow_add_r. + - rewrite !pow_neg_r. now nzsimpl. trivial. + now apply add_neg_neg. +Qed. + (** Parity of power *) Lemma even_pow : forall a b, 0<b -> even (a^b) = even a. diff --git a/theories/Numbers/Integer/Abstract/ZProperties.v b/theories/Numbers/Integer/Abstract/ZProperties.v index c0455196..8973df35 100644 --- a/theories/Numbers/Integer/Abstract/ZProperties.v +++ b/theories/Numbers/Integer/Abstract/ZProperties.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZSgnAbs.v b/theories/Numbers/Integer/Abstract/ZSgnAbs.v index b2f6cc84..24b6003c 100644 --- a/theories/Numbers/Integer/Abstract/ZSgnAbs.v +++ b/theories/Numbers/Integer/Abstract/ZSgnAbs.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/BigZ/BigZ.v b/theories/Numbers/Integer/BigZ/BigZ.v index 443777f5..a56f90b0 100644 --- a/theories/Numbers/Integer/BigZ/BigZ.v +++ b/theories/Numbers/Integer/BigZ/BigZ.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -76,7 +76,7 @@ Infix "÷" := BigZ.quot (at level 40, left associativity) : bigZ_scope. (** Some additional results about [BigZ] *) Theorem spec_to_Z: forall n : bigZ, - BigN.to_Z (BigZ.to_N n) = ((Zsgn [n]) * [n])%Z. + BigN.to_Z (BigZ.to_N n) = ((Z.sgn [n]) * [n])%Z. Proof. intros n; case n; simpl; intros p; generalize (BigN.spec_pos p); case (BigN.to_Z p); auto. @@ -85,7 +85,7 @@ intros p1 H1; case H1; auto. Qed. Theorem spec_to_N n: - ([n] = Zsgn [n] * (BigN.to_Z (BigZ.to_N n)))%Z. + ([n] = Z.sgn [n] * (BigN.to_Z (BigZ.to_N n)))%Z. Proof. case n; simpl; intros p; generalize (BigN.spec_pos p); case (BigN.to_Z p); auto. @@ -118,7 +118,7 @@ Qed. Lemma BigZeqb_correct : forall x y, (x =? y) = true -> x==y. Proof. now apply BigZ.eqb_eq. Qed. -Definition BigZ_of_N n := BigZ.of_Z (Z_of_N n). +Definition BigZ_of_N n := BigZ.of_Z (Z.of_N n). Lemma BigZpower : power_theory 1 BigZ.mul BigZ.eq BigZ_of_N BigZ.pow. Proof. @@ -139,7 +139,7 @@ BigZ.zify. auto with zarith. intros NEQ. generalize (BigZ.spec_div_eucl a b). generalize (Z_div_mod_full [a] [b] NEQ). -destruct BigZ.div_eucl as (q,r), Zdiv_eucl as (q',r'). +destruct BigZ.div_eucl as (q,r), Z.div_eucl as (q',r'). intros (EQ,_). injection 1. intros EQr EQq. BigZ.zify. rewrite EQr, EQq; auto. Qed. diff --git a/theories/Numbers/Integer/BigZ/ZMake.v b/theories/Numbers/Integer/BigZ/ZMake.v index 0142b36b..180fe0a9 100644 --- a/theories/Numbers/Integer/BigZ/ZMake.v +++ b/theories/Numbers/Integer/BigZ/ZMake.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -21,92 +21,92 @@ Open Scope Z_scope. [NSig.NType] to a structure of integers [ZSig.ZType]. *) -Module Make (N:NType) <: ZType. +Module Make (NN:NType) <: ZType. Inductive t_ := - | Pos : N.t -> t_ - | Neg : N.t -> t_. + | Pos : NN.t -> t_ + | Neg : NN.t -> t_. Definition t := t_. Bind Scope abstract_scope with t t_. - Definition zero := Pos N.zero. - Definition one := Pos N.one. - Definition two := Pos N.two. - Definition minus_one := Neg N.one. + Definition zero := Pos NN.zero. + Definition one := Pos NN.one. + Definition two := Pos NN.two. + Definition minus_one := Neg NN.one. Definition of_Z x := match x with - | Zpos x => Pos (N.of_N (Npos x)) + | Zpos x => Pos (NN.of_N (Npos x)) | Z0 => zero - | Zneg x => Neg (N.of_N (Npos x)) + | Zneg x => Neg (NN.of_N (Npos x)) end. Definition to_Z x := match x with - | Pos nx => N.to_Z nx - | Neg nx => Zopp (N.to_Z nx) + | Pos nx => NN.to_Z nx + | Neg nx => Z.opp (NN.to_Z nx) end. Theorem spec_of_Z: forall x, to_Z (of_Z x) = x. Proof. intros x; case x; unfold to_Z, of_Z, zero. - exact N.spec_0. - intros; rewrite N.spec_of_N; auto. - intros; rewrite N.spec_of_N; auto. + exact NN.spec_0. + intros; rewrite NN.spec_of_N; auto. + intros; rewrite NN.spec_of_N; auto. Qed. Definition eq x y := (to_Z x = to_Z y). Theorem spec_0: to_Z zero = 0. - exact N.spec_0. + exact NN.spec_0. Qed. Theorem spec_1: to_Z one = 1. - exact N.spec_1. + exact NN.spec_1. Qed. Theorem spec_2: to_Z two = 2. - exact N.spec_2. + exact NN.spec_2. Qed. Theorem spec_m1: to_Z minus_one = -1. - simpl; rewrite N.spec_1; auto. + simpl; rewrite NN.spec_1; auto. Qed. Definition compare x y := match x, y with - | Pos nx, Pos ny => N.compare nx ny + | Pos nx, Pos ny => NN.compare nx ny | Pos nx, Neg ny => - match N.compare nx N.zero with + match NN.compare nx NN.zero with | Gt => Gt - | _ => N.compare ny N.zero + | _ => NN.compare ny NN.zero end | Neg nx, Pos ny => - match N.compare N.zero nx with + match NN.compare NN.zero nx with | Lt => Lt - | _ => N.compare N.zero ny + | _ => NN.compare NN.zero ny end - | Neg nx, Neg ny => N.compare ny nx + | Neg nx, Neg ny => NN.compare ny nx end. Theorem spec_compare : - forall x y, compare x y = Zcompare (to_Z x) (to_Z y). + forall x y, compare x y = Z.compare (to_Z x) (to_Z y). Proof. unfold compare, to_Z. destruct x as [x|x], y as [y|y]; - rewrite ?N.spec_compare, ?N.spec_0, <-?Zcompare_opp; auto; - assert (Hx:=N.spec_pos x); assert (Hy:=N.spec_pos y); - set (X:=N.to_Z x) in *; set (Y:=N.to_Z y) in *; clearbody X Y. - destruct (Zcompare_spec X 0) as [EQ|LT|GT]. - rewrite EQ. rewrite <- Zopp_0 at 2. apply Zcompare_opp. - exfalso. omega. - symmetry. change (X > -Y). omega. - destruct (Zcompare_spec 0 X) as [EQ|LT|GT]. - rewrite <- EQ. rewrite Zopp_0; auto. - symmetry. change (-X < Y). omega. - exfalso. omega. + rewrite ?NN.spec_compare, ?NN.spec_0, ?Z.compare_opp; auto; + assert (Hx:=NN.spec_pos x); assert (Hy:=NN.spec_pos y); + set (X:=NN.to_Z x) in *; set (Y:=NN.to_Z y) in *; clearbody X Y. + - destruct (Z.compare_spec X 0) as [EQ|LT|GT]. + + rewrite <- Z.opp_0 in EQ. now rewrite EQ, Z.compare_opp. + + exfalso. omega. + + symmetry. change (X > -Y). omega. + - destruct (Z.compare_spec 0 X) as [EQ|LT|GT]. + + rewrite <- EQ, Z.opp_0; auto. + + symmetry. change (-X < Y). omega. + + exfalso. omega. Qed. Definition eqb x y := @@ -155,14 +155,14 @@ Module Make (N:NType) <: ZType. Definition min n m := match compare n m with Gt => m | _ => n end. Definition max n m := match compare n m with Lt => m | _ => n end. - Theorem spec_min : forall n m, to_Z (min n m) = Zmin (to_Z n) (to_Z m). + Theorem spec_min : forall n m, to_Z (min n m) = Z.min (to_Z n) (to_Z m). Proof. - unfold min, Zmin. intros. rewrite spec_compare. destruct Zcompare; auto. + unfold min, Z.min. intros. rewrite spec_compare. destruct Z.compare; auto. Qed. - Theorem spec_max : forall n m, to_Z (max n m) = Zmax (to_Z n) (to_Z m). + Theorem spec_max : forall n m, to_Z (max n m) = Z.max (to_Z n) (to_Z m). Proof. - unfold max, Zmax. intros. rewrite spec_compare. destruct Zcompare; auto. + unfold max, Z.max. intros. rewrite spec_compare. destruct Z.compare; auto. Qed. Definition to_N x := @@ -173,11 +173,11 @@ Module Make (N:NType) <: ZType. Definition abs x := Pos (to_N x). - Theorem spec_abs: forall x, to_Z (abs x) = Zabs (to_Z x). + Theorem spec_abs: forall x, to_Z (abs x) = Z.abs (to_Z x). Proof. - intros x; case x; clear x; intros x; assert (F:=N.spec_pos x). - simpl; rewrite Zabs_eq; auto. - simpl; rewrite Zabs_non_eq; simpl; auto with zarith. + intros x; case x; clear x; intros x; assert (F:=NN.spec_pos x). + simpl; rewrite Z.abs_eq; auto. + simpl; rewrite Z.abs_neq; simpl; auto with zarith. Qed. Definition opp x := @@ -193,10 +193,10 @@ Module Make (N:NType) <: ZType. Definition succ x := match x with - | Pos n => Pos (N.succ n) + | Pos n => Pos (NN.succ n) | Neg n => - match N.compare N.zero n with - | Lt => Neg (N.pred n) + match NN.compare NN.zero n with + | Lt => Neg (NN.pred n) | _ => one end end. @@ -204,134 +204,134 @@ Module Make (N:NType) <: ZType. Theorem spec_succ: forall n, to_Z (succ n) = to_Z n + 1. Proof. intros x; case x; clear x; intros x. - exact (N.spec_succ x). - simpl. rewrite N.spec_compare. case Zcompare_spec; rewrite ?N.spec_0; simpl. - intros HH; rewrite <- HH; rewrite N.spec_1; ring. - intros HH; rewrite N.spec_pred, Zmax_r; auto with zarith. - generalize (N.spec_pos x); auto with zarith. + exact (NN.spec_succ x). + simpl. rewrite NN.spec_compare. case Z.compare_spec; rewrite ?NN.spec_0; simpl. + intros HH; rewrite <- HH; rewrite NN.spec_1; ring. + intros HH; rewrite NN.spec_pred, Z.max_r; auto with zarith. + generalize (NN.spec_pos x); auto with zarith. Qed. Definition add x y := match x, y with - | Pos nx, Pos ny => Pos (N.add nx ny) + | Pos nx, Pos ny => Pos (NN.add nx ny) | Pos nx, Neg ny => - match N.compare nx ny with - | Gt => Pos (N.sub nx ny) + match NN.compare nx ny with + | Gt => Pos (NN.sub nx ny) | Eq => zero - | Lt => Neg (N.sub ny nx) + | Lt => Neg (NN.sub ny nx) end | Neg nx, Pos ny => - match N.compare nx ny with - | Gt => Neg (N.sub nx ny) + match NN.compare nx ny with + | Gt => Neg (NN.sub nx ny) | Eq => zero - | Lt => Pos (N.sub ny nx) + | Lt => Pos (NN.sub ny nx) end - | Neg nx, Neg ny => Neg (N.add nx ny) + | Neg nx, Neg ny => Neg (NN.add nx ny) end. Theorem spec_add: forall x y, to_Z (add x y) = to_Z x + to_Z y. Proof. unfold add, to_Z; intros [x | x] [y | y]; - try (rewrite N.spec_add; auto with zarith); - rewrite N.spec_compare; case Zcompare_spec; - unfold zero; rewrite ?N.spec_0, ?N.spec_sub; omega with *. + try (rewrite NN.spec_add; auto with zarith); + rewrite NN.spec_compare; case Z.compare_spec; + unfold zero; rewrite ?NN.spec_0, ?NN.spec_sub; omega with *. Qed. Definition pred x := match x with | Pos nx => - match N.compare N.zero nx with - | Lt => Pos (N.pred nx) + match NN.compare NN.zero nx with + | Lt => Pos (NN.pred nx) | _ => minus_one end - | Neg nx => Neg (N.succ nx) + | Neg nx => Neg (NN.succ nx) end. Theorem spec_pred: forall x, to_Z (pred x) = to_Z x - 1. Proof. unfold pred, to_Z, minus_one; intros [x | x]; - try (rewrite N.spec_succ; ring). - rewrite N.spec_compare; case Zcompare_spec; - rewrite ?N.spec_0, ?N.spec_1, ?N.spec_pred; - generalize (N.spec_pos x); omega with *. + try (rewrite NN.spec_succ; ring). + rewrite NN.spec_compare; case Z.compare_spec; + rewrite ?NN.spec_0, ?NN.spec_1, ?NN.spec_pred; + generalize (NN.spec_pos x); omega with *. Qed. Definition sub x y := match x, y with | Pos nx, Pos ny => - match N.compare nx ny with - | Gt => Pos (N.sub nx ny) + match NN.compare nx ny with + | Gt => Pos (NN.sub nx ny) | Eq => zero - | Lt => Neg (N.sub ny nx) + | Lt => Neg (NN.sub ny nx) end - | Pos nx, Neg ny => Pos (N.add nx ny) - | Neg nx, Pos ny => Neg (N.add nx ny) + | Pos nx, Neg ny => Pos (NN.add nx ny) + | Neg nx, Pos ny => Neg (NN.add nx ny) | Neg nx, Neg ny => - match N.compare nx ny with - | Gt => Neg (N.sub nx ny) + match NN.compare nx ny with + | Gt => Neg (NN.sub nx ny) | Eq => zero - | Lt => Pos (N.sub ny nx) + | Lt => Pos (NN.sub ny nx) end end. Theorem spec_sub: forall x y, to_Z (sub x y) = to_Z x - to_Z y. Proof. unfold sub, to_Z; intros [x | x] [y | y]; - try (rewrite N.spec_add; auto with zarith); - rewrite N.spec_compare; case Zcompare_spec; - unfold zero; rewrite ?N.spec_0, ?N.spec_sub; omega with *. + try (rewrite NN.spec_add; auto with zarith); + rewrite NN.spec_compare; case Z.compare_spec; + unfold zero; rewrite ?NN.spec_0, ?NN.spec_sub; omega with *. Qed. Definition mul x y := match x, y with - | Pos nx, Pos ny => Pos (N.mul nx ny) - | Pos nx, Neg ny => Neg (N.mul nx ny) - | Neg nx, Pos ny => Neg (N.mul nx ny) - | Neg nx, Neg ny => Pos (N.mul nx ny) + | Pos nx, Pos ny => Pos (NN.mul nx ny) + | Pos nx, Neg ny => Neg (NN.mul nx ny) + | Neg nx, Pos ny => Neg (NN.mul nx ny) + | Neg nx, Neg ny => Pos (NN.mul nx ny) end. Theorem spec_mul: forall x y, to_Z (mul x y) = to_Z x * to_Z y. Proof. - unfold mul, to_Z; intros [x | x] [y | y]; rewrite N.spec_mul; ring. + unfold mul, to_Z; intros [x | x] [y | y]; rewrite NN.spec_mul; ring. Qed. Definition square x := match x with - | Pos nx => Pos (N.square nx) - | Neg nx => Pos (N.square nx) + | Pos nx => Pos (NN.square nx) + | Neg nx => Pos (NN.square nx) end. Theorem spec_square: forall x, to_Z (square x) = to_Z x * to_Z x. Proof. - unfold square, to_Z; intros [x | x]; rewrite N.spec_square; ring. + unfold square, to_Z; intros [x | x]; rewrite NN.spec_square; ring. Qed. Definition pow_pos x p := match x with - | Pos nx => Pos (N.pow_pos nx p) + | Pos nx => Pos (NN.pow_pos nx p) | Neg nx => match p with | xH => x - | xO _ => Pos (N.pow_pos nx p) - | xI _ => Neg (N.pow_pos nx p) + | xO _ => Pos (NN.pow_pos nx p) + | xI _ => Neg (NN.pow_pos nx p) end end. Theorem spec_pow_pos: forall x n, to_Z (pow_pos x n) = to_Z x ^ Zpos n. Proof. assert (F0: forall x, (-x)^2 = x^2). - intros x; rewrite Zpower_2; ring. + intros x; rewrite Z.pow_2_r; ring. unfold pow_pos, to_Z; intros [x | x] [p | p |]; - try rewrite N.spec_pow_pos; try ring. + try rewrite NN.spec_pow_pos; try ring. assert (F: 0 <= 2 * Zpos p). assert (0 <= Zpos p); auto with zarith. - rewrite Zpos_xI; repeat rewrite Zpower_exp; auto with zarith. - repeat rewrite Zpower_mult; auto with zarith. + rewrite Pos2Z.inj_xI; repeat rewrite Zpower_exp; auto with zarith. + repeat rewrite Z.pow_mul_r; auto with zarith. rewrite F0; ring. assert (F: 0 <= 2 * Zpos p). assert (0 <= Zpos p); auto with zarith. - rewrite Zpos_xO; repeat rewrite Zpower_exp; auto with zarith. - repeat rewrite Zpower_mult; auto with zarith. + rewrite Pos2Z.inj_xO; repeat rewrite Zpower_exp; auto with zarith. + repeat rewrite Z.pow_mul_r; auto with zarith. rewrite F0; ring. Qed. @@ -341,9 +341,9 @@ Module Make (N:NType) <: ZType. | Npos p => pow_pos x p end. - Theorem spec_pow_N: forall x n, to_Z (pow_N x n) = to_Z x ^ Z_of_N n. + Theorem spec_pow_N: forall x n, to_Z (pow_N x n) = to_Z x ^ Z.of_N n. Proof. - destruct n; simpl. apply N.spec_1. + destruct n; simpl. apply NN.spec_1. apply spec_pow_pos. Qed. @@ -357,38 +357,38 @@ Module Make (N:NType) <: ZType. Theorem spec_pow: forall x y, to_Z (pow x y) = to_Z x ^ to_Z y. Proof. intros. unfold pow. destruct (to_Z y); simpl. - apply N.spec_1. + apply NN.spec_1. apply spec_pow_pos. - apply N.spec_0. + apply NN.spec_0. Qed. Definition log2 x := match x with - | Pos nx => Pos (N.log2 nx) + | Pos nx => Pos (NN.log2 nx) | Neg nx => zero end. Theorem spec_log2: forall x, to_Z (log2 x) = Z.log2 (to_Z x). Proof. - intros. destruct x as [p|p]; simpl. apply N.spec_log2. - rewrite N.spec_0. - destruct (Z_le_lt_eq_dec _ _ (N.spec_pos p)) as [LT|EQ]. + intros. destruct x as [p|p]; simpl. apply NN.spec_log2. + rewrite NN.spec_0. + destruct (Z_le_lt_eq_dec _ _ (NN.spec_pos p)) as [LT|EQ]. rewrite Z.log2_nonpos; auto with zarith. now rewrite <- EQ. Qed. Definition sqrt x := match x with - | Pos nx => Pos (N.sqrt nx) - | Neg nx => Neg N.zero + | Pos nx => Pos (NN.sqrt nx) + | Neg nx => Neg NN.zero end. Theorem spec_sqrt: forall x, to_Z (sqrt x) = Z.sqrt (to_Z x). Proof. destruct x as [p|p]; simpl. - apply N.spec_sqrt. - rewrite N.spec_0. - destruct (Z_le_lt_eq_dec _ _ (N.spec_pos p)) as [LT|EQ]. + apply NN.spec_sqrt. + rewrite NN.spec_0. + destruct (Z_le_lt_eq_dec _ _ (NN.spec_pos p)) as [LT|EQ]. rewrite Z.sqrt_neg; auto with zarith. now rewrite <- EQ. Qed. @@ -396,68 +396,68 @@ Module Make (N:NType) <: ZType. Definition div_eucl x y := match x, y with | Pos nx, Pos ny => - let (q, r) := N.div_eucl nx ny in + let (q, r) := NN.div_eucl nx ny in (Pos q, Pos r) | Pos nx, Neg ny => - let (q, r) := N.div_eucl nx ny in - if N.eqb N.zero r + let (q, r) := NN.div_eucl nx ny in + if NN.eqb NN.zero r then (Neg q, zero) - else (Neg (N.succ q), Neg (N.sub ny r)) + else (Neg (NN.succ q), Neg (NN.sub ny r)) | Neg nx, Pos ny => - let (q, r) := N.div_eucl nx ny in - if N.eqb N.zero r + let (q, r) := NN.div_eucl nx ny in + if NN.eqb NN.zero r then (Neg q, zero) - else (Neg (N.succ q), Pos (N.sub ny r)) + else (Neg (NN.succ q), Pos (NN.sub ny r)) | Neg nx, Neg ny => - let (q, r) := N.div_eucl nx ny in + let (q, r) := NN.div_eucl nx ny in (Pos q, Neg r) end. Ltac break_nonneg x px EQx := let H := fresh "H" in - assert (H:=N.spec_pos x); - destruct (N.to_Z x) as [|px|px]_eqn:EQx; + assert (H:=NN.spec_pos x); + destruct (NN.to_Z x) as [|px|px] eqn:EQx; [clear H|clear H|elim H; reflexivity]. Theorem spec_div_eucl: forall x y, let (q,r) := div_eucl x y in - (to_Z q, to_Z r) = Zdiv_eucl (to_Z x) (to_Z y). + (to_Z q, to_Z r) = Z.div_eucl (to_Z x) (to_Z y). Proof. unfold div_eucl, to_Z. intros [x | x] [y | y]. (* Pos Pos *) - generalize (N.spec_div_eucl x y); destruct (N.div_eucl x y); auto. + generalize (NN.spec_div_eucl x y); destruct (NN.div_eucl x y); auto. (* Pos Neg *) - generalize (N.spec_div_eucl x y); destruct (N.div_eucl x y) as (q,r). + generalize (NN.spec_div_eucl x y); destruct (NN.div_eucl x y) as (q,r). break_nonneg x px EQx; break_nonneg y py EQy; - try (injection 1; intros Hr Hq; rewrite N.spec_eqb, N.spec_0, Hr; - simpl; rewrite Hq, N.spec_0; auto). + try (injection 1; intros Hr Hq; rewrite NN.spec_eqb, NN.spec_0, Hr; + simpl; rewrite Hq, NN.spec_0; auto). change (- Zpos py) with (Zneg py). assert (GT : Zpos py > 0) by (compute; auto). generalize (Z_div_mod (Zpos px) (Zpos py) GT). - unfold Zdiv_eucl. destruct (Zdiv_eucl_POS px (Zpos py)) as (q',r'). + unfold Z.div_eucl. destruct (Z.pos_div_eucl px (Zpos py)) as (q',r'). intros (EQ,MOD). injection 1. intros Hr' Hq'. - rewrite N.spec_eqb, N.spec_0, Hr'. + rewrite NN.spec_eqb, NN.spec_0, Hr'. break_nonneg r pr EQr. - subst; simpl. rewrite N.spec_0; auto. + subst; simpl. rewrite NN.spec_0; auto. subst. lazy iota beta delta [Z.eqb]. - rewrite N.spec_sub, N.spec_succ, EQy, EQr. f_equal. omega with *. + rewrite NN.spec_sub, NN.spec_succ, EQy, EQr. f_equal. omega with *. (* Neg Pos *) - generalize (N.spec_div_eucl x y); destruct (N.div_eucl x y) as (q,r). + generalize (NN.spec_div_eucl x y); destruct (NN.div_eucl x y) as (q,r). break_nonneg x px EQx; break_nonneg y py EQy; - try (injection 1; intros Hr Hq; rewrite N.spec_eqb, N.spec_0, Hr; - simpl; rewrite Hq, N.spec_0; auto). + try (injection 1; intros Hr Hq; rewrite NN.spec_eqb, NN.spec_0, Hr; + simpl; rewrite Hq, NN.spec_0; auto). change (- Zpos px) with (Zneg px). assert (GT : Zpos py > 0) by (compute; auto). generalize (Z_div_mod (Zpos px) (Zpos py) GT). - unfold Zdiv_eucl. destruct (Zdiv_eucl_POS px (Zpos py)) as (q',r'). + unfold Z.div_eucl. destruct (Z.pos_div_eucl px (Zpos py)) as (q',r'). intros (EQ,MOD). injection 1. intros Hr' Hq'. - rewrite N.spec_eqb, N.spec_0, Hr'. + rewrite NN.spec_eqb, NN.spec_0, Hr'. break_nonneg r pr EQr. - subst; simpl. rewrite N.spec_0; auto. + subst; simpl. rewrite NN.spec_0; auto. subst. lazy iota beta delta [Z.eqb]. - rewrite N.spec_sub, N.spec_succ, EQy, EQr. f_equal. omega with *. + rewrite NN.spec_sub, NN.spec_succ, EQy, EQr. f_equal. omega with *. (* Neg Neg *) - generalize (N.spec_div_eucl x y); destruct (N.div_eucl x y) as (q,r). + generalize (NN.spec_div_eucl x y); destruct (NN.div_eucl x y) as (q,r). break_nonneg x px EQx; break_nonneg y py EQy; try (injection 1; intros Hr Hq; rewrite Hr, Hq; auto). simpl. intros <-; auto. @@ -468,8 +468,8 @@ Module Make (N:NType) <: ZType. Definition spec_div: forall x y, to_Z (div x y) = to_Z x / to_Z y. Proof. - intros x y; generalize (spec_div_eucl x y); unfold div, Zdiv. - case div_eucl; case Zdiv_eucl; simpl; auto. + intros x y; generalize (spec_div_eucl x y); unfold div, Z.div. + case div_eucl; case Z.div_eucl; simpl; auto. intros q r q11 r1 H; injection H; auto. Qed. @@ -478,38 +478,38 @@ Module Make (N:NType) <: ZType. Theorem spec_modulo: forall x y, to_Z (modulo x y) = to_Z x mod to_Z y. Proof. - intros x y; generalize (spec_div_eucl x y); unfold modulo, Zmod. - case div_eucl; case Zdiv_eucl; simpl; auto. + intros x y; generalize (spec_div_eucl x y); unfold modulo, Z.modulo. + case div_eucl; case Z.div_eucl; simpl; auto. intros q r q11 r1 H; injection H; auto. Qed. Definition quot x y := match x, y with - | Pos nx, Pos ny => Pos (N.div nx ny) - | Pos nx, Neg ny => Neg (N.div nx ny) - | Neg nx, Pos ny => Neg (N.div nx ny) - | Neg nx, Neg ny => Pos (N.div nx ny) + | Pos nx, Pos ny => Pos (NN.div nx ny) + | Pos nx, Neg ny => Neg (NN.div nx ny) + | Neg nx, Pos ny => Neg (NN.div nx ny) + | Neg nx, Neg ny => Pos (NN.div nx ny) end. Definition rem x y := if eqb y zero then x else match x, y with - | Pos nx, Pos ny => Pos (N.modulo nx ny) - | Pos nx, Neg ny => Pos (N.modulo nx ny) - | Neg nx, Pos ny => Neg (N.modulo nx ny) - | Neg nx, Neg ny => Neg (N.modulo nx ny) + | Pos nx, Pos ny => Pos (NN.modulo nx ny) + | Pos nx, Neg ny => Pos (NN.modulo nx ny) + | Neg nx, Pos ny => Neg (NN.modulo nx ny) + | Neg nx, Neg ny => Neg (NN.modulo nx ny) end. Lemma spec_quot : forall x y, to_Z (quot x y) = (to_Z x) ÷ (to_Z y). Proof. - intros [x|x] [y|y]; simpl; symmetry; rewrite N.spec_div; + intros [x|x] [y|y]; simpl; symmetry; rewrite NN.spec_div; (* Nota: we rely here on [forall a b, a ÷ 0 = b / 0] *) - destruct (Z.eq_dec (N.to_Z y) 0) as [EQ|NEQ]; - try (rewrite EQ; now destruct (N.to_Z x)); + destruct (Z.eq_dec (NN.to_Z y) 0) as [EQ|NEQ]; + try (rewrite EQ; now destruct (NN.to_Z x)); rewrite ?Z.quot_opp_r, ?Z.quot_opp_l, ?Z.opp_involutive, ?Z.opp_inj_wd; trivial; apply Z.quot_div_nonneg; - generalize (N.spec_pos x) (N.spec_pos y); Z.order. + generalize (NN.spec_pos x) (NN.spec_pos y); Z.order. Qed. Lemma spec_rem : forall x y, @@ -521,26 +521,26 @@ Module Make (N:NType) <: ZType. rewrite Hy. now destruct (to_Z x). destruct x as [x|x], y as [y|y]; simpl in *; symmetry; rewrite ?Z.eq_opp_l, ?Z.opp_0 in Hy; - rewrite N.spec_modulo, ?Z.rem_opp_r, ?Z.rem_opp_l, ?Z.opp_involutive, + rewrite NN.spec_modulo, ?Z.rem_opp_r, ?Z.rem_opp_l, ?Z.opp_involutive, ?Z.opp_inj_wd; trivial; apply Z.rem_mod_nonneg; - generalize (N.spec_pos x) (N.spec_pos y); Z.order. + generalize (NN.spec_pos x) (NN.spec_pos y); Z.order. Qed. Definition gcd x y := match x, y with - | Pos nx, Pos ny => Pos (N.gcd nx ny) - | Pos nx, Neg ny => Pos (N.gcd nx ny) - | Neg nx, Pos ny => Pos (N.gcd nx ny) - | Neg nx, Neg ny => Pos (N.gcd nx ny) + | Pos nx, Pos ny => Pos (NN.gcd nx ny) + | Pos nx, Neg ny => Pos (NN.gcd nx ny) + | Neg nx, Pos ny => Pos (NN.gcd nx ny) + | Neg nx, Neg ny => Pos (NN.gcd nx ny) end. - Theorem spec_gcd: forall a b, to_Z (gcd a b) = Zgcd (to_Z a) (to_Z b). + Theorem spec_gcd: forall a b, to_Z (gcd a b) = Z.gcd (to_Z a) (to_Z b). Proof. - unfold gcd, Zgcd, to_Z; intros [x | x] [y | y]; rewrite N.spec_gcd; unfold Zgcd; - auto; case N.to_Z; simpl; auto with zarith; - try rewrite Zabs_Zopp; auto; - case N.to_Z; simpl; auto with zarith. + unfold gcd, Z.gcd, to_Z; intros [x | x] [y | y]; rewrite NN.spec_gcd; unfold Z.gcd; + auto; case NN.to_Z; simpl; auto with zarith; + try rewrite Z.abs_opp; auto; + case NN.to_Z; simpl; auto with zarith. Qed. Definition sgn x := @@ -550,124 +550,124 @@ Module Make (N:NType) <: ZType. | Gt => minus_one end. - Lemma spec_sgn : forall x, to_Z (sgn x) = Zsgn (to_Z x). + Lemma spec_sgn : forall x, to_Z (sgn x) = Z.sgn (to_Z x). Proof. - intros. unfold sgn. rewrite spec_compare. case Zcompare_spec. + intros. unfold sgn. rewrite spec_compare. case Z.compare_spec. rewrite spec_0. intros <-; auto. - rewrite spec_0, spec_1. symmetry. rewrite Zsgn_pos; auto. - rewrite spec_0, spec_m1. symmetry. rewrite Zsgn_neg; auto with zarith. + rewrite spec_0, spec_1. symmetry. rewrite Z.sgn_pos_iff; auto. + rewrite spec_0, spec_m1. symmetry. rewrite Z.sgn_neg_iff; auto with zarith. Qed. Definition even z := match z with - | Pos n => N.even n - | Neg n => N.even n + | Pos n => NN.even n + | Neg n => NN.even n end. Definition odd z := match z with - | Pos n => N.odd n - | Neg n => N.odd n + | Pos n => NN.odd n + | Neg n => NN.odd n end. - Lemma spec_even : forall z, even z = Zeven_bool (to_Z z). + Lemma spec_even : forall z, even z = Z.even (to_Z z). Proof. - intros [n|n]; simpl; rewrite N.spec_even; trivial. - destruct (N.to_Z n) as [|p|p]; now try destruct p. + intros [n|n]; simpl; rewrite NN.spec_even; trivial. + destruct (NN.to_Z n) as [|p|p]; now try destruct p. Qed. - Lemma spec_odd : forall z, odd z = Zodd_bool (to_Z z). + Lemma spec_odd : forall z, odd z = Z.odd (to_Z z). Proof. - intros [n|n]; simpl; rewrite N.spec_odd; trivial. - destruct (N.to_Z n) as [|p|p]; now try destruct p. + intros [n|n]; simpl; rewrite NN.spec_odd; trivial. + destruct (NN.to_Z n) as [|p|p]; now try destruct p. Qed. Definition norm_pos z := match z with | Pos _ => z - | Neg n => if N.eqb n N.zero then Pos n else z + | Neg n => if NN.eqb n NN.zero then Pos n else z end. Definition testbit a n := match norm_pos n, norm_pos a with - | Pos p, Pos a => N.testbit a p - | Pos p, Neg a => negb (N.testbit (N.pred a) p) + | Pos p, Pos a => NN.testbit a p + | Pos p, Neg a => negb (NN.testbit (NN.pred a) p) | Neg p, _ => false end. Definition shiftl a n := match norm_pos a, n with - | Pos a, Pos n => Pos (N.shiftl a n) - | Pos a, Neg n => Pos (N.shiftr a n) - | Neg a, Pos n => Neg (N.shiftl a n) - | Neg a, Neg n => Neg (N.succ (N.shiftr (N.pred a) n)) + | Pos a, Pos n => Pos (NN.shiftl a n) + | Pos a, Neg n => Pos (NN.shiftr a n) + | Neg a, Pos n => Neg (NN.shiftl a n) + | Neg a, Neg n => Neg (NN.succ (NN.shiftr (NN.pred a) n)) end. Definition shiftr a n := shiftl a (opp n). Definition lor a b := match norm_pos a, norm_pos b with - | Pos a, Pos b => Pos (N.lor a b) - | Neg a, Pos b => Neg (N.succ (N.ldiff (N.pred a) b)) - | Pos a, Neg b => Neg (N.succ (N.ldiff (N.pred b) a)) - | Neg a, Neg b => Neg (N.succ (N.land (N.pred a) (N.pred b))) + | Pos a, Pos b => Pos (NN.lor a b) + | Neg a, Pos b => Neg (NN.succ (NN.ldiff (NN.pred a) b)) + | Pos a, Neg b => Neg (NN.succ (NN.ldiff (NN.pred b) a)) + | Neg a, Neg b => Neg (NN.succ (NN.land (NN.pred a) (NN.pred b))) end. Definition land a b := match norm_pos a, norm_pos b with - | Pos a, Pos b => Pos (N.land a b) - | Neg a, Pos b => Pos (N.ldiff b (N.pred a)) - | Pos a, Neg b => Pos (N.ldiff a (N.pred b)) - | Neg a, Neg b => Neg (N.succ (N.lor (N.pred a) (N.pred b))) + | Pos a, Pos b => Pos (NN.land a b) + | Neg a, Pos b => Pos (NN.ldiff b (NN.pred a)) + | Pos a, Neg b => Pos (NN.ldiff a (NN.pred b)) + | Neg a, Neg b => Neg (NN.succ (NN.lor (NN.pred a) (NN.pred b))) end. Definition ldiff a b := match norm_pos a, norm_pos b with - | Pos a, Pos b => Pos (N.ldiff a b) - | Neg a, Pos b => Neg (N.succ (N.lor (N.pred a) b)) - | Pos a, Neg b => Pos (N.land a (N.pred b)) - | Neg a, Neg b => Pos (N.ldiff (N.pred b) (N.pred a)) + | Pos a, Pos b => Pos (NN.ldiff a b) + | Neg a, Pos b => Neg (NN.succ (NN.lor (NN.pred a) b)) + | Pos a, Neg b => Pos (NN.land a (NN.pred b)) + | Neg a, Neg b => Pos (NN.ldiff (NN.pred b) (NN.pred a)) end. Definition lxor a b := match norm_pos a, norm_pos b with - | Pos a, Pos b => Pos (N.lxor a b) - | Neg a, Pos b => Neg (N.succ (N.lxor (N.pred a) b)) - | Pos a, Neg b => Neg (N.succ (N.lxor a (N.pred b))) - | Neg a, Neg b => Pos (N.lxor (N.pred a) (N.pred b)) + | Pos a, Pos b => Pos (NN.lxor a b) + | Neg a, Pos b => Neg (NN.succ (NN.lxor (NN.pred a) b)) + | Pos a, Neg b => Neg (NN.succ (NN.lxor a (NN.pred b))) + | Neg a, Neg b => Pos (NN.lxor (NN.pred a) (NN.pred b)) end. Definition div2 x := shiftr x one. Lemma Zlnot_alt1 : forall x, -(x+1) = Z.lnot x. Proof. - unfold Z.lnot, Zpred; auto with zarith. + unfold Z.lnot, Z.pred; auto with zarith. Qed. Lemma Zlnot_alt2 : forall x, Z.lnot (x-1) = -x. Proof. - unfold Z.lnot, Zpred; auto with zarith. + unfold Z.lnot, Z.pred; auto with zarith. Qed. Lemma Zlnot_alt3 : forall x, Z.lnot (-x) = x-1. Proof. - unfold Z.lnot, Zpred; auto with zarith. + unfold Z.lnot, Z.pred; auto with zarith. Qed. Lemma spec_norm_pos : forall x, to_Z (norm_pos x) = to_Z x. Proof. intros [x|x]; simpl; trivial. - rewrite N.spec_eqb, N.spec_0. + rewrite NN.spec_eqb, NN.spec_0. case Z.eqb_spec; simpl; auto with zarith. Qed. Lemma spec_norm_pos_pos : forall x y, norm_pos x = Neg y -> - 0 < N.to_Z y. + 0 < NN.to_Z y. Proof. intros [x|x] y; simpl; try easy. - rewrite N.spec_eqb, N.spec_0. + rewrite NN.spec_eqb, NN.spec_0. case Z.eqb_spec; simpl; try easy. - inversion 2. subst. generalize (N.spec_pos y); auto with zarith. + inversion 2. subst. generalize (NN.spec_pos y); auto with zarith. Qed. Ltac destr_norm_pos x := @@ -682,9 +682,9 @@ Module Make (N:NType) <: ZType. Proof. intros x p. unfold testbit. destr_norm_pos p; simpl. destr_norm_pos x; simpl. - apply N.spec_testbit. - rewrite N.spec_testbit, N.spec_pred, Zmax_r by auto with zarith. - symmetry. apply Z.bits_opp. apply N.spec_pos. + apply NN.spec_testbit. + rewrite NN.spec_testbit, NN.spec_pred, Z.max_r by auto with zarith. + symmetry. apply Z.bits_opp. apply NN.spec_pos. symmetry. apply Z.testbit_neg_r; auto with zarith. Qed. @@ -692,13 +692,13 @@ Module Make (N:NType) <: ZType. Proof. intros x p. unfold shiftl. destr_norm_pos x; destruct p as [p|p]; simpl; - assert (Hp := N.spec_pos p). - apply N.spec_shiftl. - rewrite Z.shiftl_opp_r. apply N.spec_shiftr. - rewrite !N.spec_shiftl. - rewrite !Z.shiftl_mul_pow2 by apply N.spec_pos. - apply Zopp_mult_distr_l. - rewrite Z.shiftl_opp_r, N.spec_succ, N.spec_shiftr, N.spec_pred, Zmax_r + assert (Hp := NN.spec_pos p). + apply NN.spec_shiftl. + rewrite Z.shiftl_opp_r. apply NN.spec_shiftr. + rewrite !NN.spec_shiftl. + rewrite !Z.shiftl_mul_pow2 by apply NN.spec_pos. + symmetry. apply Z.mul_opp_l. + rewrite Z.shiftl_opp_r, NN.spec_succ, NN.spec_shiftr, NN.spec_pred, Z.max_r by auto with zarith. now rewrite Zlnot_alt1, Z.lnot_shiftr, Zlnot_alt2. Qed. @@ -713,8 +713,8 @@ Module Make (N:NType) <: ZType. Proof. intros x y. unfold land. destr_norm_pos x; destr_norm_pos y; simpl; - rewrite ?N.spec_succ, ?N.spec_land, ?N.spec_ldiff, ?N.spec_lor, - ?N.spec_pred, ?Zmax_r, ?Zlnot_alt1; auto with zarith. + rewrite ?NN.spec_succ, ?NN.spec_land, ?NN.spec_ldiff, ?NN.spec_lor, + ?NN.spec_pred, ?Z.max_r, ?Zlnot_alt1; auto with zarith. now rewrite Z.ldiff_land, Zlnot_alt2. now rewrite Z.ldiff_land, Z.land_comm, Zlnot_alt2. now rewrite Z.lnot_lor, !Zlnot_alt2. @@ -724,8 +724,8 @@ Module Make (N:NType) <: ZType. Proof. intros x y. unfold lor. destr_norm_pos x; destr_norm_pos y; simpl; - rewrite ?N.spec_succ, ?N.spec_land, ?N.spec_ldiff, ?N.spec_lor, - ?N.spec_pred, ?Zmax_r, ?Zlnot_alt1; auto with zarith. + rewrite ?NN.spec_succ, ?NN.spec_land, ?NN.spec_ldiff, ?NN.spec_lor, + ?NN.spec_pred, ?Z.max_r, ?Zlnot_alt1; auto with zarith. now rewrite Z.lnot_ldiff, Z.lor_comm, Zlnot_alt2. now rewrite Z.lnot_ldiff, Zlnot_alt2. now rewrite Z.lnot_land, !Zlnot_alt2. @@ -735,8 +735,8 @@ Module Make (N:NType) <: ZType. Proof. intros x y. unfold ldiff. destr_norm_pos x; destr_norm_pos y; simpl; - rewrite ?N.spec_succ, ?N.spec_land, ?N.spec_ldiff, ?N.spec_lor, - ?N.spec_pred, ?Zmax_r, ?Zlnot_alt1; auto with zarith. + rewrite ?NN.spec_succ, ?NN.spec_land, ?NN.spec_ldiff, ?NN.spec_lor, + ?NN.spec_pred, ?Z.max_r, ?Zlnot_alt1; auto with zarith. now rewrite Z.ldiff_land, Zlnot_alt3. now rewrite Z.lnot_lor, Z.ldiff_land, <- Zlnot_alt2. now rewrite 2 Z.ldiff_land, Zlnot_alt2, Z.land_comm, Zlnot_alt3. @@ -746,7 +746,7 @@ Module Make (N:NType) <: ZType. Proof. intros x y. unfold lxor. destr_norm_pos x; destr_norm_pos y; simpl; - rewrite ?N.spec_succ, ?N.spec_lxor, ?N.spec_pred, ?Zmax_r, ?Zlnot_alt1; + rewrite ?NN.spec_succ, ?NN.spec_lxor, ?NN.spec_pred, ?Z.max_r, ?Zlnot_alt1; auto with zarith. now rewrite !Z.lnot_lxor_r, Zlnot_alt2. now rewrite !Z.lnot_lxor_l, Zlnot_alt2. diff --git a/theories/Numbers/Integer/Binary/ZBinary.v b/theories/Numbers/Integer/Binary/ZBinary.v index d7c0abd8..fc600eae 100644 --- a/theories/Numbers/Integer/Binary/ZBinary.v +++ b/theories/Numbers/Integer/Binary/ZBinary.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -36,7 +36,7 @@ End TestOrder. (** Z forms a ring *) -(*Lemma Zring : ring_theory 0 1 NZadd NZmul NZsub Zopp NZeq. +(*Lemma Zring : ring_theory 0 1 NZadd NZmul NZsub Z.opp NZeq. Proof. constructor. exact Zadd_0_l. diff --git a/theories/Numbers/Integer/NatPairs/ZNatPairs.v b/theories/Numbers/Integer/NatPairs/ZNatPairs.v index dbcc1961..b5e1fa5b 100644 --- a/theories/Numbers/Integer/NatPairs/ZNatPairs.v +++ b/theories/Numbers/Integer/NatPairs/ZNatPairs.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -59,7 +59,7 @@ Definition le (n m : t) := n#1 + m#2 <= m#1 + n#2. Definition min (n m : t) : t := (min (n#1 + m#2) (m#1 + n#2), n#2 + m#2). Definition max (n m : t) : t := (max (n#1 + m#2) (m#1 + n#2), n#2 + m#2). -(** NB : We do not have [Zpred (Zsucc n) = n] but only [Zpred (Zsucc n) == n]. +(** NB : We do not have [Z.pred (Z.succ n) = n] but only [Z.pred (Z.succ n) == n]. It could be possible to consider as canonical only pairs where one of the elements is 0, and make all operations convert canonical values into other canonical values. In that case, we diff --git a/theories/Numbers/Integer/SpecViaZ/ZSig.v b/theories/Numbers/Integer/SpecViaZ/ZSig.v index 98ac5dfc..0a26a910 100644 --- a/theories/Numbers/Integer/SpecViaZ/ZSig.v +++ b/theories/Numbers/Integer/SpecViaZ/ZSig.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v b/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v index bfbc063c..e2ec3482 100644 --- a/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v +++ b/theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -93,7 +93,7 @@ replace z with (-(-z))%Z in * by (auto with zarith). remember (-z)%Z as z'. pattern z'; apply natlike_ind. apply B0. -intros; rewrite Zopp_succ; unfold Zpred; apply BP; auto. +intros; rewrite Z.opp_succ; unfold Z.pred; apply BP; auto. subst z'; auto with zarith. Qed. @@ -364,7 +364,7 @@ Program Instance mod_wd : Proper (eq==>eq==>eq) modulo. Theorem div_mod : forall a b, ~b==0 -> a == b*(div a b) + (modulo a b). Proof. -intros a b. zify. intros. apply Z_div_mod_eq_full; auto. +intros a b. zify. intros. apply Z.div_mod; auto. Qed. Theorem mod_pos_bound : diff --git a/theories/Numbers/NaryFunctions.v b/theories/Numbers/NaryFunctions.v index c1b7bafa..7cf3daea 100644 --- a/theories/Numbers/NaryFunctions.v +++ b/theories/Numbers/NaryFunctions.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZAdd.v b/theories/Numbers/NatInt/NZAdd.v index 8bed3027..83b2d63b 100644 --- a/theories/Numbers/NatInt/NZAdd.v +++ b/theories/Numbers/NatInt/NZAdd.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZAddOrder.v b/theories/Numbers/NatInt/NZAddOrder.v index ee03e5f9..ed179699 100644 --- a/theories/Numbers/NatInt/NZAddOrder.v +++ b/theories/Numbers/NatInt/NZAddOrder.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZAxioms.v b/theories/Numbers/NatInt/NZAxioms.v index fcd98787..3a432eaa 100644 --- a/theories/Numbers/NatInt/NZAxioms.v +++ b/theories/Numbers/NatInt/NZAxioms.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -43,7 +43,7 @@ End IsNZDomain. (** Axiomatization of some more constants Simply denoting "1" for (S 0) and so on works ok when implementing - by nat, but leaves some (Nsucc N0) when implementing by N. + by nat, but leaves some (N.succ N0) when implementing by N. *) Module Type OneTwo (Import T:Typ). diff --git a/theories/Numbers/NatInt/NZBase.v b/theories/Numbers/NatInt/NZBase.v index 65b64635..62b14829 100644 --- a/theories/Numbers/NatInt/NZBase.v +++ b/theories/Numbers/NatInt/NZBase.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZBits.v b/theories/Numbers/NatInt/NZBits.v index dc97eeb1..8be5d45c 100644 --- a/theories/Numbers/NatInt/NZBits.v +++ b/theories/Numbers/NatInt/NZBits.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZDiv.v b/theories/Numbers/NatInt/NZDiv.v index bc109ace..4b8a62a8 100644 --- a/theories/Numbers/NatInt/NZDiv.v +++ b/theories/Numbers/NatInt/NZDiv.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZDomain.v b/theories/Numbers/NatInt/NZDomain.v index 36aaa3e7..4b71d539 100644 --- a/theories/Numbers/NatInt/NZDomain.v +++ b/theories/Numbers/NatInt/NZDomain.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZGcd.v b/theories/Numbers/NatInt/NZGcd.v index f72023d9..d7e598fb 100644 --- a/theories/Numbers/NatInt/NZGcd.v +++ b/theories/Numbers/NatInt/NZGcd.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZLog.v b/theories/Numbers/NatInt/NZLog.v index a5aa6d8a..fba91bf3 100644 --- a/theories/Numbers/NatInt/NZLog.v +++ b/theories/Numbers/NatInt/NZLog.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZMul.v b/theories/Numbers/NatInt/NZMul.v index 2b5a1cf3..117a9621 100644 --- a/theories/Numbers/NatInt/NZMul.v +++ b/theories/Numbers/NatInt/NZMul.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZMulOrder.v b/theories/Numbers/NatInt/NZMulOrder.v index 97306f93..a1fe4bf5 100644 --- a/theories/Numbers/NatInt/NZMulOrder.v +++ b/theories/Numbers/NatInt/NZMulOrder.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -271,9 +271,9 @@ Definition mul_eq_0 := eq_mul_0. Definition mul_eq_0_l := eq_mul_0_l. Definition mul_eq_0_r := eq_mul_0_r. -Theorem lt_0_mul : forall n m, 0 < n * m <-> (0 < n /\ 0 < m) \/ (m < 0 /\ n < 0). +Theorem lt_0_mul n m : 0 < n * m <-> (0 < n /\ 0 < m) \/ (m < 0 /\ n < 0). Proof. -intros n m; split; [intro H | intros [[H1 H2] | [H1 H2]]]. +split; [intro H | intros [[H1 H2] | [H1 H2]]]. destruct (lt_trichotomy n 0) as [H1 | [H1 | H1]]; [| rewrite H1 in H; rewrite mul_0_l in H; false_hyp H lt_irrefl |]; (destruct (lt_trichotomy m 0) as [H2 | [H2 | H2]]; diff --git a/theories/Numbers/NatInt/NZOrder.v b/theories/Numbers/NatInt/NZOrder.v index 8cf5b26f..37074aba 100644 --- a/theories/Numbers/NatInt/NZOrder.v +++ b/theories/Numbers/NatInt/NZOrder.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZParity.v b/theories/Numbers/NatInt/NZParity.v index 29109ccb..0e932378 100644 --- a/theories/Numbers/NatInt/NZParity.v +++ b/theories/Numbers/NatInt/NZParity.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZPow.v b/theories/Numbers/NatInt/NZPow.v index 58704735..26d5ffef 100644 --- a/theories/Numbers/NatInt/NZPow.v +++ b/theories/Numbers/NatInt/NZPow.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZProperties.v b/theories/Numbers/NatInt/NZProperties.v index 13c26233..a2eb1996 100644 --- a/theories/Numbers/NatInt/NZProperties.v +++ b/theories/Numbers/NatInt/NZProperties.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZSqrt.v b/theories/Numbers/NatInt/NZSqrt.v index 6e85c689..8146fd01 100644 --- a/theories/Numbers/NatInt/NZSqrt.v +++ b/theories/Numbers/NatInt/NZSqrt.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NAdd.v b/theories/Numbers/Natural/Abstract/NAdd.v index 72e09f15..0ff86fca 100644 --- a/theories/Numbers/Natural/Abstract/NAdd.v +++ b/theories/Numbers/Natural/Abstract/NAdd.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NAddOrder.v b/theories/Numbers/Natural/Abstract/NAddOrder.v index da41886f..5f80714a 100644 --- a/theories/Numbers/Natural/Abstract/NAddOrder.v +++ b/theories/Numbers/Natural/Abstract/NAddOrder.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NAxioms.v b/theories/Numbers/Natural/Abstract/NAxioms.v index ca6ccc1b..061da038 100644 --- a/theories/Numbers/Natural/Abstract/NAxioms.v +++ b/theories/Numbers/Natural/Abstract/NAxioms.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NBase.v b/theories/Numbers/Natural/Abstract/NBase.v index ac8a0522..09e9ccdf 100644 --- a/theories/Numbers/Natural/Abstract/NBase.v +++ b/theories/Numbers/Natural/Abstract/NBase.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NBits.v b/theories/Numbers/Natural/Abstract/NBits.v index c66f003e..1581ce57 100644 --- a/theories/Numbers/Natural/Abstract/NBits.v +++ b/theories/Numbers/Natural/Abstract/NBits.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -236,7 +236,7 @@ Proof. Qed. (** Hence the number of bits of [a] is [1+log2 a] - (see [Psize] and [Psize_pos]). + (see [Pos.size_nat] and [Pos.size]). *) (** Testing bits after division or multiplication by a power of two *) diff --git a/theories/Numbers/Natural/Abstract/NDefOps.v b/theories/Numbers/Natural/Abstract/NDefOps.v index ad7a9f3a..621a2ed9 100644 --- a/theories/Numbers/Natural/Abstract/NDefOps.v +++ b/theories/Numbers/Natural/Abstract/NDefOps.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -376,7 +376,7 @@ Lemma log_good_step : forall n h1 h2, (if n << 2 then 0 else S (h2 (half n))). Proof. intros n h1 h2 E. -destruct (n<<2) as [ ]_eqn:H. +destruct (n<<2) eqn:H. auto with *. f_equiv. apply E, half_decrease. rewrite two_succ, <- not_true_iff_false, ltb_lt, nlt_ge, le_succ_l in H. diff --git a/theories/Numbers/Natural/Abstract/NDiv.v b/theories/Numbers/Natural/Abstract/NDiv.v index 6db8e448..d7fb447e 100644 --- a/theories/Numbers/Natural/Abstract/NDiv.v +++ b/theories/Numbers/Natural/Abstract/NDiv.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NGcd.v b/theories/Numbers/Natural/Abstract/NGcd.v index ece369d8..1c5829dd 100644 --- a/theories/Numbers/Natural/Abstract/NGcd.v +++ b/theories/Numbers/Natural/Abstract/NGcd.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NIso.v b/theories/Numbers/Natural/Abstract/NIso.v index bcf746a7..b17f0c3d 100644 --- a/theories/Numbers/Natural/Abstract/NIso.v +++ b/theories/Numbers/Natural/Abstract/NIso.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NLcm.v b/theories/Numbers/Natural/Abstract/NLcm.v index 1e8e678c..9d8e3e6d 100644 --- a/theories/Numbers/Natural/Abstract/NLcm.v +++ b/theories/Numbers/Natural/Abstract/NLcm.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NLog.v b/theories/Numbers/Natural/Abstract/NLog.v index 74827c6e..f8dc1a2b 100644 --- a/theories/Numbers/Natural/Abstract/NLog.v +++ b/theories/Numbers/Natural/Abstract/NLog.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NMaxMin.v b/theories/Numbers/Natural/Abstract/NMaxMin.v index cdff6dbc..dde7aba5 100644 --- a/theories/Numbers/Natural/Abstract/NMaxMin.v +++ b/theories/Numbers/Natural/Abstract/NMaxMin.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NMulOrder.v b/theories/Numbers/Natural/Abstract/NMulOrder.v index 1d6e8ba0..2f4c91e3 100644 --- a/theories/Numbers/Natural/Abstract/NMulOrder.v +++ b/theories/Numbers/Natural/Abstract/NMulOrder.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NOrder.v b/theories/Numbers/Natural/Abstract/NOrder.v index 8bba7d72..a5a12d37 100644 --- a/theories/Numbers/Natural/Abstract/NOrder.v +++ b/theories/Numbers/Natural/Abstract/NOrder.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NParity.v b/theories/Numbers/Natural/Abstract/NParity.v index 6a1e20ce..69b7778a 100644 --- a/theories/Numbers/Natural/Abstract/NParity.v +++ b/theories/Numbers/Natural/Abstract/NParity.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NPow.v b/theories/Numbers/Natural/Abstract/NPow.v index 07aee9c6..ee29a4a7 100644 --- a/theories/Numbers/Natural/Abstract/NPow.v +++ b/theories/Numbers/Natural/Abstract/NPow.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NProperties.v b/theories/Numbers/Natural/Abstract/NProperties.v index 1edb6b51..90739410 100644 --- a/theories/Numbers/Natural/Abstract/NProperties.v +++ b/theories/Numbers/Natural/Abstract/NProperties.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NSqrt.v b/theories/Numbers/Natural/Abstract/NSqrt.v index 34b7d011..9cd62ae9 100644 --- a/theories/Numbers/Natural/Abstract/NSqrt.v +++ b/theories/Numbers/Natural/Abstract/NSqrt.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NStrongRec.v b/theories/Numbers/Natural/Abstract/NStrongRec.v index 607746d5..e4cbf090 100644 --- a/theories/Numbers/Natural/Abstract/NStrongRec.v +++ b/theories/Numbers/Natural/Abstract/NStrongRec.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NSub.v b/theories/Numbers/Natural/Abstract/NSub.v index d7143c67..68bfffad 100644 --- a/theories/Numbers/Natural/Abstract/NSub.v +++ b/theories/Numbers/Natural/Abstract/NSub.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/BigN/BigN.v b/theories/Numbers/Natural/BigN/BigN.v index 7f205b38..072b75f7 100644 --- a/theories/Numbers/Natural/BigN/BigN.v +++ b/theories/Numbers/Natural/BigN/BigN.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -119,7 +119,7 @@ BigN.zify. auto with zarith. intros NEQ. generalize (BigN.spec_div_eucl a b). generalize (Z_div_mod_full [a] [b] NEQ). -destruct BigN.div_eucl as (q,r), Zdiv_eucl as (q',r'). +destruct BigN.div_eucl as (q,r), Z.div_eucl as (q',r'). intros (EQ,_). injection 1. intros EQr EQq. BigN.zify. rewrite EQr, EQq; auto. Qed. diff --git a/theories/Numbers/Natural/BigN/NMake.v b/theories/Numbers/Natural/BigN/NMake.v index 952f6183..5012a1b9 100644 --- a/theories/Numbers/Natural/BigN/NMake.v +++ b/theories/Numbers/Natural/BigN/NMake.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -65,8 +65,8 @@ Module Make (W0:CyclicType) <: NType. intros. change (Zpos (ZnZ.digits (dom_op n)) <= Zpos (ZnZ.digits (dom_op m))). rewrite !digits_dom_op, !Pshiftl_nat_Zpower. - apply Zmult_le_compat_l; auto with zarith. - apply Zpower_le_monotone2; auto with zarith. + apply Z.mul_le_mono_nonneg_l; auto with zarith. + apply Z.pow_le_mono_r; auto with zarith. Qed. Definition to_N (x : t) := Z.to_N (to_Z x). @@ -186,12 +186,12 @@ Module Make (W0:CyclicType) <: NType. exact spec_0. Qed. - Lemma spec_pred : forall x, [pred x] = Zmax 0 ([x]-1). + Lemma spec_pred x : [pred x] = Z.max 0 ([x]-1). Proof. - intros. destruct (Zle_lt_or_eq _ _ (spec_pos x)). - rewrite Zmax_r; auto with zarith. - apply spec_pred_pos; auto. - rewrite <- H; apply spec_pred0; auto. + rewrite Z.max_comm. + destruct (Z.max_spec ([x]-1) 0) as [(H,->)|(H,->)]. + - apply spec_pred0; generalize (spec_pos x); auto with zarith. + - apply spec_pred_pos; auto with zarith. Qed. (** * Subtraction *) @@ -230,11 +230,11 @@ Module Make (W0:CyclicType) <: NType. exact spec_0. Qed. - Lemma spec_sub : forall x y, [sub x y] = Zmax 0 ([x]-[y]). + Lemma spec_sub : forall x y, [sub x y] = Z.max 0 ([x]-[y]). Proof. - intros. destruct (Zle_or_lt [y] [x]). - rewrite Zmax_r; auto with zarith. apply spec_sub_pos; auto. - rewrite Zmax_l; auto with zarith. apply spec_sub0; auto. + intros. destruct (Z.le_gt_cases [y] [x]). + rewrite Z.max_r; auto with zarith. apply spec_sub_pos; auto. + rewrite Z.max_l; auto with zarith. apply spec_sub0; auto. Qed. (** * Comparison *) @@ -249,7 +249,7 @@ Module Make (W0:CyclicType) <: NType. Let spec_comparen_m: forall n m (x : word (dom_t n) (S m)) (y : dom_t n), - comparen_m n m x y = Zcompare (eval n (S m) x) (ZnZ.to_Z y). + comparen_m n m x y = Z.compare (eval n (S m) x) (ZnZ.to_Z y). Proof. intros n m x y. unfold comparen_m, eval. @@ -287,10 +287,8 @@ Module Make (W0:CyclicType) <: NType. lazy beta iota delta [iter_sym dom_op dom_t comparen_m]. reflexivity. Qed. -(** TODO: no need for ZnZ.Spec_rect , Spec_ind, and so on... *) - Theorem spec_compare : forall x y, - compare x y = Zcompare [x] [y]. + compare x y = Z.compare [x] [y]. Proof. intros x y. rewrite compare_fold. apply spec_iter_sym; clear x y. intros. apply ZnZ.spec_compare. @@ -298,7 +296,7 @@ Module Make (W0:CyclicType) <: NType. intros n m x y; unfold comparenm. rewrite (spec_cast_l n m x), (spec_cast_r n m y). unfold to_Z; apply ZnZ.spec_compare. - intros. subst. apply Zcompare_antisym. + intros. subst. now rewrite <- Z.compare_antisym. Qed. Definition eqb (x y : t) : bool := @@ -346,14 +344,14 @@ Module Make (W0:CyclicType) <: NType. Definition min (n m : t) : t := match compare n m with Gt => m | _ => n end. Definition max (n m : t) : t := match compare n m with Lt => m | _ => n end. - Theorem spec_max : forall n m, [max n m] = Zmax [n] [m]. + Theorem spec_max : forall n m, [max n m] = Z.max [n] [m]. Proof. - intros. unfold max, Zmax. rewrite spec_compare; destruct Zcompare; reflexivity. + intros. unfold max, Z.max. rewrite spec_compare; destruct Z.compare; reflexivity. Qed. - Theorem spec_min : forall n m, [min n m] = Zmin [n] [m]. + Theorem spec_min : forall n m, [min n m] = Z.min [n] [m]. Proof. - intros. unfold min, Zmin. rewrite spec_compare; destruct Zcompare; reflexivity. + intros. unfold min, Z.min. rewrite spec_compare; destruct Z.compare; reflexivity. Qed. (** * Multiplication *) @@ -437,7 +435,7 @@ Module Make (W0:CyclicType) <: NType. intros; unfold wn_mul. generalize (spec_mul_add_n1 n m x y ZnZ.zero). case DoubleMul.double_mul_add_n1; intros q r Hqr. - rewrite ZnZ.spec_0, Zplus_0_r in Hqr. rewrite <- Hqr. + rewrite ZnZ.spec_0, Z.add_0_r in Hqr. rewrite <- Hqr. generalize (ZnZ.spec_eq0 q); case ZnZ.eq0; intros HH. rewrite HH; auto. simpl. apply spec_mk_t_w'. clear. @@ -458,7 +456,7 @@ Module Make (W0:CyclicType) <: NType. intros n m x y; unfold mulnm. rewrite spec_reduce_n. rewrite (spec_cast_l n m x), (spec_cast_r n m y). apply spec_muln. - intros. rewrite Zmult_comm; auto. + intros. rewrite Z.mul_comm; auto. Qed. (** * Division by a smaller number *) @@ -519,7 +517,7 @@ Module Make (W0:CyclicType) <: NType. apply DoubleBase.spec_get_low. apply spec_zeron. exact ZnZ.spec_to_Z. - apply Zle_lt_trans with (ZnZ.to_Z y); auto. + apply Z.le_lt_trans with (ZnZ.to_Z y); auto. rewrite <- nmake_double; auto. case (ZnZ.spec_to_Z y); auto. Qed. @@ -580,9 +578,9 @@ Module Make (W0:CyclicType) <: NType. intros x y H1 H2; generalize (spec_div_gt_aux x y H1 H2); case div_gt. intros q r (H3, H4); split. apply (Zdiv_unique [x] [y] [q] [r]); auto. - rewrite Zmult_comm; auto. + rewrite Z.mul_comm; auto. apply (Zmod_unique [x] [y] [q] [r]); auto. - rewrite Zmult_comm; auto. + rewrite Z.mul_comm; auto. Qed. (** * General Division *) @@ -597,7 +595,7 @@ Module Make (W0:CyclicType) <: NType. Theorem spec_div_eucl: forall x y, let (q,r) := div_eucl x y in - ([q], [r]) = Zdiv_eucl [x] [y]. + ([q], [r]) = Z.div_eucl [x] [y]. Proof. intros x y. unfold div_eucl. rewrite spec_eqb, spec_compare, spec_0. @@ -606,16 +604,16 @@ Module Make (W0:CyclicType) <: NType. intros H'. assert (H : 0 < [y]) by (generalize (spec_pos y); auto with zarith). clear H'. - case Zcompare_spec; intros Cmp; + case Z.compare_spec; intros Cmp; rewrite ?spec_0, ?spec_1; intros; auto with zarith. - rewrite Cmp; generalize (Z_div_same [y] (Zlt_gt _ _ H)) - (Z_mod_same [y] (Zlt_gt _ _ H)); - unfold Zdiv, Zmod; case Zdiv_eucl; intros; subst; auto. + rewrite Cmp; generalize (Z_div_same [y] (Z.lt_gt _ _ H)) + (Z_mod_same [y] (Z.lt_gt _ _ H)); + unfold Z.div, Z.modulo; case Z.div_eucl; intros; subst; auto. assert (LeLt: 0 <= [x] < [y]) by (generalize (spec_pos x); auto). generalize (Zdiv_small _ _ LeLt) (Zmod_small _ _ LeLt); - unfold Zdiv, Zmod; case Zdiv_eucl; intros; subst; auto. - generalize (spec_div_gt _ _ (Zlt_gt _ _ Cmp) H); auto. - unfold Zdiv, Zmod; case Zdiv_eucl; case div_gt. + unfold Z.div, Z.modulo; case Z.div_eucl; intros; subst; auto. + generalize (spec_div_gt _ _ (Z.lt_gt _ _ Cmp) H); auto. + unfold Z.div, Z.modulo; case Z.div_eucl; case div_gt. intros a b c d (H1, H2); subst; auto. Qed. @@ -626,7 +624,7 @@ Module Make (W0:CyclicType) <: NType. Proof. intros x y; unfold div; generalize (spec_div_eucl x y); case div_eucl; simpl fst. - intros xx yy; unfold Zdiv; case Zdiv_eucl; intros qq rr H; + intros xx yy; unfold Z.div; case Z.div_eucl; intros qq rr H; injection H; auto. Qed. @@ -730,10 +728,10 @@ Module Make (W0:CyclicType) <: NType. intro H'. assert (H : 0 < [y]) by (generalize (spec_pos y); auto with zarith). clear H'. - case Zcompare_spec; + case Z.compare_spec; rewrite ?spec_0, ?spec_1; intros; try split; auto with zarith. - rewrite H0; apply sym_equal; apply Z_mod_same; auto with zarith. - apply sym_equal; apply Zmod_small; auto with zarith. + rewrite H0; symmetry; apply Z_mod_same; auto with zarith. + symmetry; apply Zmod_small; auto with zarith. generalize (spec_pos x); auto with zarith. apply spec_mod_gt; auto with zarith. Qed. @@ -775,7 +773,7 @@ Module Make (W0:CyclicType) <: NType. Proof. intros x. symmetry. apply Z.sqrt_unique. - rewrite <- ! Zpower_2. apply spec_sqrt_aux. + rewrite <- ! Z.pow_2_r. apply spec_sqrt_aux. Qed. (** * Power *) @@ -791,14 +789,14 @@ Module Make (W0:CyclicType) <: NType. Proof. intros x n; generalize x; elim n; clear n x; simpl pow_pos. intros; rewrite spec_mul; rewrite spec_square; rewrite H. - rewrite Zpos_xI; rewrite Zpower_exp; auto with zarith. - rewrite (Zmult_comm 2); rewrite Zpower_mult; auto with zarith. - rewrite Zpower_2; rewrite Zpower_1_r; auto. + rewrite Pos2Z.inj_xI; rewrite Zpower_exp; auto with zarith. + rewrite (Z.mul_comm 2); rewrite Z.pow_mul_r; auto with zarith. + rewrite Z.pow_2_r; rewrite Z.pow_1_r; auto. intros; rewrite spec_square; rewrite H. - rewrite Zpos_xO; auto with zarith. - rewrite (Zmult_comm 2); rewrite Zpower_mult; auto with zarith. - rewrite Zpower_2; auto. - intros; rewrite Zpower_1_r; auto. + rewrite Pos2Z.inj_xO; auto with zarith. + rewrite (Z.mul_comm 2); rewrite Z.pow_mul_r; auto with zarith. + rewrite Z.pow_2_r; auto. + intros; rewrite Z.pow_1_r; auto. Qed. Definition pow_N (x:t)(n:N) : t := match n with @@ -806,7 +804,7 @@ Module Make (W0:CyclicType) <: NType. | BinNat.Npos p => pow_pos x p end. - Theorem spec_pow_N: forall x n, [pow_N x n] = [x] ^ Z_of_N n. + Theorem spec_pow_N: forall x n, [pow_N x n] = [x] ^ Z.of_N n. Proof. destruct n; simpl. apply spec_1. apply spec_pow_pos. @@ -867,15 +865,15 @@ Module Make (W0:CyclicType) <: NType. Zis_gcd [a] [b] [gcd_gt_body a b cont]. Proof. intros a b cont p H2 H3 H4; unfold gcd_gt_body. - rewrite ! spec_compare, spec_0. case Zcompare_spec. + rewrite ! spec_compare, spec_0. case Z.compare_spec. intros ->; apply Zis_gcd_0. intros HH; absurd (0 <= [b]); auto with zarith. case (spec_digits b); auto with zarith. - intros H5; case Zcompare_spec. - intros H6; rewrite <- (Zmult_1_r [b]). + intros H5; case Z.compare_spec. + intros H6; rewrite <- (Z.mul_1_r [b]). rewrite (Z_div_mod_eq [a] [b]); auto with zarith. rewrite <- spec_mod_gt; auto with zarith. - rewrite H6; rewrite Zplus_0_r. + rewrite H6; rewrite Z.add_0_r. apply Zis_gcd_mult; apply Zis_gcd_1. intros; apply False_ind. case (spec_digits (mod_gt a b)); auto with zarith. @@ -890,24 +888,19 @@ Module Make (W0:CyclicType) <: NType. rewrite <- spec_mod_gt; auto with zarith. repeat rewrite <- spec_mod_gt; auto with zarith. apply H4; auto with zarith. - apply Zmult_lt_reg_r with 2; auto with zarith. - apply Zle_lt_trans with ([b] + [mod_gt a b]); auto with zarith. - apply Zle_lt_trans with (([a]/[b]) * [b] + [mod_gt a b]); auto with zarith. - apply Zplus_le_compat_r. - pattern [b] at 1; rewrite <- (Zmult_1_l [b]). - apply Zmult_le_compat_r; auto with zarith. - case (Zle_lt_or_eq 0 ([a]/[b])); auto with zarith. - intros HH; rewrite (Z_div_mod_eq [a] [b]) in H2; - try rewrite <- HH in H2; auto with zarith. - case (Z_mod_lt [a] [b]); auto with zarith. - rewrite Zmult_comm; rewrite spec_mod_gt; auto with zarith. - rewrite <- Z_div_mod_eq; auto with zarith. - pattern 2 at 2; rewrite <- (Zpower_1_r 2). - rewrite <- Zpower_exp; auto with zarith. - ring_simplify (p - 1 + 1); auto. - case (Zle_lt_or_eq 0 p); auto with zarith. - generalize H3; case p; simpl Zpower; auto with zarith. - intros HH; generalize H3; rewrite <- HH; simpl Zpower; auto with zarith. + apply Z.mul_lt_mono_pos_r with 2; auto with zarith. + apply Z.le_lt_trans with ([b] + [mod_gt a b]); auto with zarith. + apply Z.le_lt_trans with (([a]/[b]) * [b] + [mod_gt a b]); auto with zarith. + - apply Z.add_le_mono_r. + rewrite <- (Z.mul_1_l [b]) at 1. + apply Z.mul_le_mono_nonneg_r; auto with zarith. + change 1 with (Z.succ 0). apply Z.le_succ_l. + apply Z.div_str_pos; auto with zarith. + - rewrite Z.mul_comm; rewrite spec_mod_gt; auto with zarith. + rewrite <- Z_div_mod_eq; auto with zarith. + rewrite Z.mul_comm, <- Z.pow_succ_r, Z.sub_1_r, Z.succ_pred; auto. + apply Z.le_0_sub. change 1 with (Z.succ 0). apply Z.le_succ_l. + destruct p; simpl in H3; auto with zarith. Qed. Fixpoint gcd_gt_aux (p:positive) (cont:t->t->t) (a b:t) : t := @@ -931,7 +924,7 @@ Module Make (W0:CyclicType) <: NType. apply Hrec with (Zpos p + n); auto. replace (Zpos p + (Zpos p + n)) with (Zpos (xI p) + n - 1); auto. - rewrite Zpos_xI; ring. + rewrite Pos2Z.inj_xI; ring. intros a2 b2 H9 H10. apply Hrec with n; auto. intros p Hrec n a b cont H2 H3 H4. @@ -940,18 +933,18 @@ Module Make (W0:CyclicType) <: NType. apply Hrec with (Zpos p + n - 1); auto. replace (Zpos p + (Zpos p + n - 1)) with (Zpos (xO p) + n - 1); auto. - rewrite Zpos_xO; ring. + rewrite Pos2Z.inj_xO; ring. intros a2 b2 H9 H10. apply Hrec with (n - 1); auto. replace (Zpos p + (n - 1)) with (Zpos p + n - 1); auto with zarith. intros a3 b3 H12 H13; apply H4; auto with zarith. - apply Zlt_le_trans with (1 := H12). - apply Zpower_le_monotone2; auto with zarith. + apply Z.lt_le_trans with (1 := H12). + apply Z.pow_le_mono_r; auto with zarith. intros n a b cont H H2 H3. simpl gcd_gt_aux. apply Zspec_gcd_gt_body with (n + 1); auto with zarith. - rewrite Zplus_comm; auto. + rewrite Z.add_comm; auto. intros a1 b1 H5 H6; apply H3; auto. replace n with (n + 1 - 1); auto; try ring. Qed. @@ -965,14 +958,14 @@ Module Make (W0:CyclicType) <: NType. Definition gcd_gt a b := gcd_gt_aux (digits a) gcd_cont a b. Theorem spec_gcd_gt: forall a b, - [a] > [b] -> [gcd_gt a b] = Zgcd [a] [b]. + [a] > [b] -> [gcd_gt a b] = Z.gcd [a] [b]. Proof. intros a b H2. case (spec_digits (gcd_gt a b)); intros H3 H4. case (spec_digits a); intros H5 H6. - apply sym_equal; apply Zis_gcd_gcd; auto with zarith. + symmetry; apply Zis_gcd_gcd; auto with zarith. unfold gcd_gt; apply Zspec_gcd_gt_aux with 0; auto with zarith. - intros a1 a2; rewrite Zpower_0_r. + intros a1 a2; rewrite Z.pow_0_r. case (spec_digits a2); intros H7 H8; intros; apply False_ind; auto with zarith. Qed. @@ -984,18 +977,18 @@ Module Make (W0:CyclicType) <: NType. | Gt => gcd_gt a b end. - Theorem spec_gcd: forall a b, [gcd a b] = Zgcd [a] [b]. + Theorem spec_gcd: forall a b, [gcd a b] = Z.gcd [a] [b]. Proof. intros a b. case (spec_digits a); intros H1 H2. case (spec_digits b); intros H3 H4. - unfold gcd. rewrite spec_compare. case Zcompare_spec. - intros HH; rewrite HH; apply sym_equal; apply Zis_gcd_gcd; auto. + unfold gcd. rewrite spec_compare. case Z.compare_spec. + intros HH; rewrite HH; symmetry; apply Zis_gcd_gcd; auto. apply Zis_gcd_refl. - intros; apply trans_equal with (Zgcd [b] [a]). + intros; transitivity (Z.gcd [b] [a]). apply spec_gcd_gt; auto with zarith. apply Zis_gcd_gcd; auto with zarith. - apply Zgcd_is_pos. + apply Z.gcd_nonneg. apply Zis_gcd_sym; apply Zgcd_is_gcd. intros; apply spec_gcd_gt; auto with zarith. Qed. @@ -1017,22 +1010,22 @@ Module Make (W0:CyclicType) <: NType. exact (ZnZ.spec_is_even x). Qed. - Theorem spec_even: forall x, even x = Zeven_bool [x]. + Theorem spec_even: forall x, even x = Z.even [x]. Proof. intros x. assert (H := spec_even_aux x). symmetry. - rewrite (Z_div_mod_eq_full [x] 2); auto with zarith. - destruct (even x); rewrite H, ?Zplus_0_r. + rewrite (Z.div_mod [x] 2); auto with zarith. + destruct (even x); rewrite H, ?Z.add_0_r. rewrite Zeven_bool_iff. apply Zeven_2p. apply not_true_is_false. rewrite Zeven_bool_iff. apply Zodd_not_Zeven. apply Zodd_2p_plus_1. Qed. - Theorem spec_odd: forall x, odd x = Zodd_bool [x]. + Theorem spec_odd: forall x, odd x = Z.odd [x]. Proof. intros x. unfold odd. assert (H := spec_even_aux x). symmetry. - rewrite (Z_div_mod_eq_full [x] 2); auto with zarith. - destruct (even x); rewrite H, ?Zplus_0_r; simpl negb. + rewrite (Z.div_mod [x] 2); auto with zarith. + destruct (even x); rewrite H, ?Z.add_0_r; simpl negb. apply not_true_is_false. rewrite Zodd_bool_iff. apply Zeven_not_Zodd. apply Zeven_2p. apply Zodd_bool_iff. apply Zodd_2p_plus_1. @@ -1041,27 +1034,21 @@ Module Make (W0:CyclicType) <: NType. (** * Conversion *) Definition pheight p := - Peano.pred (nat_of_P (get_height (ZnZ.digits (dom_op 0)) (plength p))). + Peano.pred (Pos.to_nat (get_height (ZnZ.digits (dom_op 0)) (plength p))). Theorem pheight_correct: forall p, - Zpos p < 2 ^ (Zpos (ZnZ.digits (dom_op 0)) * 2 ^ (Z_of_nat (pheight p))). + Zpos p < 2 ^ (Zpos (ZnZ.digits (dom_op 0)) * 2 ^ (Z.of_nat (pheight p))). Proof. intros p; unfold pheight. - assert (F1: forall x, Z_of_nat (Peano.pred (nat_of_P x)) = Zpos x - 1). - intros x. - assert (Zsucc (Z_of_nat (Peano.pred (nat_of_P x))) = Zpos x); auto with zarith. - rewrite <- inj_S. - rewrite <- (fun x => S_pred x 0); auto with zarith. - rewrite Zpos_eq_Z_of_nat_o_nat_of_P; auto. - apply lt_le_trans with 1%nat; auto with zarith. - exact (le_Pmult_nat x 1). - rewrite F1; clear F1. + rewrite Nat2Z.inj_pred by apply Pos2Nat.is_pos. + rewrite positive_nat_Z. + rewrite <- Z.sub_1_r. assert (F2:= (get_height_correct (ZnZ.digits (dom_op 0)) (plength p))). - apply Zlt_le_trans with (Zpos (Psucc p)). - rewrite Zpos_succ_morphism; auto with zarith. - apply Zle_trans with (1 := plength_pred_correct (Psucc p)). - rewrite Ppred_succ. - apply Zpower_le_monotone2; auto with zarith. + apply Z.lt_le_trans with (Zpos (Pos.succ p)). + rewrite Pos2Z.inj_succ; auto with zarith. + apply Z.le_trans with (1 := plength_pred_correct (Pos.succ p)). + rewrite Pos.pred_succ. + apply Z.pow_le_mono_r; auto with zarith. Qed. Definition of_pos (x:positive) : t := @@ -1076,8 +1063,8 @@ Module Make (W0:CyclicType) <: NType. simpl. apply ZnZ.of_pos_correct. unfold base. - apply Zlt_le_trans with (1 := pheight_correct x). - apply Zpower_le_monotone2; auto with zarith. + apply Z.lt_le_trans with (1 := pheight_correct x). + apply Z.pow_le_mono_r; auto with zarith. rewrite (digits_dom_op (_ _)), Pshiftl_nat_Zpower. auto with zarith. Qed. @@ -1088,7 +1075,7 @@ Module Make (W0:CyclicType) <: NType. end. Theorem spec_of_N: forall x, - [of_N x] = Z_of_N x. + [of_N x] = Z.of_N x. Proof. intros x; case x. simpl of_N. exact spec_0. @@ -1122,7 +1109,7 @@ Module Make (W0:CyclicType) <: NType. intros. apply Zdiv_unique with 0; auto with zarith. change 2 with (2^1) at 2. rewrite <- Zpower_exp; auto with zarith. - rewrite Zplus_0_r. f_equal. auto with zarith. + rewrite Z.add_0_r. f_equal. auto with zarith. Qed. Theorem spec_head0: forall x, 0 < [x] -> @@ -1212,9 +1199,9 @@ Module Make (W0:CyclicType) <: NType. set (d := ZnZ.digits (dom_op n)) in *; clearbody d. destruct (Z_lt_le_dec h (Zpos d)); auto. exfalso. assert (1 * 2^Zpos d <= ZnZ.to_Z x * 2^h). - apply Zmult_le_compat; auto with zarith. - apply Zpower_le_monotone2; auto with zarith. - rewrite Zmult_comm in H0. auto with zarith. + apply Z.mul_le_mono_nonneg; auto with zarith. + apply Z.pow_le_mono_r; auto with zarith. + rewrite Z.mul_comm in H0. auto with zarith. Qed. Lemma spec_log2_pos : forall x, [x]<>0 -> @@ -1232,13 +1219,13 @@ Module Make (W0:CyclicType) <: NType. assert (H2 := ZnZ.spec_to_Z (ZnZ.zdigits (dom_op n))). assert (H3 := head0_zdigits n x). rewrite Zmod_small by auto with zarith. + rewrite Z.sub_simpl_r. rewrite (Z.mul_lt_mono_pos_l (2^(ZnZ.to_Z (ZnZ.head0 x)))); auto with zarith. rewrite (Z.mul_le_mono_pos_l _ _ (2^(ZnZ.to_Z (ZnZ.head0 x)))); auto with zarith. rewrite <- 2 Zpower_exp; auto with zarith. - rewrite Z.add_sub_assoc, Zplus_minus. - rewrite Z.sub_simpl_r, Zplus_minus. + rewrite !Z.add_sub_assoc, !Z.add_simpl_l. rewrite ZnZ.spec_zdigits. rewrite pow2_pos_minus_1 by (red; auto). apply ZnZ.spec_head0; auto with zarith. @@ -1294,12 +1281,12 @@ Module Make (W0:CyclicType) <: NType. Proof. intros x y z HH HH1 HH2. split; auto with zarith. - apply Zle_lt_trans with (2 := HH2); auto with zarith. + apply Z.le_lt_trans with (2 := HH2); auto with zarith. apply Zdiv_le_upper_bound; auto with zarith. pattern x at 1; replace x with (x * 2 ^ 0); auto with zarith. - apply Zmult_le_compat_l; auto. - apply Zpower_le_monotone2; auto with zarith. - rewrite Zpower_0_r; ring. + apply Z.mul_le_mono_nonneg_l; auto. + apply Z.pow_le_mono_r; auto with zarith. + rewrite Z.pow_0_r; ring. Qed. Theorem spec_shiftr_pow2 : forall x n, @@ -1315,7 +1302,7 @@ Module Make (W0:CyclicType) <: NType. rewrite spec_reduce. rewrite ZnZ.spec_zdigits in H. rewrite ZnZ.spec_add_mul_div by auto with zarith. - rewrite ZnZ.spec_0, Zmult_0_l, Zplus_0_l. + rewrite ZnZ.spec_0, Z.mul_0_l, Z.add_0_l. rewrite Zmod_small. f_equal. f_equal. auto with zarith. split. auto with zarith. @@ -1324,8 +1311,8 @@ Module Make (W0:CyclicType) <: NType. rewrite ZnZ.spec_0. symmetry. apply Zdiv_small. split; auto with zarith. - apply Zlt_le_trans with (base (ZnZ.digits (dom_op n))); auto with zarith. - unfold base. apply Zpower_le_monotone2; auto with zarith. + apply Z.lt_le_trans with (base (ZnZ.digits (dom_op n))); auto with zarith. + unfold base. apply Z.pow_le_mono_r; auto with zarith. rewrite ZnZ.spec_zdigits in H. generalize (ZnZ.spec_to_Z d); auto with zarith. Qed. @@ -1370,21 +1357,21 @@ Module Make (W0:CyclicType) <: NType. destruct (ZnZ.spec_to_Z x). destruct (ZnZ.spec_to_Z p). rewrite ZnZ.spec_add_mul_div by (omega with *). - rewrite ZnZ.spec_0, Zdiv_0_l, Zplus_0_r. + rewrite ZnZ.spec_0, Zdiv_0_l, Z.add_0_r. apply Zmod_small. unfold base. split; auto with zarith. - rewrite Zmult_comm. - apply Zlt_le_trans with (2^(ZnZ.to_Z p + K)). + rewrite Z.mul_comm. + apply Z.lt_le_trans with (2^(ZnZ.to_Z p + K)). rewrite Zpower_exp; auto with zarith. - apply Zmult_lt_compat_l; auto with zarith. - apply Zpower_le_monotone2; auto with zarith. + apply Z.mul_lt_mono_pos_l; auto with zarith. + apply Z.pow_le_mono_r; auto with zarith. Qed. Theorem spec_unsafe_shiftl: forall x p, [p] <= [head0 x] -> [unsafe_shiftl x p] = [x] * 2 ^ [p]. Proof. intros. - destruct (Z_eq_dec [x] 0) as [EQ|NEQ]. + destruct (Z.eq_dec [x] 0) as [EQ|NEQ]. (* [x] = 0 *) apply spec_unsafe_shiftl_aux with 0; auto with zarith. now rewrite EQ. @@ -1421,7 +1408,7 @@ Module Make (W0:CyclicType) <: NType. Proof. intros x. rewrite ! digits_level, double_size_level. rewrite 2 digits_dom_op, 2 Pshiftl_nat_Zpower, - inj_S, Zpower_Zsucc; auto with zarith. + Nat2Z.inj_succ, Z.pow_succ_r; auto with zarith. ring. Qed. @@ -1438,46 +1425,47 @@ Module Make (W0:CyclicType) <: NType. assert (F1:= spec_pos (head0 x)). assert (F2: 0 < Zpos (digits x)). red; auto. - case (Zle_lt_or_eq _ _ (spec_pos x)); intros HH. + assert (HH := spec_pos x). Z.le_elim HH. generalize HH; rewrite <- (spec_double_size x); intros HH1. case (spec_head0 x HH); intros _ HH2. case (spec_head0 _ HH1). rewrite (spec_double_size x); rewrite (spec_double_size_digits x). intros HH3 _. - case (Zle_or_lt ([head0 (double_size x)]) (2 * [head0 x])); auto; intros HH4. + case (Z.le_gt_cases ([head0 (double_size x)]) (2 * [head0 x])); auto; intros HH4. absurd (2 ^ (2 * [head0 x] )* [x] < 2 ^ [head0 (double_size x)] * [x]); auto. - apply Zle_not_lt. - apply Zmult_le_compat_r; auto with zarith. - apply Zpower_le_monotone2; auto; auto with zarith. + apply Z.le_ngt. + apply Z.mul_le_mono_nonneg_r; auto with zarith. + apply Z.pow_le_mono_r; auto; auto with zarith. assert (HH5: 2 ^[head0 x] <= 2 ^(Zpos (digits x) - 1)). - case (Zle_lt_or_eq 1 [x]); auto with zarith; intros HH5. - apply Zmult_le_reg_r with (2 ^ 1); auto with zarith. - rewrite <- (fun x y z => Zpower_exp x (y - z)); auto with zarith. - assert (tmp: forall x, x - 1 + 1 = x); [intros; ring | rewrite tmp; clear tmp]. - apply Zle_trans with (2 := Zlt_le_weak _ _ HH2). - apply Zmult_le_compat_l; auto with zarith. - rewrite Zpower_1_r; auto with zarith. - apply Zpower_le_monotone2; auto with zarith. - case (Zle_or_lt (Zpos (digits x)) [head0 x]); auto with zarith; intros HH6. - absurd (2 ^ Zpos (digits x) <= 2 ^ [head0 x] * [x]); auto with zarith. - rewrite <- HH5; rewrite Zmult_1_r. - apply Zpower_le_monotone2; auto with zarith. - rewrite (Zmult_comm 2). - rewrite Zpower_mult; auto with zarith. - rewrite Zpower_2. - apply Zlt_le_trans with (2 := HH3). - rewrite <- Zmult_assoc. + { apply Z.le_succ_l in HH. change (1 <= [x]) in HH. + Z.le_elim HH. + - apply Z.mul_le_mono_pos_r with (2 ^ 1); auto with zarith. + rewrite <- (fun x y z => Z.pow_add_r x (y - z)); auto with zarith. + rewrite Z.sub_add. + apply Z.le_trans with (2 := Z.lt_le_incl _ _ HH2). + apply Z.mul_le_mono_nonneg_l; auto with zarith. + rewrite Z.pow_1_r; auto with zarith. + - apply Z.pow_le_mono_r; auto with zarith. + case (Z.le_gt_cases (Zpos (digits x)) [head0 x]); auto with zarith; intros HH6. + absurd (2 ^ Zpos (digits x) <= 2 ^ [head0 x] * [x]); auto with zarith. + rewrite <- HH; rewrite Z.mul_1_r. + apply Z.pow_le_mono_r; auto with zarith. } + rewrite (Z.mul_comm 2). + rewrite Z.pow_mul_r; auto with zarith. + rewrite Z.pow_2_r. + apply Z.lt_le_trans with (2 := HH3). + rewrite <- Z.mul_assoc. replace (2 * Zpos (digits x) - 1) with ((Zpos (digits x) - 1) + (Zpos (digits x))). rewrite Zpower_exp; auto with zarith. apply Zmult_lt_compat2; auto with zarith. split; auto with zarith. - apply Zmult_lt_0_compat; auto with zarith. - rewrite Zpos_xO; ring. - apply Zlt_le_weak; auto. + apply Z.mul_pos_pos; auto with zarith. + rewrite Pos2Z.inj_xO; ring. + apply Z.lt_le_incl; auto. repeat rewrite spec_head00; auto. rewrite spec_double_size_digits. - rewrite Zpos_xO; auto with zarith. + rewrite Pos2Z.inj_xO; auto with zarith. rewrite spec_double_size; auto. Qed. @@ -1485,24 +1473,26 @@ Module Make (W0:CyclicType) <: NType. forall x, 0 < [head0 (double_size x)]. Proof. intros x. - assert (F: 0 < Zpos (digits x)). - red; auto. - case (Zle_lt_or_eq _ _ (spec_pos (head0 (double_size x)))); auto; intros F0. - case (Zle_lt_or_eq _ _ (spec_pos (head0 x))); intros F1. - apply Zlt_le_trans with (2 := (spec_double_size_head0 x)); auto with zarith. - case (Zle_lt_or_eq _ _ (spec_pos x)); intros F3. + assert (F := Pos2Z.is_pos (digits x)). + assert (F0 := spec_pos (head0 (double_size x))). + Z.le_elim F0; auto. + assert (F1 := spec_pos (head0 x)). + Z.le_elim F1. + apply Z.lt_le_trans with (2 := (spec_double_size_head0 x)); auto with zarith. + assert (F3 := spec_pos x). + Z.le_elim F3. generalize F3; rewrite <- (spec_double_size x); intros F4. absurd (2 ^ (Zpos (xO (digits x)) - 1) < 2 ^ (Zpos (digits x))). - apply Zle_not_lt. - apply Zpower_le_monotone2; auto with zarith. - rewrite Zpos_xO; auto with zarith. + { apply Z.le_ngt. + apply Z.pow_le_mono_r; auto with zarith. + rewrite Pos2Z.inj_xO; auto with zarith. } case (spec_head0 x F3). - rewrite <- F1; rewrite Zpower_0_r; rewrite Zmult_1_l; intros _ HH. - apply Zle_lt_trans with (2 := HH). + rewrite <- F1; rewrite Z.pow_0_r; rewrite Z.mul_1_l; intros _ HH. + apply Z.le_lt_trans with (2 := HH). case (spec_head0 _ F4). rewrite (spec_double_size x); rewrite (spec_double_size_digits x). - rewrite <- F0; rewrite Zpower_0_r; rewrite Zmult_1_l; auto. - generalize F1; rewrite (spec_head00 _ (sym_equal F3)); auto with zarith. + rewrite <- F0; rewrite Z.pow_0_r; rewrite Z.mul_1_l; auto. + generalize F1; rewrite (spec_head00 _ (eq_sym F3)); auto with zarith. Qed. (** Finally we iterate [double_size] enough before [unsafe_shiftl] @@ -1521,14 +1511,14 @@ Module Make (W0:CyclicType) <: NType. [shiftl_aux_body cont x n] = [x] * 2 ^ [n]. Proof. intros n x p cont H1 H2; unfold shiftl_aux_body. - rewrite spec_compare; case Zcompare_spec; intros H. + rewrite spec_compare; case Z.compare_spec; intros H. apply spec_unsafe_shiftl; auto with zarith. apply spec_unsafe_shiftl; auto with zarith. rewrite H2. rewrite spec_double_size; auto. - rewrite Zplus_comm; rewrite Zpower_exp; auto with zarith. - apply Zle_trans with (2 := spec_double_size_head0 x). - rewrite Zpower_1_r; apply Zmult_le_compat_l; auto with zarith. + rewrite Z.add_comm; rewrite Zpower_exp; auto with zarith. + apply Z.le_trans with (2 := spec_double_size_head0 x). + rewrite Z.pow_1_r; apply Z.mul_le_mono_nonneg_l; auto with zarith. Qed. Fixpoint shiftl_aux p cont x n := @@ -1550,27 +1540,27 @@ Module Make (W0:CyclicType) <: NType. apply spec_shiftl_aux_body with (q); auto. intros x1 H3; apply Hrec with (q + 1)%positive; auto. intros x2 H4; apply Hrec with (p + q + 1)%positive; auto. - rewrite <- Pplus_assoc. - rewrite Zpos_plus_distr; auto. + rewrite <- Pos.add_assoc. + rewrite Pos2Z.inj_add; auto. intros x3 H5; apply H2. - rewrite Zpos_xI. + rewrite Pos2Z.inj_xI. replace (2 * Zpos p + 1 + Zpos q) with (Zpos p + Zpos (p + q + 1)); auto. - repeat rewrite Zpos_plus_distr; ring. + rewrite !Pos2Z.inj_add; ring. intros p Hrec q n x cont H1 H2. apply spec_shiftl_aux_body with (q); auto. intros x1 H3; apply Hrec with (q); auto. - apply Zle_trans with (2 := H3); auto with zarith. - apply Zpower_le_monotone2; auto with zarith. + apply Z.le_trans with (2 := H3); auto with zarith. + apply Z.pow_le_mono_r; auto with zarith. intros x2 H4; apply Hrec with (p + q)%positive; auto. intros x3 H5; apply H2. - rewrite (Zpos_xO p). + rewrite (Pos2Z.inj_xO p). replace (2 * Zpos p + Zpos q) with (Zpos p + Zpos (p + q)); auto. - repeat rewrite Zpos_plus_distr; ring. + rewrite Pos2Z.inj_add; ring. intros q n x cont H1 H2. apply spec_shiftl_aux_body with (q); auto. - rewrite Zplus_comm; auto. + rewrite Z.add_comm; auto. Qed. Definition shiftl x n := @@ -1582,25 +1572,25 @@ Module Make (W0:CyclicType) <: NType. [shiftl x n] = [x] * 2 ^ [n]. Proof. intros x n; unfold shiftl, shiftl_aux_body. - rewrite spec_compare; case Zcompare_spec; intros H. + rewrite spec_compare; case Z.compare_spec; intros H. apply spec_unsafe_shiftl; auto with zarith. apply spec_unsafe_shiftl; auto with zarith. rewrite <- (spec_double_size x). - rewrite spec_compare; case Zcompare_spec; intros H1. + rewrite spec_compare; case Z.compare_spec; intros H1. apply spec_unsafe_shiftl; auto with zarith. apply spec_unsafe_shiftl; auto with zarith. rewrite <- (spec_double_size (double_size x)). apply spec_shiftl_aux with 1%positive. - apply Zle_trans with (2 := spec_double_size_head0 (double_size x)). + apply Z.le_trans with (2 := spec_double_size_head0 (double_size x)). replace (2 ^ 1) with (2 * 1). - apply Zmult_le_compat_l; auto with zarith. + apply Z.mul_le_mono_nonneg_l; auto with zarith. generalize (spec_double_size_head0_pos x); auto with zarith. - rewrite Zpower_1_r; ring. + rewrite Z.pow_1_r; ring. intros x1 H2; apply spec_unsafe_shiftl. - apply Zle_trans with (2 := H2). - apply Zle_trans with (2 ^ Zpos (digits n)); auto with zarith. + apply Z.le_trans with (2 := H2). + apply Z.le_trans with (2 ^ Zpos (digits n)); auto with zarith. case (spec_digits n); auto with zarith. - apply Zpower_le_monotone2; auto with zarith. + apply Z.pow_le_mono_r; auto with zarith. Qed. Lemma spec_shiftl: forall x p, [shiftl x p] = Z.shiftl [x] [p]. diff --git a/theories/Numbers/Natural/BigN/NMake_gen.ml b/theories/Numbers/Natural/BigN/NMake_gen.ml index 59d440c3..278cc8bf 100644 --- a/theories/Numbers/Natural/BigN/NMake_gen.ml +++ b/theories/Numbers/Natural/BigN/NMake_gen.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/BigN/Nbasic.v b/theories/Numbers/Natural/BigN/Nbasic.v index 4717d0b2..5bde1008 100644 --- a/theories/Numbers/Natural/BigN/Nbasic.v +++ b/theories/Numbers/Natural/BigN/Nbasic.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -32,7 +32,7 @@ Proof. transitivity (2 * (2 ^ Z.of_nat n * Zpos p)). rewrite <- IHn. auto. rewrite Z.mul_assoc. - rewrite inj_S. + rewrite Nat2Z.inj_succ. rewrite <- Z.pow_succ_r; auto with zarith. Qed. @@ -41,39 +41,39 @@ Qed. Fixpoint plength (p: positive) : positive := match p with xH => xH - | xO p1 => Psucc (plength p1) - | xI p1 => Psucc (plength p1) + | xO p1 => Pos.succ (plength p1) + | xI p1 => Pos.succ (plength p1) end. Theorem plength_correct: forall p, (Zpos p < 2 ^ Zpos (plength p))%Z. -assert (F: (forall p, 2 ^ (Zpos (Psucc p)) = 2 * 2 ^ Zpos p)%Z). -intros p; replace (Zpos (Psucc p)) with (1 + Zpos p)%Z. +assert (F: (forall p, 2 ^ (Zpos (Pos.succ p)) = 2 * 2 ^ Zpos p)%Z). +intros p; replace (Zpos (Pos.succ p)) with (1 + Zpos p)%Z. rewrite Zpower_exp; auto with zarith. -rewrite Zpos_succ_morphism; unfold Zsucc; auto with zarith. +rewrite Pos2Z.inj_succ; unfold Z.succ; auto with zarith. intros p; elim p; simpl plength; auto. -intros p1 Hp1; rewrite F; repeat rewrite Zpos_xI. +intros p1 Hp1; rewrite F; repeat rewrite Pos2Z.inj_xI. assert (tmp: (forall p, 2 * p = p + p)%Z); try repeat rewrite tmp; auto with zarith. -intros p1 Hp1; rewrite F; rewrite (Zpos_xO p1). +intros p1 Hp1; rewrite F; rewrite (Pos2Z.inj_xO p1). assert (tmp: (forall p, 2 * p = p + p)%Z); try repeat rewrite tmp; auto with zarith. -rewrite Zpower_1_r; auto with zarith. +rewrite Z.pow_1_r; auto with zarith. Qed. -Theorem plength_pred_correct: forall p, (Zpos p <= 2 ^ Zpos (plength (Ppred p)))%Z. -intros p; case (Psucc_pred p); intros H1. +Theorem plength_pred_correct: forall p, (Zpos p <= 2 ^ Zpos (plength (Pos.pred p)))%Z. +intros p; case (Pos.succ_pred_or p); intros H1. subst; simpl plength. -rewrite Zpower_1_r; auto with zarith. +rewrite Z.pow_1_r; auto with zarith. pattern p at 1; rewrite <- H1. -rewrite Zpos_succ_morphism; unfold Zsucc; auto with zarith. -generalize (plength_correct (Ppred p)); auto with zarith. +rewrite Pos2Z.inj_succ; unfold Z.succ; auto with zarith. +generalize (plength_correct (Pos.pred p)); auto with zarith. Qed. Definition Pdiv p q := - match Zdiv (Zpos p) (Zpos q) with + match Z.div (Zpos p) (Zpos q) with Zpos q1 => match (Zpos p) - (Zpos q) * (Zpos q1) with Z0 => q1 - | _ => (Psucc q1) + | _ => (Pos.succ q1) end | _ => xH end. @@ -85,20 +85,20 @@ unfold Pdiv. assert (H1: Zpos q > 0); auto with zarith. assert (H1b: Zpos p >= 0); auto with zarith. generalize (Z_div_ge0 (Zpos p) (Zpos q) H1 H1b). -generalize (Z_div_mod_eq (Zpos p) (Zpos q) H1); case Zdiv. - intros HH _; rewrite HH; rewrite Zmult_0_r; rewrite Zmult_1_r; simpl. +generalize (Z_div_mod_eq (Zpos p) (Zpos q) H1); case Z.div. + intros HH _; rewrite HH; rewrite Z.mul_0_r; rewrite Z.mul_1_r; simpl. case (Z_mod_lt (Zpos p) (Zpos q) H1); auto with zarith. intros q1 H2. replace (Zpos p - Zpos q * Zpos q1) with (Zpos p mod Zpos q). 2: pattern (Zpos p) at 2; rewrite H2; auto with zarith. generalize H2 (Z_mod_lt (Zpos p) (Zpos q) H1); clear H2; - case Zmod. + case Z.modulo. intros HH _; rewrite HH; auto with zarith. - intros r1 HH (_,HH1); rewrite HH; rewrite Zpos_succ_morphism. - unfold Zsucc; rewrite Zmult_plus_distr_r; auto with zarith. + intros r1 HH (_,HH1); rewrite HH; rewrite Pos2Z.inj_succ. + unfold Z.succ; rewrite Z.mul_add_distr_l; auto with zarith. intros r1 _ (HH,_); case HH; auto. intros q1 HH; rewrite HH. -unfold Zge; simpl Zcompare; intros HH1; case HH1; auto. +unfold Z.ge; simpl Z.compare; intros HH1; case HH1; auto. Qed. Definition is_one p := match p with xH => true | _ => false end. @@ -109,7 +109,7 @@ Qed. Definition get_height digits p := let r := Pdiv p digits in - if is_one r then xH else Psucc (plength (Ppred r)). + if is_one r then xH else Pos.succ (plength (Pos.pred r)). Theorem get_height_correct: forall digits N, @@ -119,13 +119,13 @@ unfold get_height. assert (H1 := Pdiv_le N digits). case_eq (is_one (Pdiv N digits)); intros H2. rewrite (is_one_one _ H2) in H1. -rewrite Zmult_1_r in H1. -change (2^(1-1))%Z with 1; rewrite Zmult_1_r; auto. +rewrite Z.mul_1_r in H1. +change (2^(1-1))%Z with 1; rewrite Z.mul_1_r; auto. clear H2. -apply Zle_trans with (1 := H1). -apply Zmult_le_compat_l; auto with zarith. -rewrite Zpos_succ_morphism; unfold Zsucc. -rewrite Zplus_comm; rewrite Zminus_plus. +apply Z.le_trans with (1 := H1). +apply Z.mul_le_mono_nonneg_l; auto with zarith. +rewrite Pos2Z.inj_succ; unfold Z.succ. +rewrite Z.add_comm; rewrite Z.add_simpl_l. apply plength_pred_correct. Qed. @@ -152,18 +152,18 @@ Open Scope nat_scope. Fixpoint plusnS (n m: nat) {struct n} : (n + S m = S (n + m))%nat := match n return (n + S m = S (n + m))%nat with - | 0 => refl_equal (S m) + | 0 => eq_refl (S m) | S n1 => let v := S (S n1 + m) in - eq_ind_r (fun n => S n = v) (refl_equal v) (plusnS n1 m) + eq_ind_r (fun n => S n = v) (eq_refl v) (plusnS n1 m) end. Fixpoint plusn0 n : n + 0 = n := match n return (n + 0 = n) with - | 0 => refl_equal 0 + | 0 => eq_refl 0 | S n1 => let v := S n1 in - eq_ind_r (fun n : nat => S n = v) (refl_equal v) (plusn0 n1) + eq_ind_r (fun n : nat => S n = v) (eq_refl v) (plusn0 n1) end. Fixpoint diff (m n: nat) {struct m}: nat * nat := @@ -177,8 +177,8 @@ Fixpoint diff_l (m n : nat) {struct m} : fst (diff m n) + n = max m n := match m return fst (diff m n) + n = max m n with | 0 => match n return (n = max 0 n) with - | 0 => refl_equal _ - | S n0 => refl_equal _ + | 0 => eq_refl _ + | S n0 => eq_refl _ end | S m1 => match n return (fst (diff (S m1) n) + n = max (S m1) n) @@ -188,7 +188,7 @@ Fixpoint diff_l (m n : nat) {struct m} : fst (diff m n) + n = max m n := let v := fst (diff m1 n1) + n1 in let v1 := fst (diff m1 n1) + S n1 in eq_ind v (fun n => v1 = S n) - (eq_ind v1 (fun n => v1 = n) (refl_equal v1) (S v) (plusnS _ _)) + (eq_ind v1 (fun n => v1 = n) (eq_refl v1) (S v) (plusnS _ _)) _ (diff_l _ _) end end. @@ -197,17 +197,17 @@ Fixpoint diff_r (m n: nat) {struct m}: snd (diff m n) + m = max m n := match m return (snd (diff m n) + m = max m n) with | 0 => match n return (snd (diff 0 n) + 0 = max 0 n) with - | 0 => refl_equal _ + | 0 => eq_refl _ | S _ => plusn0 _ end | S m => match n return (snd (diff (S m) n) + S m = max (S m) n) with - | 0 => refl_equal (snd (diff (S m) 0) + S m) + | 0 => eq_refl (snd (diff (S m) 0) + S m) | S n1 => let v := S (max m n1) in eq_ind_r (fun n => n = v) (eq_ind_r (fun n => S n = v) - (refl_equal v) (diff_r _ _)) (plusnS _ _) + (eq_refl v) (diff_r _ _)) (plusnS _ _) end end. @@ -216,7 +216,7 @@ Fixpoint diff_r (m n: nat) {struct m}: snd (diff m n) + m = max m n := Definition castm (m n: nat) (H: m = n) (x: word w (S m)): (word w (S n)) := match H in (_ = y) return (word w (S y)) with - | refl_equal => x + | eq_refl => x end. Variable m: nat. @@ -314,7 +314,7 @@ Section CompareRec. Lemma base_xO: forall n, base (xO n) = (base n)^2. Proof. intros n1; unfold base. - rewrite (Zpos_xO n1); rewrite Zmult_comm; rewrite Zpower_mult; auto with zarith. + rewrite (Pos2Z.inj_xO n1); rewrite Z.mul_comm; rewrite Z.pow_mul_r; auto with zarith. Qed. Let double_to_Z_pos: forall n x, 0 <= double_to_Z n x < double_wB n := @@ -332,13 +332,13 @@ Section CompareRec. rewrite 2 Hrec. simpl double_to_Z. set (wB := DoubleBase.double_wB wm_base n). - case Zcompare_spec; intros Cmp. + case Z.compare_spec; intros Cmp. rewrite <- Cmp. reflexivity. - symmetry. apply Zgt_lt, Zlt_gt. (* ;-) *) + symmetry. apply Z.gt_lt, Z.lt_gt. (* ;-) *) assert (0 < wB). unfold wB, DoubleBase.double_wB, base; auto with zarith. - change 0 with (0 + 0); apply Zplus_lt_le_compat; auto with zarith. - apply Zmult_lt_0_compat; auto with zarith. + change 0 with (0 + 0); apply Z.add_lt_le_mono; auto with zarith. + apply Z.mul_pos_pos; auto with zarith. case (double_to_Z_pos n xl); auto with zarith. case (double_to_Z_pos n xh); intros; exfalso; omega. Qed. @@ -358,9 +358,9 @@ Section CompareRec. end. Variable spec_compare: forall x y, - compare x y = Zcompare (w_to_Z x) (w_to_Z y). + compare x y = Z.compare (w_to_Z x) (w_to_Z y). Variable spec_compare_m: forall x y, - compare_m x y = Zcompare (wm_to_Z x) (w_to_Z y). + compare_m x y = Z.compare (wm_to_Z x) (w_to_Z y). Variable wm_base_lt: forall x, 0 <= w_to_Z x < base (wm_base). @@ -369,35 +369,35 @@ Section CompareRec. Proof. intros n x; elim n; simpl; auto; clear n. intros n (H0, H); split; auto. - apply Zlt_le_trans with (1:= H). + apply Z.lt_le_trans with (1:= H). unfold double_wB, DoubleBase.double_wB; simpl. rewrite Pshiftl_nat_S, base_xO. set (u := base (Pos.shiftl_nat wm_base n)). assert (0 < u). unfold u, base; auto with zarith. replace (u^2) with (u * u); simpl; auto with zarith. - apply Zle_trans with (1 * u); auto with zarith. - unfold Zpower_pos; simpl; ring. + apply Z.le_trans with (1 * u); auto with zarith. + unfold Z.pow_pos; simpl; ring. Qed. Lemma spec_compare_mn_1: forall n x y, - compare_mn_1 n x y = Zcompare (double_to_Z n x) (w_to_Z y). + compare_mn_1 n x y = Z.compare (double_to_Z n x) (w_to_Z y). Proof. intros n; elim n; simpl; auto; clear n. intros n Hrec x; case x; clear x; auto. intros y; rewrite spec_compare; rewrite w_to_Z_0. reflexivity. intros xh xl y; simpl; - rewrite spec_compare0_mn, Hrec. case Zcompare_spec. + rewrite spec_compare0_mn, Hrec. case Z.compare_spec. intros H1b. - rewrite <- H1b; rewrite Zmult_0_l; rewrite Zplus_0_l; auto. - symmetry. apply Zlt_gt. + rewrite <- H1b; rewrite Z.mul_0_l; rewrite Z.add_0_l; auto. + symmetry. apply Z.lt_gt. case (double_wB_lt n y); intros _ H0. - apply Zlt_le_trans with (1:= H0). + apply Z.lt_le_trans with (1:= H0). fold double_wB. case (double_to_Z_pos n xl); intros H1 H2. - apply Zle_trans with (double_to_Z n xh * double_wB n); auto with zarith. - apply Zle_trans with (1 * double_wB n); auto with zarith. + apply Z.le_trans with (double_to_Z n xh * double_wB n); auto with zarith. + apply Z.le_trans with (1 * double_wB n); auto with zarith. case (double_to_Z_pos n xh); intros; exfalso; omega. Qed. @@ -440,8 +440,8 @@ End AddS. Proof. intros x; elim x; clear x; [intros x1 Hrec | intros x1 Hrec | idtac]; intros y; case y; clear y; intros y1 H || intros H; simpl length_pos; - try (rewrite (Zpos_xI x1) || rewrite (Zpos_xO x1)); - try (rewrite (Zpos_xI y1) || rewrite (Zpos_xO y1)); + try (rewrite (Pos2Z.inj_xI x1) || rewrite (Pos2Z.inj_xO x1)); + try (rewrite (Pos2Z.inj_xI y1) || rewrite (Pos2Z.inj_xO y1)); try (inversion H; fail); try (assert (Zpos x1 < Zpos y1); [apply Hrec; apply lt_S_n | idtac]; auto with zarith); assert (0 < Zpos y1); auto with zarith; red; auto. diff --git a/theories/Numbers/Natural/Binary/NBinary.v b/theories/Numbers/Natural/Binary/NBinary.v index 43ca67dd..3150c561 100644 --- a/theories/Numbers/Natural/Binary/NBinary.v +++ b/theories/Numbers/Natural/Binary/NBinary.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -31,8 +31,8 @@ Time Eval vm_compute in (log 500000). (* 11 sec *) Fixpoint binposlog (p : positive) : N := match p with | xH => 0 -| xO p' => Nsucc (binposlog p') -| xI p' => Nsucc (binposlog p') +| xO p' => N.succ (binposlog p') +| xI p' => N.succ (binposlog p') end. Definition binlog (n : N) : N := diff --git a/theories/Numbers/Natural/Peano/NPeano.v b/theories/Numbers/Natural/Peano/NPeano.v index d5df6329..a510b3ae 100644 --- a/theories/Numbers/Natural/Peano/NPeano.v +++ b/theories/Numbers/Natural/Peano/NPeano.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/SpecViaZ/NSig.v b/theories/Numbers/Natural/SpecViaZ/NSig.v index aaf44ca6..0b8bded0 100644 --- a/theories/Numbers/Natural/SpecViaZ/NSig.v +++ b/theories/Numbers/Natural/SpecViaZ/NSig.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v b/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v index 2c7884ac..37d5db10 100644 --- a/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v +++ b/theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -318,7 +318,7 @@ Program Instance mod_wd : Proper (eq==>eq==>eq) modulo. Theorem div_mod : forall a b, ~b==0 -> a == b*(div a b) + (modulo a b). Proof. -intros a b. zify. intros. apply Z_div_mod_eq_full; auto. +intros a b. zify. intros. apply Z.div_mod; auto. Qed. Theorem mod_bound_pos : forall a b, 0<=a -> 0<b -> @@ -444,7 +444,7 @@ Qed. (** Recursion *) Definition recursion (A : Type) (a : A) (f : NN.t -> A -> A) (n : NN.t) := - Nrect (fun _ => A) a (fun n a => f (NN.of_N n) a) (NN.to_N n). + N.peano_rect (fun _ => A) a (fun n a => f (NN.of_N n) a) (NN.to_N n). Arguments recursion [A] a f n. Instance recursion_wd (A : Type) (Aeq : relation A) : @@ -457,7 +457,7 @@ unfold NN.to_N. rewrite <- Exx'; clear x' Exx'. induction (Z.to_N [x]) using N.peano_ind. simpl; auto. -rewrite 2 Nrect_step. now apply Eff'. +rewrite 2 N.peano_rect_succ. now apply Eff'. Qed. Theorem recursion_0 : @@ -474,7 +474,7 @@ Proof. unfold eq, recursion; intros A Aeq a f EAaa f_wd n. replace (to_N (succ n)) with (N.succ (to_N n)) by (zify; now rewrite <- Z2N.inj_succ by apply spec_pos). -rewrite Nrect_step. +rewrite N.peano_rect_succ. apply f_wd; auto. zify. now rewrite Z2N.id by apply spec_pos. fold (recursion a f n). apply recursion_wd; auto. red; auto. diff --git a/theories/Numbers/NumPrelude.v b/theories/Numbers/NumPrelude.v index ba7859ee..d637295e 100644 --- a/theories/Numbers/NumPrelude.v +++ b/theories/Numbers/NumPrelude.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Rational/BigQ/BigQ.v b/theories/Numbers/Rational/BigQ/BigQ.v index 424db5b7..3b2a372e 100644 --- a/theories/Numbers/Rational/BigQ/BigQ.v +++ b/theories/Numbers/Rational/BigQ/BigQ.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -26,10 +26,10 @@ Module BigN_BigZ <: NType_ZType BigN.BigN BigZ. reflexivity. Qed. Definition Zabs_N := BigZ.to_N. - Lemma spec_Zabs_N : forall z, BigN.to_Z (Zabs_N z) = Zabs (BigZ.to_Z z). + Lemma spec_Zabs_N : forall z, BigN.to_Z (Zabs_N z) = Z.abs (BigZ.to_Z z). Proof. unfold Zabs_N; intros. - rewrite BigZ.spec_to_Z, Zmult_comm; apply Zsgn_Zabs. + rewrite BigZ.spec_to_Z, Z.mul_comm; apply Z.sgn_abs. Qed. End BigN_BigZ. @@ -89,10 +89,10 @@ exact BigQ.div_mul_inv. exact BigQ.mul_inv_diag_l. Qed. Lemma BigQpowerth : - power_theory 1 BigQ.mul BigQ.eq Z_of_N BigQ.power. + power_theory 1 BigQ.mul BigQ.eq Z.of_N BigQ.power. Proof. constructor. intros. BigQ.qify. -replace ([r] ^ Z_of_N n)%Q with (pow_N 1 Qmult [r] n)%Q by (now destruct n). +replace ([r] ^ Z.of_N n)%Q with (pow_N 1 Qmult [r] n)%Q by (now destruct n). destruct n. reflexivity. induction p; simpl; auto; rewrite ?BigQ.spec_mul, ?IHp; reflexivity. Qed. diff --git a/theories/Numbers/Rational/BigQ/QMake.v b/theories/Numbers/Rational/BigQ/QMake.v index 995fbb9e..a13bb511 100644 --- a/theories/Numbers/Rational/BigQ/QMake.v +++ b/theories/Numbers/Rational/BigQ/QMake.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -19,14 +19,14 @@ Require Import NSig ZSig QSig. denominators. But first we will need some glue between [NType] and [ZType]. *) -Module Type NType_ZType (N:NType)(Z:ZType). - Parameter Z_of_N : N.t -> Z.t. - Parameter spec_Z_of_N : forall n, Z.to_Z (Z_of_N n) = N.to_Z n. - Parameter Zabs_N : Z.t -> N.t. - Parameter spec_Zabs_N : forall z, N.to_Z (Zabs_N z) = Zabs (Z.to_Z z). +Module Type NType_ZType (NN:NType)(ZZ:ZType). + Parameter Z_of_N : NN.t -> ZZ.t. + Parameter spec_Z_of_N : forall n, ZZ.to_Z (Z_of_N n) = NN.to_Z n. + Parameter Zabs_N : ZZ.t -> NN.t. + Parameter spec_Zabs_N : forall z, NN.to_Z (Zabs_N z) = Z.abs (ZZ.to_Z z). End NType_ZType. -Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. +Module Make (NN:NType)(ZZ:ZType)(Import NZ:NType_ZType NN ZZ) <: QType. (** The notation of a rational number is either an integer x, interpreted as itself or a pair (x,y) of an integer x and a natural @@ -34,8 +34,8 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. interpreted as 0. *) Inductive t_ := - | Qz : Z.t -> t_ - | Qq : Z.t -> N.t -> t_. + | Qz : ZZ.t -> t_ + | Qq : ZZ.t -> NN.t -> t_. Definition t := t_. @@ -45,41 +45,41 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Local Open Scope Q_scope. - Definition of_Z x: t := Qz (Z.of_Z x). + Definition of_Z x: t := Qz (ZZ.of_Z x). Definition of_Q (q:Q) : t := let (x,y) := q in match y with - | 1%positive => Qz (Z.of_Z x) - | _ => Qq (Z.of_Z x) (N.of_N (Npos y)) + | 1%positive => Qz (ZZ.of_Z x) + | _ => Qq (ZZ.of_Z x) (NN.of_N (Npos y)) end. Definition to_Q (q: t) := match q with - | Qz x => Z.to_Z x # 1 - | Qq x y => if N.eqb y N.zero then 0 - else Z.to_Z x # Z2P (N.to_Z y) + | Qz x => ZZ.to_Z x # 1 + | Qq x y => if NN.eqb y NN.zero then 0 + else ZZ.to_Z x # Z.to_pos (NN.to_Z y) end. Notation "[ x ]" := (to_Q x). Lemma N_to_Z_pos : - forall x, (N.to_Z x <> N.to_Z N.zero)%Z -> (0 < N.to_Z x)%Z. + forall x, (NN.to_Z x <> NN.to_Z NN.zero)%Z -> (0 < NN.to_Z x)%Z. Proof. - intros x; rewrite N.spec_0; generalize (N.spec_pos x). romega. + intros x; rewrite NN.spec_0; generalize (NN.spec_pos x). romega. Qed. Ltac destr_zcompare := case Z.compare_spec; intros ?H. Ltac destr_eqb := match goal with - | |- context [Z.eqb ?x ?y] => - rewrite (Z.spec_eqb x y); - case (Z.eqb_spec (Z.to_Z x) (Z.to_Z y)); + | |- context [ZZ.eqb ?x ?y] => + rewrite (ZZ.spec_eqb x y); + case (Z.eqb_spec (ZZ.to_Z x) (ZZ.to_Z y)); destr_eqb - | |- context [N.eqb ?x ?y] => - rewrite (N.spec_eqb x y); - case (Z.eqb_spec (N.to_Z x) (N.to_Z y)); + | |- context [NN.eqb ?x ?y] => + rewrite (NN.spec_eqb x y); + case (Z.eqb_spec (NN.to_Z x) (NN.to_Z y)); [ | let H:=fresh "H" in try (intro H;generalize (N_to_Z_pos _ H); clear H)]; destr_eqb @@ -87,11 +87,11 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. end. Hint Rewrite - Zplus_0_r Zplus_0_l Zmult_0_r Zmult_0_l Zmult_1_r Zmult_1_l - Z.spec_0 N.spec_0 Z.spec_1 N.spec_1 Z.spec_m1 Z.spec_opp - Z.spec_compare N.spec_compare - Z.spec_add N.spec_add Z.spec_mul N.spec_mul Z.spec_div N.spec_div - Z.spec_gcd N.spec_gcd Zgcd_Zabs Zgcd_1 + Z.add_0_r Z.add_0_l Z.mul_0_r Z.mul_0_l Z.mul_1_r Z.mul_1_l + ZZ.spec_0 NN.spec_0 ZZ.spec_1 NN.spec_1 ZZ.spec_m1 ZZ.spec_opp + ZZ.spec_compare NN.spec_compare + ZZ.spec_add NN.spec_add ZZ.spec_mul NN.spec_mul ZZ.spec_div NN.spec_div + ZZ.spec_gcd NN.spec_gcd Z.gcd_abs_l Z.gcd_1_r spec_Z_of_N spec_Zabs_N : nz. @@ -99,13 +99,13 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Ltac qsimpl := try red; unfold to_Q; simpl; intros; destr_eqb; simpl; nzsimpl; intros; - rewrite ?Z2P_correct by auto; + rewrite ?Z2Pos.id by auto; auto. Theorem strong_spec_of_Q: forall q: Q, [of_Q q] = q. Proof. - intros(x,y); destruct y; simpl; rewrite ?Z.spec_of_Z; auto; - destr_eqb; now rewrite ?N.spec_0, ?N.spec_of_N. + intros(x,y); destruct y; simpl; rewrite ?ZZ.spec_of_Z; auto; + destr_eqb; now rewrite ?NN.spec_0, ?NN.spec_of_N. Qed. Theorem spec_of_Q: forall q: Q, [of_Q q] == q. @@ -115,9 +115,9 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Definition eq x y := [x] == [y]. - Definition zero: t := Qz Z.zero. - Definition one: t := Qz Z.one. - Definition minus_one: t := Qz Z.minus_one. + Definition zero: t := Qz ZZ.zero. + Definition one: t := Qz ZZ.one. + Definition minus_one: t := Qz ZZ.minus_one. Lemma spec_0: [zero] == 0. Proof. @@ -136,20 +136,20 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Definition compare (x y: t) := match x, y with - | Qz zx, Qz zy => Z.compare zx zy + | Qz zx, Qz zy => ZZ.compare zx zy | Qz zx, Qq ny dy => - if N.eqb dy N.zero then Z.compare zx Z.zero - else Z.compare (Z.mul zx (Z_of_N dy)) ny + if NN.eqb dy NN.zero then ZZ.compare zx ZZ.zero + else ZZ.compare (ZZ.mul zx (Z_of_N dy)) ny | Qq nx dx, Qz zy => - if N.eqb dx N.zero then Z.compare Z.zero zy - else Z.compare nx (Z.mul zy (Z_of_N dx)) + if NN.eqb dx NN.zero then ZZ.compare ZZ.zero zy + else ZZ.compare nx (ZZ.mul zy (Z_of_N dx)) | Qq nx dx, Qq ny dy => - match N.eqb dx N.zero, N.eqb dy N.zero with + match NN.eqb dx NN.zero, NN.eqb dy NN.zero with | true, true => Eq - | true, false => Z.compare Z.zero ny - | false, true => Z.compare nx Z.zero - | false, false => Z.compare (Z.mul nx (Z_of_N dy)) - (Z.mul ny (Z_of_N dx)) + | true, false => ZZ.compare ZZ.zero ny + | false, true => ZZ.compare nx ZZ.zero + | false, false => ZZ.compare (ZZ.mul nx (Z_of_N dy)) + (ZZ.mul ny (Z_of_N dx)) end end. @@ -188,7 +188,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. (** [check_int] : is a reduced fraction [n/d] in fact a integer ? *) Definition check_int n d := - match N.compare N.one d with + match NN.compare NN.one d with | Lt => Qq n d | Eq => Qz n | Gt => zero (* n/0 encodes 0 *) @@ -207,9 +207,9 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. (** Normalisation function *) Definition norm n d : t := - let gcd := N.gcd (Zabs_N n) d in - match N.compare N.one gcd with - | Lt => check_int (Z.div n (Z_of_N gcd)) (N.div d gcd) + let gcd := NN.gcd (Zabs_N n) d in + match NN.compare NN.one gcd with + | Lt => check_int (ZZ.div n (Z_of_N gcd)) (NN.div d gcd) | Eq => check_int n d | Gt => zero (* gcd = 0 => both numbers are 0 *) end. @@ -217,8 +217,8 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Theorem spec_norm: forall n q, [norm n q] == [Qq n q]. Proof. intros p q; unfold norm. - assert (Hp := N.spec_pos (Zabs_N p)). - assert (Hq := N.spec_pos q). + assert (Hp := NN.spec_pos (Zabs_N p)). + assert (Hq := NN.spec_pos q). nzsimpl. destr_zcompare. (* Eq *) @@ -226,15 +226,15 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. (* Lt *) rewrite strong_spec_check_int. qsimpl. - generalize (Zgcd_div_pos (Z.to_Z p) (N.to_Z q)). romega. - replace (N.to_Z q) with 0%Z in * by assumption. + generalize (Zgcd_div_pos (ZZ.to_Z p) (NN.to_Z q)). romega. + replace (NN.to_Z q) with 0%Z in * by assumption. rewrite Zdiv_0_l in *; auto with zarith. apply Zgcd_div_swap0; romega. (* Gt *) qsimpl. - assert (H' : Zgcd (Z.to_Z p) (N.to_Z q) = 0%Z). - generalize (Zgcd_is_pos (Z.to_Z p) (N.to_Z q)); romega. - symmetry; apply (Zgcd_inv_0_l _ _ H'); auto. + assert (H' : Z.gcd (ZZ.to_Z p) (NN.to_Z q) = 0%Z). + generalize (Z.gcd_nonneg (ZZ.to_Z p) (NN.to_Z q)); romega. + symmetry; apply (Z.gcd_eq_0_l _ _ H'); auto. Qed. Theorem strong_spec_norm : forall p q, [norm p q] = Qred [Qq p q]. @@ -244,8 +244,8 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. (apply Qred_complete; apply spec_norm). symmetry; apply Qred_identity. unfold norm. - assert (Hp := N.spec_pos (Zabs_N p)). - assert (Hq := N.spec_pos q). + assert (Hp := NN.spec_pos (Zabs_N p)). + assert (Hq := NN.spec_pos q). nzsimpl. destr_zcompare; rewrite ?strong_spec_check_int. (* Eq *) @@ -253,10 +253,10 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. (* Lt *) qsimpl. rewrite Zgcd_1_rel_prime. - destruct (Z_lt_le_dec 0 (N.to_Z q)). + destruct (Z_lt_le_dec 0 (NN.to_Z q)). apply Zis_gcd_rel_prime; auto with zarith. apply Zgcd_is_gcd. - replace (N.to_Z q) with 0%Z in * by romega. + replace (NN.to_Z q) with 0%Z in * by romega. rewrite Zdiv_0_l in *; romega. (* Gt *) simpl; auto with zarith. @@ -292,20 +292,20 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. match x with | Qz zx => match y with - | Qz zy => Qz (Z.add zx zy) + | Qz zy => Qz (ZZ.add zx zy) | Qq ny dy => - if N.eqb dy N.zero then x - else Qq (Z.add (Z.mul zx (Z_of_N dy)) ny) dy + if NN.eqb dy NN.zero then x + else Qq (ZZ.add (ZZ.mul zx (Z_of_N dy)) ny) dy end | Qq nx dx => - if N.eqb dx N.zero then y + if NN.eqb dx NN.zero then y else match y with - | Qz zy => Qq (Z.add nx (Z.mul zy (Z_of_N dx))) dx + | Qz zy => Qq (ZZ.add nx (ZZ.mul zy (Z_of_N dx))) dx | Qq ny dy => - if N.eqb dy N.zero then x + if NN.eqb dy NN.zero then x else - let n := Z.add (Z.mul nx (Z_of_N dy)) (Z.mul ny (Z_of_N dx)) in - let d := N.mul dx dy in + let n := ZZ.add (ZZ.mul nx (Z_of_N dy)) (ZZ.mul ny (Z_of_N dx)) in + let d := NN.mul dx dy in Qq n d end end. @@ -314,30 +314,30 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Proof. intros [x | nx dx] [y | ny dy]; unfold Qplus; qsimpl; auto with zarith. - rewrite Pmult_1_r, Z2P_correct; auto. - rewrite Pmult_1_r, Z2P_correct; auto. - destruct (Zmult_integral (N.to_Z dx) (N.to_Z dy)); intuition. - rewrite Zpos_mult_morphism, 2 Z2P_correct; auto. + rewrite Pos.mul_1_r, Z2Pos.id; auto. + rewrite Pos.mul_1_r, Z2Pos.id; auto. + rewrite Z.mul_eq_0 in *; intuition. + rewrite Pos2Z.inj_mul, 2 Z2Pos.id; auto. Qed. Definition add_norm (x y: t): t := match x with | Qz zx => match y with - | Qz zy => Qz (Z.add zx zy) + | Qz zy => Qz (ZZ.add zx zy) | Qq ny dy => - if N.eqb dy N.zero then x - else norm (Z.add (Z.mul zx (Z_of_N dy)) ny) dy + if NN.eqb dy NN.zero then x + else norm (ZZ.add (ZZ.mul zx (Z_of_N dy)) ny) dy end | Qq nx dx => - if N.eqb dx N.zero then y + if NN.eqb dx NN.zero then y else match y with - | Qz zy => norm (Z.add nx (Z.mul zy (Z_of_N dx))) dx + | Qz zy => norm (ZZ.add nx (ZZ.mul zy (Z_of_N dx))) dx | Qq ny dy => - if N.eqb dy N.zero then x + if NN.eqb dy NN.zero then x else - let n := Z.add (Z.mul nx (Z_of_N dy)) (Z.mul ny (Z_of_N dx)) in - let d := N.mul dx dy in + let n := ZZ.add (ZZ.mul nx (Z_of_N dy)) (ZZ.mul ny (Z_of_N dx)) in + let d := NN.mul dx dy in norm n d end end. @@ -363,18 +363,18 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Definition opp (x: t): t := match x with - | Qz zx => Qz (Z.opp zx) - | Qq nx dx => Qq (Z.opp nx) dx + | Qz zx => Qz (ZZ.opp zx) + | Qq nx dx => Qq (ZZ.opp nx) dx end. Theorem strong_spec_opp: forall q, [opp q] = -[q]. Proof. intros [z | x y]; simpl. - rewrite Z.spec_opp; auto. - match goal with |- context[N.eqb ?X ?Y] => - generalize (N.spec_eqb X Y); case N.eqb - end; auto; rewrite N.spec_0. - rewrite Z.spec_opp; auto. + rewrite ZZ.spec_opp; auto. + match goal with |- context[NN.eqb ?X ?Y] => + generalize (NN.spec_eqb X Y); case NN.eqb + end; auto; rewrite NN.spec_0. + rewrite ZZ.spec_opp; auto. Qed. Theorem spec_opp : forall q, [opp q] == -[q]. @@ -416,28 +416,28 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Definition mul (x y: t): t := match x, y with - | Qz zx, Qz zy => Qz (Z.mul zx zy) - | Qz zx, Qq ny dy => Qq (Z.mul zx ny) dy - | Qq nx dx, Qz zy => Qq (Z.mul nx zy) dx - | Qq nx dx, Qq ny dy => Qq (Z.mul nx ny) (N.mul dx dy) + | Qz zx, Qz zy => Qz (ZZ.mul zx zy) + | Qz zx, Qq ny dy => Qq (ZZ.mul zx ny) dy + | Qq nx dx, Qz zy => Qq (ZZ.mul nx zy) dx + | Qq nx dx, Qq ny dy => Qq (ZZ.mul nx ny) (NN.mul dx dy) end. Ltac nsubst := - match goal with E : N.to_Z _ = _ |- _ => rewrite E in * end. + match goal with E : NN.to_Z _ = _ |- _ => rewrite E in * end. Theorem spec_mul : forall x y, [mul x y] == [x] * [y]. Proof. intros [x | nx dx] [y | ny dy]; unfold Qmult; simpl; qsimpl. - rewrite Pmult_1_r, Z2P_correct; auto. - destruct (Zmult_integral (N.to_Z dx) (N.to_Z dy)); intuition. + rewrite Pos.mul_1_r, Z2Pos.id; auto. + rewrite Z.mul_eq_0 in *; intuition. nsubst; auto with zarith. nsubst; auto with zarith. nsubst; nzsimpl; auto with zarith. - rewrite Zpos_mult_morphism, 2 Z2P_correct; auto. + rewrite Pos2Z.inj_mul, 2 Z2Pos.id; auto. Qed. Definition norm_denum n d := - if N.eqb d N.one then Qz n else Qq n d. + if NN.eqb d NN.one then Qz n else Qq n d. Lemma spec_norm_denum : forall n d, [norm_denum n d] == [Qq n d]. @@ -448,40 +448,40 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Qed. Definition irred n d := - let gcd := N.gcd (Zabs_N n) d in - match N.compare gcd N.one with - | Gt => (Z.div n (Z_of_N gcd), N.div d gcd) + let gcd := NN.gcd (Zabs_N n) d in + match NN.compare gcd NN.one with + | Gt => (ZZ.div n (Z_of_N gcd), NN.div d gcd) | _ => (n, d) end. Lemma spec_irred : forall n d, exists g, let (n',d') := irred n d in - (Z.to_Z n' * g = Z.to_Z n)%Z /\ (N.to_Z d' * g = N.to_Z d)%Z. + (ZZ.to_Z n' * g = ZZ.to_Z n)%Z /\ (NN.to_Z d' * g = NN.to_Z d)%Z. Proof. intros. unfold irred; nzsimpl; simpl. destr_zcompare. exists 1%Z; nzsimpl; auto. exists 0%Z; nzsimpl. - assert (Zgcd (Z.to_Z n) (N.to_Z d) = 0%Z). - generalize (Zgcd_is_pos (Z.to_Z n) (N.to_Z d)); romega. + assert (Z.gcd (ZZ.to_Z n) (NN.to_Z d) = 0%Z). + generalize (Z.gcd_nonneg (ZZ.to_Z n) (NN.to_Z d)); romega. clear H. split. - symmetry; apply (Zgcd_inv_0_l _ _ H0). - symmetry; apply (Zgcd_inv_0_r _ _ H0). - exists (Zgcd (Z.to_Z n) (N.to_Z d)). + symmetry; apply (Z.gcd_eq_0_l _ _ H0). + symmetry; apply (Z.gcd_eq_0_r _ _ H0). + exists (Z.gcd (ZZ.to_Z n) (NN.to_Z d)). simpl. split. nzsimpl. - destruct (Zgcd_is_gcd (Z.to_Z n) (N.to_Z d)). - rewrite Zmult_comm; symmetry; apply Zdivide_Zdiv_eq; auto with zarith. + destruct (Zgcd_is_gcd (ZZ.to_Z n) (NN.to_Z d)). + rewrite Z.mul_comm; symmetry; apply Zdivide_Zdiv_eq; auto with zarith. nzsimpl. - destruct (Zgcd_is_gcd (Z.to_Z n) (N.to_Z d)). - rewrite Zmult_comm; symmetry; apply Zdivide_Zdiv_eq; auto with zarith. + destruct (Zgcd_is_gcd (ZZ.to_Z n) (NN.to_Z d)). + rewrite Z.mul_comm; symmetry; apply Zdivide_Zdiv_eq; auto with zarith. Qed. Lemma spec_irred_zero : forall n d, - (N.to_Z d = 0)%Z <-> (N.to_Z (snd (irred n d)) = 0)%Z. + (NN.to_Z d = 0)%Z <-> (NN.to_Z (snd (irred n d)) = 0)%Z. Proof. intros. unfold irred. @@ -494,8 +494,8 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. nzsimpl; destr_zcompare; simpl; auto. nzsimpl. intros. - generalize (N.spec_pos d); intros. - destruct (N.to_Z d); auto. + generalize (NN.spec_pos d); intros. + destruct (NN.to_Z d); auto. assert (0 < 0)%Z. rewrite <- H0 at 2. apply Zgcd_div_pos; auto with zarith. @@ -505,49 +505,49 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Qed. Lemma strong_spec_irred : forall n d, - (N.to_Z d <> 0%Z) -> - let (n',d') := irred n d in Zgcd (Z.to_Z n') (N.to_Z d') = 1%Z. + (NN.to_Z d <> 0%Z) -> + let (n',d') := irred n d in Z.gcd (ZZ.to_Z n') (NN.to_Z d') = 1%Z. Proof. unfold irred; intros. nzsimpl. destr_zcompare; simpl; auto. elim H. - apply (Zgcd_inv_0_r (Z.to_Z n)). - generalize (Zgcd_is_pos (Z.to_Z n) (N.to_Z d)); romega. + apply (Z.gcd_eq_0_r (ZZ.to_Z n)). + generalize (Z.gcd_nonneg (ZZ.to_Z n) (NN.to_Z d)); romega. nzsimpl. rewrite Zgcd_1_rel_prime. apply Zis_gcd_rel_prime. - generalize (N.spec_pos d); romega. - generalize (Zgcd_is_pos (Z.to_Z n) (N.to_Z d)); romega. + generalize (NN.spec_pos d); romega. + generalize (Z.gcd_nonneg (ZZ.to_Z n) (NN.to_Z d)); romega. apply Zgcd_is_gcd; auto. Qed. Definition mul_norm_Qz_Qq z n d := - if Z.eqb z Z.zero then zero + if ZZ.eqb z ZZ.zero then zero else - let gcd := N.gcd (Zabs_N z) d in - match N.compare gcd N.one with + let gcd := NN.gcd (Zabs_N z) d in + match NN.compare gcd NN.one with | Gt => - let z := Z.div z (Z_of_N gcd) in - let d := N.div d gcd in - norm_denum (Z.mul z n) d - | _ => Qq (Z.mul z n) d + let z := ZZ.div z (Z_of_N gcd) in + let d := NN.div d gcd in + norm_denum (ZZ.mul z n) d + | _ => Qq (ZZ.mul z n) d end. Definition mul_norm (x y: t): t := match x, y with - | Qz zx, Qz zy => Qz (Z.mul zx zy) + | Qz zx, Qz zy => Qz (ZZ.mul zx zy) | Qz zx, Qq ny dy => mul_norm_Qz_Qq zx ny dy | Qq nx dx, Qz zy => mul_norm_Qz_Qq zy nx dx | Qq nx dx, Qq ny dy => let (nx, dy) := irred nx dy in let (ny, dx) := irred ny dx in - norm_denum (Z.mul ny nx) (N.mul dx dy) + norm_denum (ZZ.mul ny nx) (NN.mul dx dy) end. Lemma spec_mul_norm_Qz_Qq : forall z n d, - [mul_norm_Qz_Qq z n d] == [Qq (Z.mul z n) d]. + [mul_norm_Qz_Qq z n d] == [Qq (ZZ.mul z n) d]. Proof. intros z n d; unfold mul_norm_Qz_Qq; nzsimpl; rewrite Zcompare_gt. destr_eqb; nzsimpl; intros Hz. @@ -558,7 +558,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. qsimpl. rewrite Zdiv_gcd_zero in GT; auto with zarith. nsubst. rewrite Zdiv_0_l in *; discriminate. - rewrite <- Zmult_assoc, (Zmult_comm (Z.to_Z n)), Zmult_assoc. + rewrite <- Z.mul_assoc, (Z.mul_comm (ZZ.to_Z n)), Z.mul_assoc. rewrite Zgcd_div_swap0; try romega. ring. Qed. @@ -582,34 +582,34 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. destr_eqb; simpl; nzsimpl; auto. nzsimpl; rewrite Hd, Zdiv_0_l; auto with zarith. - rewrite Z2P_correct in H; auto. + rewrite Z2Pos.id in H; auto. unfold mul_norm_Qz_Qq; nzsimpl; rewrite Zcompare_gt. destr_eqb; intros Hz; simpl; nzsimpl; simpl; auto. destruct Z_le_gt_dec as [H'|H']. simpl; nzsimpl. destr_eqb; simpl; nzsimpl; auto. intros. - rewrite Z2P_correct; auto. + rewrite Z2Pos.id; auto. apply Zgcd_mult_rel_prime; auto. - generalize (Zgcd_inv_0_l (Z.to_Z z) (N.to_Z d)) - (Zgcd_is_pos (Z.to_Z z) (N.to_Z d)); romega. + generalize (Z.gcd_eq_0_l (ZZ.to_Z z) (NN.to_Z d)) + (Z.gcd_nonneg (ZZ.to_Z z) (NN.to_Z d)); romega. destr_eqb; simpl; nzsimpl; auto. unfold norm_denum. destr_eqb; nzsimpl; simpl; destr_eqb; simpl; auto. intros; nzsimpl. - rewrite Z2P_correct; auto. + rewrite Z2Pos.id; auto. apply Zgcd_mult_rel_prime. rewrite Zgcd_1_rel_prime. apply Zis_gcd_rel_prime. - generalize (N.spec_pos d); romega. - generalize (Zgcd_is_pos (Z.to_Z z) (N.to_Z d)); romega. + generalize (NN.spec_pos d); romega. + generalize (Z.gcd_nonneg (ZZ.to_Z z) (NN.to_Z d)); romega. apply Zgcd_is_gcd. - destruct (Zgcd_is_gcd (Z.to_Z z) (N.to_Z d)) as [ (z0,Hz0) (d0,Hd0) Hzd]. - replace (N.to_Z d / Zgcd (Z.to_Z z) (N.to_Z d))%Z with d0. + destruct (Zgcd_is_gcd (ZZ.to_Z z) (NN.to_Z d)) as [ (z0,Hz0) (d0,Hd0) Hzd]. + replace (NN.to_Z d / Z.gcd (ZZ.to_Z z) (NN.to_Z d))%Z with d0. rewrite Zgcd_1_rel_prime in *. apply bezout_rel_prime. destruct (rel_prime_bezout _ _ H) as [u v Huv]. - apply Bezout_intro with u (v*(Zgcd (Z.to_Z z) (N.to_Z d)))%Z. + apply Bezout_intro with u (v*(Z.gcd (ZZ.to_Z z) (NN.to_Z d)))%Z. rewrite <- Huv; rewrite Hd0 at 2; ring. rewrite Hd0 at 1. symmetry; apply Z_div_mult_full; auto with zarith. @@ -634,14 +634,14 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. qsimpl. match goal with E : (_ * _ = 0)%Z |- _ => - destruct (Zmult_integral _ _ E) as [Eq|Eq] end. + rewrite Z.mul_eq_0 in E; destruct E as [Eq|Eq] end. rewrite Eq in *; simpl in *. rewrite <- Hg2' in *; auto with zarith. rewrite Eq in *; simpl in *. rewrite <- Hg2 in *; auto with zarith. match goal with E : (_ * _ = 0)%Z |- _ => - destruct (Zmult_integral _ _ E) as [Eq|Eq] end. + rewrite Z.mul_eq_0 in E; destruct E as [Eq|Eq] end. rewrite Hz' in Eq; rewrite Eq in *; auto with zarith. rewrite Hz in Eq; rewrite Eq in *; auto with zarith. @@ -671,31 +671,31 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. unfold norm_denum; qsimpl. - assert (NEQ : N.to_Z dy <> 0%Z) by + assert (NEQ : NN.to_Z dy <> 0%Z) by (rewrite Hz; intros EQ; rewrite EQ in *; romega). specialize (Hgc NEQ). - assert (NEQ' : N.to_Z dx <> 0%Z) by + assert (NEQ' : NN.to_Z dx <> 0%Z) by (rewrite Hz'; intro EQ; rewrite EQ in *; romega). specialize (Hgc' NEQ'). revert H H0. rewrite 2 strong_spec_red, 2 Qred_iff; simpl. destr_eqb; simpl; nzsimpl; try romega; intros. - rewrite Z2P_correct in *; auto. + rewrite Z2Pos.id in *; auto. - apply Zgcd_mult_rel_prime; rewrite Zgcd_comm; - apply Zgcd_mult_rel_prime; rewrite Zgcd_comm; auto. + apply Zgcd_mult_rel_prime; rewrite Z.gcd_comm; + apply Zgcd_mult_rel_prime; rewrite Z.gcd_comm; auto. rewrite Zgcd_1_rel_prime in *. apply bezout_rel_prime. - destruct (rel_prime_bezout (Z.to_Z ny) (N.to_Z dy)) as [u v Huv]; trivial. + destruct (rel_prime_bezout (ZZ.to_Z ny) (NN.to_Z dy)) as [u v Huv]; trivial. apply Bezout_intro with (u*g')%Z (v*g)%Z. rewrite <- Huv, <- Hg1', <- Hg2. ring. rewrite Zgcd_1_rel_prime in *. apply bezout_rel_prime. - destruct (rel_prime_bezout (Z.to_Z nx) (N.to_Z dx)) as [u v Huv]; trivial. + destruct (rel_prime_bezout (ZZ.to_Z nx) (NN.to_Z dx)) as [u v Huv]; trivial. apply Bezout_intro with (u*g)%Z (v*g')%Z. rewrite <- Huv, <- Hg2', <- Hg1. ring. Qed. @@ -703,16 +703,16 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Definition inv (x: t): t := match x with | Qz z => - match Z.compare Z.zero z with + match ZZ.compare ZZ.zero z with | Eq => zero - | Lt => Qq Z.one (Zabs_N z) - | Gt => Qq Z.minus_one (Zabs_N z) + | Lt => Qq ZZ.one (Zabs_N z) + | Gt => Qq ZZ.minus_one (Zabs_N z) end | Qq n d => - match Z.compare Z.zero n with + match ZZ.compare ZZ.zero n with | Eq => zero | Lt => Qq (Z_of_N d) (Zabs_N n) - | Gt => Qq (Z.opp (Z_of_N d)) (Zabs_N n) + | Gt => Qq (ZZ.opp (Z_of_N d)) (Zabs_N n) end end. @@ -721,29 +721,29 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. destruct x as [ z | n d ]. (* Qz z *) simpl. - rewrite Z.spec_compare; destr_zcompare. + rewrite ZZ.spec_compare; destr_zcompare. (* 0 = z *) rewrite <- H. simpl; nzsimpl; compute; auto. (* 0 < z *) simpl. - destr_eqb; nzsimpl; [ intros; rewrite Zabs_eq in *; romega | intros _ ]. - set (z':=Z.to_Z z) in *; clearbody z'. + destr_eqb; nzsimpl; [ intros; rewrite Z.abs_eq in *; romega | intros _ ]. + set (z':=ZZ.to_Z z) in *; clearbody z'. red; simpl. - rewrite Zabs_eq by romega. - rewrite Z2P_correct by auto. + rewrite Z.abs_eq by romega. + rewrite Z2Pos.id by auto. unfold Qinv; simpl; destruct z'; simpl; auto; discriminate. (* 0 > z *) simpl. - destr_eqb; nzsimpl; [ intros; rewrite Zabs_non_eq in *; romega | intros _ ]. - set (z':=Z.to_Z z) in *; clearbody z'. + destr_eqb; nzsimpl; [ intros; rewrite Z.abs_neq in *; romega | intros _ ]. + set (z':=ZZ.to_Z z) in *; clearbody z'. red; simpl. - rewrite Zabs_non_eq by romega. - rewrite Z2P_correct by romega. + rewrite Z.abs_neq by romega. + rewrite Z2Pos.id by romega. unfold Qinv; simpl; destruct z'; simpl; auto; discriminate. (* Qq n d *) simpl. - rewrite Z.spec_compare; destr_zcompare. + rewrite ZZ.spec_compare; destr_zcompare. (* 0 = n *) rewrite <- H. simpl; nzsimpl. @@ -751,51 +751,51 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. (* 0 < n *) simpl. destr_eqb; nzsimpl; intros. - intros; rewrite Zabs_eq in *; romega. - intros; rewrite Zabs_eq in *; romega. + intros; rewrite Z.abs_eq in *; romega. + intros; rewrite Z.abs_eq in *; romega. nsubst; compute; auto. - set (n':=Z.to_Z n) in *; clearbody n'. - rewrite Zabs_eq by romega. + set (n':=ZZ.to_Z n) in *; clearbody n'. + rewrite Z.abs_eq by romega. red; simpl. - rewrite Z2P_correct by auto. + rewrite Z2Pos.id by auto. unfold Qinv; simpl; destruct n'; simpl; auto; try discriminate. - rewrite Zpos_mult_morphism, Z2P_correct; auto. + rewrite Pos2Z.inj_mul, Z2Pos.id; auto. (* 0 > n *) simpl. destr_eqb; nzsimpl; intros. - intros; rewrite Zabs_non_eq in *; romega. - intros; rewrite Zabs_non_eq in *; romega. + intros; rewrite Z.abs_neq in *; romega. + intros; rewrite Z.abs_neq in *; romega. nsubst; compute; auto. - set (n':=Z.to_Z n) in *; clearbody n'. + set (n':=ZZ.to_Z n) in *; clearbody n'. red; simpl; nzsimpl. - rewrite Zabs_non_eq by romega. - rewrite Z2P_correct by romega. + rewrite Z.abs_neq by romega. + rewrite Z2Pos.id by romega. unfold Qinv; simpl; destruct n'; simpl; auto; try discriminate. - assert (T : forall x, Zneg x = Zopp (Zpos x)) by auto. - rewrite T, Zpos_mult_morphism, Z2P_correct; auto; ring. + assert (T : forall x, Zneg x = Z.opp (Zpos x)) by auto. + rewrite T, Pos2Z.inj_mul, Z2Pos.id; auto; ring. Qed. Definition inv_norm (x: t): t := match x with | Qz z => - match Z.compare Z.zero z with + match ZZ.compare ZZ.zero z with | Eq => zero - | Lt => Qq Z.one (Zabs_N z) - | Gt => Qq Z.minus_one (Zabs_N z) + | Lt => Qq ZZ.one (Zabs_N z) + | Gt => Qq ZZ.minus_one (Zabs_N z) end | Qq n d => - if N.eqb d N.zero then zero else - match Z.compare Z.zero n with + if NN.eqb d NN.zero then zero else + match ZZ.compare ZZ.zero n with | Eq => zero | Lt => - match Z.compare n Z.one with + match ZZ.compare n ZZ.one with | Gt => Qq (Z_of_N d) (Zabs_N n) | _ => Qz (Z_of_N d) end | Gt => - match Z.compare n Z.minus_one with - | Lt => Qq (Z.opp (Z_of_N d)) (Zabs_N n) - | _ => Qz (Z.opp (Z_of_N d)) + match ZZ.compare n ZZ.minus_one with + | Lt => Qq (ZZ.opp (Z_of_N d)) (Zabs_N n) + | _ => Qz (ZZ.opp (Z_of_N d)) end end end. @@ -807,7 +807,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. destruct x as [ z | n d ]. (* Qz z *) simpl. - rewrite Z.spec_compare; destr_zcompare; auto with qarith. + rewrite ZZ.spec_compare; destr_zcompare; auto with qarith. (* Qq n d *) simpl; nzsimpl; destr_eqb. destr_zcompare; simpl; auto with qarith. @@ -818,12 +818,12 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. (* 0 < n *) destr_zcompare; auto with qarith. destr_zcompare; nzsimpl; simpl; auto with qarith; intros. - destr_eqb; nzsimpl; [ intros; rewrite Zabs_eq in *; romega | intros _ ]. + destr_eqb; nzsimpl; [ intros; rewrite Z.abs_eq in *; romega | intros _ ]. rewrite H0; auto with qarith. romega. (* 0 > n *) destr_zcompare; nzsimpl; simpl; auto with qarith. - destr_eqb; nzsimpl; [ intros; rewrite Zabs_non_eq in *; romega | intros _ ]. + destr_eqb; nzsimpl; [ intros; rewrite Z.abs_neq in *; romega | intros _ ]. rewrite H0; auto with qarith. romega. Qed. @@ -847,36 +847,36 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. (* 0 < n *) destr_zcompare; simpl; nzsimpl; auto. destr_eqb; nzsimpl; simpl; auto. - rewrite Zabs_eq; romega. + rewrite Z.abs_eq; romega. intros _. rewrite strong_spec_norm; simpl; nzsimpl. destr_eqb; nzsimpl. - rewrite Zabs_eq; romega. + rewrite Z.abs_eq; romega. intros _. rewrite Qred_iff. simpl. - rewrite Zabs_eq; auto with zarith. - rewrite Z2P_correct in *; auto. - rewrite Zgcd_comm; auto. + rewrite Z.abs_eq; auto with zarith. + rewrite Z2Pos.id in *; auto. + rewrite Z.gcd_comm; auto. (* 0 > n *) destr_eqb; nzsimpl; simpl; auto; intros. destr_zcompare; simpl; nzsimpl; auto. destr_eqb; nzsimpl. - rewrite Zabs_non_eq; romega. + rewrite Z.abs_neq; romega. intros _. rewrite strong_spec_norm; simpl; nzsimpl. destr_eqb; nzsimpl. - rewrite Zabs_non_eq; romega. + rewrite Z.abs_neq; romega. intros _. rewrite Qred_iff. simpl. - rewrite Z2P_correct in *; auto. + rewrite Z2Pos.id in *; auto. intros. - rewrite Zgcd_comm, Zgcd_Zabs, Zgcd_comm. + rewrite Z.gcd_comm, Z.gcd_abs_l, Z.gcd_comm. apply Zis_gcd_gcd; auto with zarith. apply Zis_gcd_minus. - rewrite Zopp_involutive, <- H1; apply Zgcd_is_gcd. - rewrite Zabs_non_eq; romega. + rewrite Z.opp_involutive, <- H1; apply Zgcd_is_gcd. + rewrite Z.abs_neq; romega. Qed. Definition div x y := mul x (inv y). @@ -909,31 +909,30 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Definition square (x: t): t := match x with - | Qz zx => Qz (Z.square zx) - | Qq nx dx => Qq (Z.square nx) (N.square dx) + | Qz zx => Qz (ZZ.square zx) + | Qq nx dx => Qq (ZZ.square nx) (NN.square dx) end. Theorem spec_square : forall x, [square x] == [x] ^ 2. Proof. destruct x as [ z | n d ]. - simpl; rewrite Z.spec_square; red; auto. + simpl; rewrite ZZ.spec_square; red; auto. simpl. destr_eqb; nzsimpl; intros. apply Qeq_refl. - rewrite N.spec_square in *; nzsimpl. - match goal with E : (_ * _ = 0)%Z |- _ => - elim (Zmult_integral _ _ E); romega end. - rewrite N.spec_square in *; nzsimpl; nsubst; romega. - rewrite Z.spec_square, N.spec_square. + rewrite NN.spec_square in *; nzsimpl. + rewrite Z.mul_eq_0 in *; romega. + rewrite NN.spec_square in *; nzsimpl; nsubst; romega. + rewrite ZZ.spec_square, NN.spec_square. red; simpl. - rewrite Zpos_mult_morphism; rewrite !Z2P_correct; auto. - apply Zmult_lt_0_compat; auto. + rewrite Pos2Z.inj_mul; rewrite !Z2Pos.id; auto. + apply Z.mul_pos_pos; auto. Qed. Definition power_pos (x : t) p : t := match x with - | Qz zx => Qz (Z.pow_pos zx p) - | Qq nx dx => Qq (Z.pow_pos nx p) (N.pow_pos dx p) + | Qz zx => Qz (ZZ.pow_pos zx p) + | Qq nx dx => Qq (ZZ.pow_pos nx p) (NN.pow_pos dx p) end. Theorem spec_power_pos : forall x p, [power_pos x p] == [x] ^ Zpos p. @@ -941,26 +940,26 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. intros [ z | n d ] p; unfold power_pos. (* Qz *) simpl. - rewrite Z.spec_pow_pos. - rewrite Qpower_decomp. + rewrite ZZ.spec_pow_pos, Qpower_decomp. red; simpl; f_equal. - rewrite Zpower_pos_1_l; auto. + now rewrite Pos2Z.inj_pow, Z.pow_1_l. (* Qq *) simpl. - rewrite Z.spec_pow_pos. + rewrite ZZ.spec_pow_pos. destr_eqb; nzsimpl; intros. - apply Qeq_sym; apply Qpower_positive_0. - rewrite N.spec_pow_pos in *. - assert (0 < N.to_Z d ^ ' p)%Z by - (apply Zpower_gt_0; auto with zarith). - romega. - exfalso. - rewrite N.spec_pow_pos in *. nsubst. - rewrite Zpower_0_l in *; [romega|discriminate]. - rewrite Qpower_decomp. - red; simpl; do 3 f_equal. - rewrite Z2P_correct by (generalize (N.spec_pos d); romega). - rewrite N.spec_pow_pos. auto. + - apply Qeq_sym; apply Qpower_positive_0. + - rewrite NN.spec_pow_pos in *. + assert (0 < NN.to_Z d ^ ' p)%Z by + (apply Z.pow_pos_nonneg; auto with zarith). + romega. + - exfalso. + rewrite NN.spec_pow_pos in *. nsubst. + rewrite Z.pow_0_l' in *; [romega|discriminate]. + - rewrite Qpower_decomp. + red; simpl; do 3 f_equal. + apply Pos2Z.inj. rewrite Pos2Z.inj_pow. + rewrite 2 Z2Pos.id by (generalize (NN.spec_pos d); romega). + now rewrite NN.spec_pow_pos. Qed. Instance strong_spec_power_pos x p `(Reduced x) : Reduced (power_pos x p). @@ -976,10 +975,10 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. unfold Reduced; rewrite strong_spec_red, Qred_iff; simpl. destr_eqb; nzsimpl; simpl; intros. exfalso. - rewrite N.spec_pow_pos in *. nsubst. - rewrite Zpower_0_l in *; [romega|discriminate]. - rewrite Z2P_correct in *; auto. - rewrite N.spec_pow_pos, Z.spec_pow_pos; auto. + rewrite NN.spec_pow_pos in *. nsubst. + rewrite Z.pow_0_l' in *; [romega|discriminate]. + rewrite Z2Pos.id in *; auto. + rewrite NN.spec_pow_pos, ZZ.spec_pow_pos; auto. rewrite Zgcd_1_rel_prime in *. apply rel_prime_Zpower; auto with zarith. Qed. @@ -1086,7 +1085,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. [[add x y]] = [[x]] + [[y]]. Proof. unfold to_Qc. - apply trans_equal with (!! ([x] + [y])). + transitivity (!! ([x] + [y])). unfold Q2Qc. apply Qc_decomp; intros _ _; unfold this. apply Qred_complete; apply spec_add; auto. @@ -1100,7 +1099,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. [[add_norm x y]] = [[x]] + [[y]]. Proof. unfold to_Qc. - apply trans_equal with (!! ([x] + [y])). + transitivity (!! ([x] + [y])). unfold Q2Qc. apply Qc_decomp; intros _ _; unfold this. apply Qred_complete; apply spec_add_norm; auto. @@ -1148,7 +1147,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. [[mul x y]] = [[x]] * [[y]]. Proof. unfold to_Qc. - apply trans_equal with (!! ([x] * [y])). + transitivity (!! ([x] * [y])). unfold Q2Qc. apply Qc_decomp; intros _ _; unfold this. apply Qred_complete; apply spec_mul; auto. @@ -1162,7 +1161,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. [[mul_norm x y]] = [[x]] * [[y]]. Proof. unfold to_Qc. - apply trans_equal with (!! ([x] * [y])). + transitivity (!! ([x] * [y])). unfold Q2Qc. apply Qc_decomp; intros _ _; unfold this. apply Qred_complete; apply spec_mul_norm; auto. @@ -1186,7 +1185,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. [[inv x]] = /[[x]]. Proof. unfold to_Qc. - apply trans_equal with (!! (/[x])). + transitivity (!! (/[x])). unfold Q2Qc. apply Qc_decomp; intros _ _; unfold this. apply Qred_complete; apply spec_inv; auto. @@ -1200,7 +1199,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. [[inv_norm x]] = /[[x]]. Proof. unfold to_Qc. - apply trans_equal with (!! (/[x])). + transitivity (!! (/[x])). unfold Q2Qc. apply Qc_decomp; intros _ _; unfold this. apply Qred_complete; apply spec_inv_norm; auto. @@ -1248,7 +1247,7 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Theorem spec_squarec x: [[square x]] = [[x]]^2. Proof. unfold to_Qc. - apply trans_equal with (!! ([x]^2)). + transitivity (!! ([x]^2)). unfold Q2Qc. apply Qc_decomp; intros _ _; unfold this. apply Qred_complete; apply spec_square; auto. @@ -1262,24 +1261,24 @@ Module Make (N:NType)(Z:ZType)(Import NZ:NType_ZType N Z) <: QType. Qed. Theorem spec_power_posc x p: - [[power_pos x p]] = [[x]] ^ nat_of_P p. + [[power_pos x p]] = [[x]] ^ Pos.to_nat p. Proof. unfold to_Qc. - apply trans_equal with (!! ([x]^Zpos p)). + transitivity (!! ([x]^Zpos p)). unfold Q2Qc. apply Qc_decomp; intros _ _; unfold this. apply Qred_complete; apply spec_power_pos; auto. - induction p using Pind. + induction p using Pos.peano_ind. simpl; ring. - rewrite Psucc_S; simpl Qcpower. + rewrite Pos2Nat.inj_succ; simpl Qcpower. rewrite <- IHp; clear IHp. unfold Qcmult, Q2Qc. apply Qc_decomp; intros _ _; unfold this. apply Qred_complete. - setoid_replace ([x] ^ ' Psucc p)%Q with ([x] * [x] ^ ' p)%Q. + setoid_replace ([x] ^ ' Pos.succ p)%Q with ([x] * [x] ^ ' p)%Q. apply Qmult_comp; apply Qeq_sym; apply Qred_correct. simpl. - rewrite Pplus_one_succ_l. + rewrite <- Pos.add_1_l. rewrite Qpower_plus_positive; simpl; apply Qeq_refl. Qed. diff --git a/theories/Numbers/Rational/SpecViaQ/QSig.v b/theories/Numbers/Rational/SpecViaQ/QSig.v index 29e1e795..e199c713 100644 --- a/theories/Numbers/Rational/SpecViaQ/QSig.v +++ b/theories/Numbers/Rational/SpecViaQ/QSig.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/PArith/BinPos.v b/theories/PArith/BinPos.v index 2e4d52a2..4747cfe1 100644 --- a/theories/PArith/BinPos.v +++ b/theories/PArith/BinPos.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -1484,8 +1484,7 @@ Qed. (** We hence obtain all the generic properties of [min] and [max]. *) -Include !UsualMinMaxLogicalProperties. -Include !UsualMinMaxDecProperties. +Include UsualMinMaxLogicalProperties <+ UsualMinMaxDecProperties. (** Minimum, maximum and constant one *) @@ -1871,183 +1870,184 @@ Notation xI := xI (only parsing). Notation xO := xO (only parsing). Notation xH := xH (only parsing). -Notation Psucc := Pos.succ (only parsing). -Notation Pplus := Pos.add (only parsing). -Notation Pplus_carry := Pos.add_carry (only parsing). -Notation Ppred := Pos.pred (only parsing). -Notation Piter_op := Pos.iter_op (only parsing). -Notation Piter_op_succ := Pos.iter_op_succ (only parsing). -Notation Pmult_nat := (Pos.iter_op plus) (only parsing). -Notation nat_of_P := Pos.to_nat (only parsing). -Notation P_of_succ_nat := Pos.of_succ_nat (only parsing). -Notation Pdouble_minus_one := Pos.pred_double (only parsing). -Notation positive_mask := Pos.mask (only parsing). Notation IsNul := Pos.IsNul (only parsing). Notation IsPos := Pos.IsPos (only parsing). Notation IsNeg := Pos.IsNeg (only parsing). -Notation positive_mask_rect := Pos.mask_rect (only parsing). -Notation positive_mask_ind := Pos.mask_ind (only parsing). -Notation positive_mask_rec := Pos.mask_rec (only parsing). -Notation Pdouble_plus_one_mask := Pos.succ_double_mask (only parsing). -Notation Pdouble_mask := Pos.double_mask (only parsing). -Notation Pdouble_minus_two := Pos.double_pred_mask (only parsing). -Notation Pminus_mask := Pos.sub_mask (only parsing). -Notation Pminus_mask_carry := Pos.sub_mask_carry (only parsing). -Notation Pminus := Pos.sub (only parsing). -Notation Pmult := Pos.mul (only parsing). -Notation iter_pos := @Pos.iter (only parsing). -Notation Ppow := Pos.pow (only parsing). -Notation Pdiv2 := Pos.div2 (only parsing). -Notation Pdiv2_up := Pos.div2_up (only parsing). -Notation Psize := Pos.size_nat (only parsing). -Notation Psize_pos := Pos.size (only parsing). -Notation Pcompare := Pos.compare_cont (only parsing). -Notation Plt := Pos.lt (only parsing). -Notation Pgt := Pos.gt (only parsing). -Notation Ple := Pos.le (only parsing). -Notation Pge := Pos.ge (only parsing). -Notation Pmin := Pos.min (only parsing). -Notation Pmax := Pos.max (only parsing). -Notation Peqb := Pos.eqb (only parsing). -Notation positive_eq_dec := Pos.eq_dec (only parsing). -Notation xI_succ_xO := Pos.xI_succ_xO (only parsing). -Notation Psucc_discr := Pos.succ_discr (only parsing). + +Notation Psucc := Pos.succ (compat "8.3"). +Notation Pplus := Pos.add (compat "8.3"). +Notation Pplus_carry := Pos.add_carry (compat "8.3"). +Notation Ppred := Pos.pred (compat "8.3"). +Notation Piter_op := Pos.iter_op (compat "8.3"). +Notation Piter_op_succ := Pos.iter_op_succ (compat "8.3"). +Notation Pmult_nat := (Pos.iter_op plus) (compat "8.3"). +Notation nat_of_P := Pos.to_nat (compat "8.3"). +Notation P_of_succ_nat := Pos.of_succ_nat (compat "8.3"). +Notation Pdouble_minus_one := Pos.pred_double (compat "8.3"). +Notation positive_mask := Pos.mask (compat "8.3"). +Notation positive_mask_rect := Pos.mask_rect (compat "8.3"). +Notation positive_mask_ind := Pos.mask_ind (compat "8.3"). +Notation positive_mask_rec := Pos.mask_rec (compat "8.3"). +Notation Pdouble_plus_one_mask := Pos.succ_double_mask (compat "8.3"). +Notation Pdouble_mask := Pos.double_mask (compat "8.3"). +Notation Pdouble_minus_two := Pos.double_pred_mask (compat "8.3"). +Notation Pminus_mask := Pos.sub_mask (compat "8.3"). +Notation Pminus_mask_carry := Pos.sub_mask_carry (compat "8.3"). +Notation Pminus := Pos.sub (compat "8.3"). +Notation Pmult := Pos.mul (compat "8.3"). +Notation iter_pos := @Pos.iter (compat "8.3"). +Notation Ppow := Pos.pow (compat "8.3"). +Notation Pdiv2 := Pos.div2 (compat "8.3"). +Notation Pdiv2_up := Pos.div2_up (compat "8.3"). +Notation Psize := Pos.size_nat (compat "8.3"). +Notation Psize_pos := Pos.size (compat "8.3"). +Notation Pcompare := Pos.compare_cont (compat "8.3"). +Notation Plt := Pos.lt (compat "8.3"). +Notation Pgt := Pos.gt (compat "8.3"). +Notation Ple := Pos.le (compat "8.3"). +Notation Pge := Pos.ge (compat "8.3"). +Notation Pmin := Pos.min (compat "8.3"). +Notation Pmax := Pos.max (compat "8.3"). +Notation Peqb := Pos.eqb (compat "8.3"). +Notation positive_eq_dec := Pos.eq_dec (compat "8.3"). +Notation xI_succ_xO := Pos.xI_succ_xO (compat "8.3"). +Notation Psucc_discr := Pos.succ_discr (compat "8.3"). Notation Psucc_o_double_minus_one_eq_xO := - Pos.succ_pred_double (only parsing). + Pos.succ_pred_double (compat "8.3"). Notation Pdouble_minus_one_o_succ_eq_xI := - Pos.pred_double_succ (only parsing). -Notation xO_succ_permute := Pos.double_succ (only parsing). + Pos.pred_double_succ (compat "8.3"). +Notation xO_succ_permute := Pos.double_succ (compat "8.3"). Notation double_moins_un_xO_discr := - Pos.pred_double_xO_discr (only parsing). -Notation Psucc_not_one := Pos.succ_not_1 (only parsing). -Notation Ppred_succ := Pos.pred_succ (only parsing). -Notation Psucc_pred := Pos.succ_pred_or (only parsing). -Notation Psucc_inj := Pos.succ_inj (only parsing). -Notation Pplus_carry_spec := Pos.add_carry_spec (only parsing). -Notation Pplus_comm := Pos.add_comm (only parsing). -Notation Pplus_succ_permute_r := Pos.add_succ_r (only parsing). -Notation Pplus_succ_permute_l := Pos.add_succ_l (only parsing). -Notation Pplus_no_neutral := Pos.add_no_neutral (only parsing). -Notation Pplus_carry_plus := Pos.add_carry_add (only parsing). -Notation Pplus_reg_r := Pos.add_reg_r (only parsing). -Notation Pplus_reg_l := Pos.add_reg_l (only parsing). -Notation Pplus_carry_reg_r := Pos.add_carry_reg_r (only parsing). -Notation Pplus_carry_reg_l := Pos.add_carry_reg_l (only parsing). -Notation Pplus_assoc := Pos.add_assoc (only parsing). -Notation Pplus_xO := Pos.add_xO (only parsing). -Notation Pplus_xI_double_minus_one := Pos.add_xI_pred_double (only parsing). -Notation Pplus_xO_double_minus_one := Pos.add_xO_pred_double (only parsing). -Notation Pplus_diag := Pos.add_diag (only parsing). -Notation PeanoView := Pos.PeanoView (only parsing). -Notation PeanoOne := Pos.PeanoOne (only parsing). -Notation PeanoSucc := Pos.PeanoSucc (only parsing). -Notation PeanoView_rect := Pos.PeanoView_rect (only parsing). -Notation PeanoView_ind := Pos.PeanoView_ind (only parsing). -Notation PeanoView_rec := Pos.PeanoView_rec (only parsing). -Notation peanoView_xO := Pos.peanoView_xO (only parsing). -Notation peanoView_xI := Pos.peanoView_xI (only parsing). -Notation peanoView := Pos.peanoView (only parsing). -Notation PeanoView_iter := Pos.PeanoView_iter (only parsing). -Notation eq_dep_eq_positive := Pos.eq_dep_eq_positive (only parsing). -Notation PeanoViewUnique := Pos.PeanoViewUnique (only parsing). -Notation Prect := Pos.peano_rect (only parsing). -Notation Prect_succ := Pos.peano_rect_succ (only parsing). -Notation Prect_base := Pos.peano_rect_base (only parsing). -Notation Prec := Pos.peano_rec (only parsing). -Notation Pind := Pos.peano_ind (only parsing). -Notation Pcase := Pos.peano_case (only parsing). -Notation Pmult_1_r := Pos.mul_1_r (only parsing). -Notation Pmult_Sn_m := Pos.mul_succ_l (only parsing). -Notation Pmult_xO_permute_r := Pos.mul_xO_r (only parsing). -Notation Pmult_xI_permute_r := Pos.mul_xI_r (only parsing). -Notation Pmult_comm := Pos.mul_comm (only parsing). -Notation Pmult_plus_distr_l := Pos.mul_add_distr_l (only parsing). -Notation Pmult_plus_distr_r := Pos.mul_add_distr_r (only parsing). -Notation Pmult_assoc := Pos.mul_assoc (only parsing). -Notation Pmult_xI_mult_xO_discr := Pos.mul_xI_mul_xO_discr (only parsing). -Notation Pmult_xO_discr := Pos.mul_xO_discr (only parsing). -Notation Pmult_reg_r := Pos.mul_reg_r (only parsing). -Notation Pmult_reg_l := Pos.mul_reg_l (only parsing). -Notation Pmult_1_inversion_l := Pos.mul_eq_1_l (only parsing). -Notation Psquare_xO := Pos.square_xO (only parsing). -Notation Psquare_xI := Pos.square_xI (only parsing). -Notation iter_pos_swap_gen := Pos.iter_swap_gen (only parsing). -Notation iter_pos_swap := Pos.iter_swap (only parsing). -Notation iter_pos_succ := Pos.iter_succ (only parsing). -Notation iter_pos_plus := Pos.iter_add (only parsing). -Notation iter_pos_invariant := Pos.iter_invariant (only parsing). -Notation Ppow_1_r := Pos.pow_1_r (only parsing). -Notation Ppow_succ_r := Pos.pow_succ_r (only parsing). -Notation Peqb_refl := Pos.eqb_refl (only parsing). -Notation Peqb_eq := Pos.eqb_eq (only parsing). -Notation Pcompare_refl_id := Pos.compare_cont_refl (only parsing). -Notation Pcompare_eq_iff := Pos.compare_eq_iff (only parsing). -Notation Pcompare_Gt_Lt := Pos.compare_cont_Gt_Lt (only parsing). -Notation Pcompare_eq_Lt := Pos.compare_lt_iff (only parsing). -Notation Pcompare_Lt_Gt := Pos.compare_cont_Lt_Gt (only parsing). - -Notation Pcompare_antisym := Pos.compare_cont_antisym (only parsing). -Notation ZC1 := Pos.gt_lt (only parsing). -Notation ZC2 := Pos.lt_gt (only parsing). -Notation Pcompare_spec := Pos.compare_spec (only parsing). -Notation Pcompare_p_Sp := Pos.lt_succ_diag_r (only parsing). -Notation Pcompare_succ_succ := Pos.compare_succ_succ (only parsing). -Notation Pcompare_1 := Pos.nlt_1_r (only parsing). -Notation Plt_1 := Pos.nlt_1_r (only parsing). -Notation Plt_1_succ := Pos.lt_1_succ (only parsing). -Notation Plt_lt_succ := Pos.lt_lt_succ (only parsing). -Notation Plt_irrefl := Pos.lt_irrefl (only parsing). -Notation Plt_trans := Pos.lt_trans (only parsing). -Notation Plt_ind := Pos.lt_ind (only parsing). -Notation Ple_lteq := Pos.le_lteq (only parsing). -Notation Ple_refl := Pos.le_refl (only parsing). -Notation Ple_lt_trans := Pos.le_lt_trans (only parsing). -Notation Plt_le_trans := Pos.lt_le_trans (only parsing). -Notation Ple_trans := Pos.le_trans (only parsing). -Notation Plt_succ_r := Pos.lt_succ_r (only parsing). -Notation Ple_succ_l := Pos.le_succ_l (only parsing). -Notation Pplus_compare_mono_l := Pos.add_compare_mono_l (only parsing). -Notation Pplus_compare_mono_r := Pos.add_compare_mono_r (only parsing). -Notation Pplus_lt_mono_l := Pos.add_lt_mono_l (only parsing). -Notation Pplus_lt_mono_r := Pos.add_lt_mono_r (only parsing). -Notation Pplus_lt_mono := Pos.add_lt_mono (only parsing). -Notation Pplus_le_mono_l := Pos.add_le_mono_l (only parsing). -Notation Pplus_le_mono_r := Pos.add_le_mono_r (only parsing). -Notation Pplus_le_mono := Pos.add_le_mono (only parsing). -Notation Pmult_compare_mono_l := Pos.mul_compare_mono_l (only parsing). -Notation Pmult_compare_mono_r := Pos.mul_compare_mono_r (only parsing). -Notation Pmult_lt_mono_l := Pos.mul_lt_mono_l (only parsing). -Notation Pmult_lt_mono_r := Pos.mul_lt_mono_r (only parsing). -Notation Pmult_lt_mono := Pos.mul_lt_mono (only parsing). -Notation Pmult_le_mono_l := Pos.mul_le_mono_l (only parsing). -Notation Pmult_le_mono_r := Pos.mul_le_mono_r (only parsing). -Notation Pmult_le_mono := Pos.mul_le_mono (only parsing). -Notation Plt_plus_r := Pos.lt_add_r (only parsing). -Notation Plt_not_plus_l := Pos.lt_not_add_l (only parsing). -Notation Ppow_gt_1 := Pos.pow_gt_1 (only parsing). -Notation Ppred_mask := Pos.pred_mask (only parsing). -Notation Pminus_mask_succ_r := Pos.sub_mask_succ_r (only parsing). -Notation Pminus_mask_carry_spec := Pos.sub_mask_carry_spec (only parsing). -Notation Pminus_succ_r := Pos.sub_succ_r (only parsing). -Notation Pminus_mask_diag := Pos.sub_mask_diag (only parsing). - -Notation Pplus_minus_eq := Pos.add_sub (only parsing). -Notation Pmult_minus_distr_l := Pos.mul_sub_distr_l (only parsing). -Notation Pminus_lt_mono_l := Pos.sub_lt_mono_l (only parsing). -Notation Pminus_compare_mono_l := Pos.sub_compare_mono_l (only parsing). -Notation Pminus_compare_mono_r := Pos.sub_compare_mono_r (only parsing). -Notation Pminus_lt_mono_r := Pos.sub_lt_mono_r (only parsing). -Notation Pminus_decr := Pos.sub_decr (only parsing). -Notation Pminus_xI_xI := Pos.sub_xI_xI (only parsing). -Notation Pplus_minus_assoc := Pos.add_sub_assoc (only parsing). -Notation Pminus_plus_distr := Pos.sub_add_distr (only parsing). -Notation Pminus_minus_distr := Pos.sub_sub_distr (only parsing). -Notation Pminus_mask_Lt := Pos.sub_mask_neg (only parsing). -Notation Pminus_Lt := Pos.sub_lt (only parsing). -Notation Pminus_Eq := Pos.sub_diag (only parsing). -Notation Psize_monotone := Pos.size_nat_monotone (only parsing). -Notation Psize_pos_gt := Pos.size_gt (only parsing). -Notation Psize_pos_le := Pos.size_le (only parsing). + Pos.pred_double_xO_discr (compat "8.3"). +Notation Psucc_not_one := Pos.succ_not_1 (compat "8.3"). +Notation Ppred_succ := Pos.pred_succ (compat "8.3"). +Notation Psucc_pred := Pos.succ_pred_or (compat "8.3"). +Notation Psucc_inj := Pos.succ_inj (compat "8.3"). +Notation Pplus_carry_spec := Pos.add_carry_spec (compat "8.3"). +Notation Pplus_comm := Pos.add_comm (compat "8.3"). +Notation Pplus_succ_permute_r := Pos.add_succ_r (compat "8.3"). +Notation Pplus_succ_permute_l := Pos.add_succ_l (compat "8.3"). +Notation Pplus_no_neutral := Pos.add_no_neutral (compat "8.3"). +Notation Pplus_carry_plus := Pos.add_carry_add (compat "8.3"). +Notation Pplus_reg_r := Pos.add_reg_r (compat "8.3"). +Notation Pplus_reg_l := Pos.add_reg_l (compat "8.3"). +Notation Pplus_carry_reg_r := Pos.add_carry_reg_r (compat "8.3"). +Notation Pplus_carry_reg_l := Pos.add_carry_reg_l (compat "8.3"). +Notation Pplus_assoc := Pos.add_assoc (compat "8.3"). +Notation Pplus_xO := Pos.add_xO (compat "8.3"). +Notation Pplus_xI_double_minus_one := Pos.add_xI_pred_double (compat "8.3"). +Notation Pplus_xO_double_minus_one := Pos.add_xO_pred_double (compat "8.3"). +Notation Pplus_diag := Pos.add_diag (compat "8.3"). +Notation PeanoView := Pos.PeanoView (compat "8.3"). +Notation PeanoOne := Pos.PeanoOne (compat "8.3"). +Notation PeanoSucc := Pos.PeanoSucc (compat "8.3"). +Notation PeanoView_rect := Pos.PeanoView_rect (compat "8.3"). +Notation PeanoView_ind := Pos.PeanoView_ind (compat "8.3"). +Notation PeanoView_rec := Pos.PeanoView_rec (compat "8.3"). +Notation peanoView_xO := Pos.peanoView_xO (compat "8.3"). +Notation peanoView_xI := Pos.peanoView_xI (compat "8.3"). +Notation peanoView := Pos.peanoView (compat "8.3"). +Notation PeanoView_iter := Pos.PeanoView_iter (compat "8.3"). +Notation eq_dep_eq_positive := Pos.eq_dep_eq_positive (compat "8.3"). +Notation PeanoViewUnique := Pos.PeanoViewUnique (compat "8.3"). +Notation Prect := Pos.peano_rect (compat "8.3"). +Notation Prect_succ := Pos.peano_rect_succ (compat "8.3"). +Notation Prect_base := Pos.peano_rect_base (compat "8.3"). +Notation Prec := Pos.peano_rec (compat "8.3"). +Notation Pind := Pos.peano_ind (compat "8.3"). +Notation Pcase := Pos.peano_case (compat "8.3"). +Notation Pmult_1_r := Pos.mul_1_r (compat "8.3"). +Notation Pmult_Sn_m := Pos.mul_succ_l (compat "8.3"). +Notation Pmult_xO_permute_r := Pos.mul_xO_r (compat "8.3"). +Notation Pmult_xI_permute_r := Pos.mul_xI_r (compat "8.3"). +Notation Pmult_comm := Pos.mul_comm (compat "8.3"). +Notation Pmult_plus_distr_l := Pos.mul_add_distr_l (compat "8.3"). +Notation Pmult_plus_distr_r := Pos.mul_add_distr_r (compat "8.3"). +Notation Pmult_assoc := Pos.mul_assoc (compat "8.3"). +Notation Pmult_xI_mult_xO_discr := Pos.mul_xI_mul_xO_discr (compat "8.3"). +Notation Pmult_xO_discr := Pos.mul_xO_discr (compat "8.3"). +Notation Pmult_reg_r := Pos.mul_reg_r (compat "8.3"). +Notation Pmult_reg_l := Pos.mul_reg_l (compat "8.3"). +Notation Pmult_1_inversion_l := Pos.mul_eq_1_l (compat "8.3"). +Notation Psquare_xO := Pos.square_xO (compat "8.3"). +Notation Psquare_xI := Pos.square_xI (compat "8.3"). +Notation iter_pos_swap_gen := Pos.iter_swap_gen (compat "8.3"). +Notation iter_pos_swap := Pos.iter_swap (compat "8.3"). +Notation iter_pos_succ := Pos.iter_succ (compat "8.3"). +Notation iter_pos_plus := Pos.iter_add (compat "8.3"). +Notation iter_pos_invariant := Pos.iter_invariant (compat "8.3"). +Notation Ppow_1_r := Pos.pow_1_r (compat "8.3"). +Notation Ppow_succ_r := Pos.pow_succ_r (compat "8.3"). +Notation Peqb_refl := Pos.eqb_refl (compat "8.3"). +Notation Peqb_eq := Pos.eqb_eq (compat "8.3"). +Notation Pcompare_refl_id := Pos.compare_cont_refl (compat "8.3"). +Notation Pcompare_eq_iff := Pos.compare_eq_iff (compat "8.3"). +Notation Pcompare_Gt_Lt := Pos.compare_cont_Gt_Lt (compat "8.3"). +Notation Pcompare_eq_Lt := Pos.compare_lt_iff (compat "8.3"). +Notation Pcompare_Lt_Gt := Pos.compare_cont_Lt_Gt (compat "8.3"). + +Notation Pcompare_antisym := Pos.compare_cont_antisym (compat "8.3"). +Notation ZC1 := Pos.gt_lt (compat "8.3"). +Notation ZC2 := Pos.lt_gt (compat "8.3"). +Notation Pcompare_spec := Pos.compare_spec (compat "8.3"). +Notation Pcompare_p_Sp := Pos.lt_succ_diag_r (compat "8.3"). +Notation Pcompare_succ_succ := Pos.compare_succ_succ (compat "8.3"). +Notation Pcompare_1 := Pos.nlt_1_r (compat "8.3"). +Notation Plt_1 := Pos.nlt_1_r (compat "8.3"). +Notation Plt_1_succ := Pos.lt_1_succ (compat "8.3"). +Notation Plt_lt_succ := Pos.lt_lt_succ (compat "8.3"). +Notation Plt_irrefl := Pos.lt_irrefl (compat "8.3"). +Notation Plt_trans := Pos.lt_trans (compat "8.3"). +Notation Plt_ind := Pos.lt_ind (compat "8.3"). +Notation Ple_lteq := Pos.le_lteq (compat "8.3"). +Notation Ple_refl := Pos.le_refl (compat "8.3"). +Notation Ple_lt_trans := Pos.le_lt_trans (compat "8.3"). +Notation Plt_le_trans := Pos.lt_le_trans (compat "8.3"). +Notation Ple_trans := Pos.le_trans (compat "8.3"). +Notation Plt_succ_r := Pos.lt_succ_r (compat "8.3"). +Notation Ple_succ_l := Pos.le_succ_l (compat "8.3"). +Notation Pplus_compare_mono_l := Pos.add_compare_mono_l (compat "8.3"). +Notation Pplus_compare_mono_r := Pos.add_compare_mono_r (compat "8.3"). +Notation Pplus_lt_mono_l := Pos.add_lt_mono_l (compat "8.3"). +Notation Pplus_lt_mono_r := Pos.add_lt_mono_r (compat "8.3"). +Notation Pplus_lt_mono := Pos.add_lt_mono (compat "8.3"). +Notation Pplus_le_mono_l := Pos.add_le_mono_l (compat "8.3"). +Notation Pplus_le_mono_r := Pos.add_le_mono_r (compat "8.3"). +Notation Pplus_le_mono := Pos.add_le_mono (compat "8.3"). +Notation Pmult_compare_mono_l := Pos.mul_compare_mono_l (compat "8.3"). +Notation Pmult_compare_mono_r := Pos.mul_compare_mono_r (compat "8.3"). +Notation Pmult_lt_mono_l := Pos.mul_lt_mono_l (compat "8.3"). +Notation Pmult_lt_mono_r := Pos.mul_lt_mono_r (compat "8.3"). +Notation Pmult_lt_mono := Pos.mul_lt_mono (compat "8.3"). +Notation Pmult_le_mono_l := Pos.mul_le_mono_l (compat "8.3"). +Notation Pmult_le_mono_r := Pos.mul_le_mono_r (compat "8.3"). +Notation Pmult_le_mono := Pos.mul_le_mono (compat "8.3"). +Notation Plt_plus_r := Pos.lt_add_r (compat "8.3"). +Notation Plt_not_plus_l := Pos.lt_not_add_l (compat "8.3"). +Notation Ppow_gt_1 := Pos.pow_gt_1 (compat "8.3"). +Notation Ppred_mask := Pos.pred_mask (compat "8.3"). +Notation Pminus_mask_succ_r := Pos.sub_mask_succ_r (compat "8.3"). +Notation Pminus_mask_carry_spec := Pos.sub_mask_carry_spec (compat "8.3"). +Notation Pminus_succ_r := Pos.sub_succ_r (compat "8.3"). +Notation Pminus_mask_diag := Pos.sub_mask_diag (compat "8.3"). + +Notation Pplus_minus_eq := Pos.add_sub (compat "8.3"). +Notation Pmult_minus_distr_l := Pos.mul_sub_distr_l (compat "8.3"). +Notation Pminus_lt_mono_l := Pos.sub_lt_mono_l (compat "8.3"). +Notation Pminus_compare_mono_l := Pos.sub_compare_mono_l (compat "8.3"). +Notation Pminus_compare_mono_r := Pos.sub_compare_mono_r (compat "8.3"). +Notation Pminus_lt_mono_r := Pos.sub_lt_mono_r (compat "8.3"). +Notation Pminus_decr := Pos.sub_decr (compat "8.3"). +Notation Pminus_xI_xI := Pos.sub_xI_xI (compat "8.3"). +Notation Pplus_minus_assoc := Pos.add_sub_assoc (compat "8.3"). +Notation Pminus_plus_distr := Pos.sub_add_distr (compat "8.3"). +Notation Pminus_minus_distr := Pos.sub_sub_distr (compat "8.3"). +Notation Pminus_mask_Lt := Pos.sub_mask_neg (compat "8.3"). +Notation Pminus_Lt := Pos.sub_lt (compat "8.3"). +Notation Pminus_Eq := Pos.sub_diag (compat "8.3"). +Notation Psize_monotone := Pos.size_nat_monotone (compat "8.3"). +Notation Psize_pos_gt := Pos.size_gt (compat "8.3"). +Notation Psize_pos_le := Pos.size_le (compat "8.3"). (** More complex compatibility facts, expressed as lemmas (to preserve scopes for instance) *) @@ -2056,24 +2056,24 @@ Lemma Peqb_true_eq x y : Pos.eqb x y = true -> x=y. Proof. apply Pos.eqb_eq. Qed. Lemma Pcompare_eq_Gt p q : (p ?= q) = Gt <-> p > q. Proof. reflexivity. Qed. -Lemma Pplus_one_succ_r p : Psucc p = p + 1. +Lemma Pplus_one_succ_r p : Pos.succ p = p + 1. Proof (eq_sym (Pos.add_1_r p)). -Lemma Pplus_one_succ_l p : Psucc p = 1 + p. +Lemma Pplus_one_succ_l p : Pos.succ p = 1 + p. Proof (eq_sym (Pos.add_1_l p)). -Lemma Pcompare_refl p : Pcompare p p Eq = Eq. +Lemma Pcompare_refl p : Pos.compare_cont p p Eq = Eq. Proof (Pos.compare_cont_refl p Eq). -Lemma Pcompare_Eq_eq : forall p q, Pcompare p q Eq = Eq -> p = q. +Lemma Pcompare_Eq_eq : forall p q, Pos.compare_cont p q Eq = Eq -> p = q. Proof Pos.compare_eq. -Lemma ZC4 p q : Pcompare p q Eq = CompOpp (Pcompare q p Eq). +Lemma ZC4 p q : Pos.compare_cont p q Eq = CompOpp (Pos.compare_cont q p Eq). Proof (Pos.compare_antisym q p). -Lemma Ppred_minus p : Ppred p = p - 1. +Lemma Ppred_minus p : Pos.pred p = p - 1. Proof (eq_sym (Pos.sub_1_r p)). Lemma Pminus_mask_Gt p q : p > q -> exists h : positive, - Pminus_mask p q = IsPos h /\ - q + h = p /\ (h = 1 \/ Pminus_mask_carry p q = IsPos (Ppred h)). + Pos.sub_mask p q = IsPos h /\ + q + h = p /\ (h = 1 \/ Pos.sub_mask_carry p q = IsPos (Pos.pred h)). Proof. intros H. apply Pos.gt_lt in H. destruct (Pos.sub_mask_pos p q H) as (r & U). diff --git a/theories/PArith/BinPosDef.v b/theories/PArith/BinPosDef.v index 7916511a..4beeea31 100644 --- a/theories/PArith/BinPosDef.v +++ b/theories/PArith/BinPosDef.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -288,9 +288,6 @@ Definition max p p' := (** ** Boolean equality and comparisons *) -(** Nota: this [eqb] is not convertible with the generated [positive_beq], due - to a different guard argument. We keep this version for compatibility. *) - Fixpoint eqb p q {struct q} := match p, q with | p~1, q~1 => eqb p q diff --git a/theories/PArith/PArith.v b/theories/PArith/PArith.v index 26b8265b..9d294026 100644 --- a/theories/PArith/PArith.v +++ b/theories/PArith/PArith.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/PArith/POrderedType.v b/theories/PArith/POrderedType.v index de7b2b82..4aae6271 100644 --- a/theories/PArith/POrderedType.v +++ b/theories/PArith/POrderedType.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/PArith/Pnat.v b/theories/PArith/Pnat.v index f9df70bd..31e88a40 100644 --- a/theories/PArith/Pnat.v +++ b/theories/PArith/Pnat.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -30,7 +30,7 @@ Qed. Theorem inj_add p q : to_nat (p + q) = to_nat p + to_nat q. Proof. - revert q. induction p using Pind; intros q. + revert q. induction p using peano_ind; intros q. now rewrite add_1_l, inj_succ. now rewrite add_succ_l, !inj_succ, IHp. Qed. @@ -378,55 +378,56 @@ End SuccNat2Pos. (** For compatibility, old names and old-style lemmas *) -Notation Psucc_S := Pos2Nat.inj_succ (only parsing). -Notation Pplus_plus := Pos2Nat.inj_add (only parsing). -Notation Pmult_mult := Pos2Nat.inj_mul (only parsing). -Notation Pcompare_nat_compare := Pos2Nat.inj_compare (only parsing). -Notation nat_of_P_xH := Pos2Nat.inj_1 (only parsing). -Notation nat_of_P_xO := Pos2Nat.inj_xO (only parsing). -Notation nat_of_P_xI := Pos2Nat.inj_xI (only parsing). -Notation nat_of_P_is_S := Pos2Nat.is_succ (only parsing). -Notation nat_of_P_pos := Pos2Nat.is_pos (only parsing). -Notation nat_of_P_inj_iff := Pos2Nat.inj_iff (only parsing). -Notation nat_of_P_inj := Pos2Nat.inj (only parsing). -Notation Plt_lt := Pos2Nat.inj_lt (only parsing). -Notation Pgt_gt := Pos2Nat.inj_gt (only parsing). -Notation Ple_le := Pos2Nat.inj_le (only parsing). -Notation Pge_ge := Pos2Nat.inj_ge (only parsing). -Notation Pminus_minus := Pos2Nat.inj_sub (only parsing). -Notation iter_nat_of_P := @Pos2Nat.inj_iter (only parsing). - -Notation nat_of_P_of_succ_nat := SuccNat2Pos.id_succ (only parsing). -Notation P_of_succ_nat_of_P := Pos2SuccNat.id_succ (only parsing). - -Notation nat_of_P_succ_morphism := Pos2Nat.inj_succ (only parsing). -Notation nat_of_P_plus_morphism := Pos2Nat.inj_add (only parsing). -Notation nat_of_P_mult_morphism := Pos2Nat.inj_mul (only parsing). -Notation nat_of_P_compare_morphism := Pos2Nat.inj_compare (only parsing). -Notation lt_O_nat_of_P := Pos2Nat.is_pos (only parsing). -Notation ZL4 := Pos2Nat.is_succ (only parsing). -Notation nat_of_P_o_P_of_succ_nat_eq_succ := SuccNat2Pos.id_succ (only parsing). -Notation P_of_succ_nat_o_nat_of_P_eq_succ := Pos2SuccNat.id_succ (only parsing). -Notation pred_o_P_of_succ_nat_o_nat_of_P_eq_id := Pos2SuccNat.pred_id (only parsing). +Notation Psucc_S := Pos2Nat.inj_succ (compat "8.3"). +Notation Pplus_plus := Pos2Nat.inj_add (compat "8.3"). +Notation Pmult_mult := Pos2Nat.inj_mul (compat "8.3"). +Notation Pcompare_nat_compare := Pos2Nat.inj_compare (compat "8.3"). +Notation nat_of_P_xH := Pos2Nat.inj_1 (compat "8.3"). +Notation nat_of_P_xO := Pos2Nat.inj_xO (compat "8.3"). +Notation nat_of_P_xI := Pos2Nat.inj_xI (compat "8.3"). +Notation nat_of_P_is_S := Pos2Nat.is_succ (compat "8.3"). +Notation nat_of_P_pos := Pos2Nat.is_pos (compat "8.3"). +Notation nat_of_P_inj_iff := Pos2Nat.inj_iff (compat "8.3"). +Notation nat_of_P_inj := Pos2Nat.inj (compat "8.3"). +Notation Plt_lt := Pos2Nat.inj_lt (compat "8.3"). +Notation Pgt_gt := Pos2Nat.inj_gt (compat "8.3"). +Notation Ple_le := Pos2Nat.inj_le (compat "8.3"). +Notation Pge_ge := Pos2Nat.inj_ge (compat "8.3"). +Notation Pminus_minus := Pos2Nat.inj_sub (compat "8.3"). +Notation iter_nat_of_P := @Pos2Nat.inj_iter (compat "8.3"). + +Notation nat_of_P_of_succ_nat := SuccNat2Pos.id_succ (compat "8.3"). +Notation P_of_succ_nat_of_P := Pos2SuccNat.id_succ (compat "8.3"). + +Notation nat_of_P_succ_morphism := Pos2Nat.inj_succ (compat "8.3"). +Notation nat_of_P_plus_morphism := Pos2Nat.inj_add (compat "8.3"). +Notation nat_of_P_mult_morphism := Pos2Nat.inj_mul (compat "8.3"). +Notation nat_of_P_compare_morphism := Pos2Nat.inj_compare (compat "8.3"). +Notation lt_O_nat_of_P := Pos2Nat.is_pos (compat "8.3"). +Notation ZL4 := Pos2Nat.is_succ (compat "8.3"). +Notation nat_of_P_o_P_of_succ_nat_eq_succ := SuccNat2Pos.id_succ (compat "8.3"). +Notation P_of_succ_nat_o_nat_of_P_eq_succ := Pos2SuccNat.id_succ (compat "8.3"). +Notation pred_o_P_of_succ_nat_o_nat_of_P_eq_id := Pos2SuccNat.pred_id (compat "8.3"). Lemma nat_of_P_minus_morphism p q : - Pcompare p q Eq = Gt -> Pos.to_nat (p - q) = Pos.to_nat p - Pos.to_nat q. -Proof (fun H => Pos2Nat.inj_sub p q (ZC1 _ _ H)). + Pos.compare_cont p q Eq = Gt -> + Pos.to_nat (p - q) = Pos.to_nat p - Pos.to_nat q. +Proof (fun H => Pos2Nat.inj_sub p q (Pos.gt_lt _ _ H)). Lemma nat_of_P_lt_Lt_compare_morphism p q : - Pcompare p q Eq = Lt -> Pos.to_nat p < Pos.to_nat q. + Pos.compare_cont p q Eq = Lt -> Pos.to_nat p < Pos.to_nat q. Proof (proj1 (Pos2Nat.inj_lt p q)). Lemma nat_of_P_gt_Gt_compare_morphism p q : - Pcompare p q Eq = Gt -> Pos.to_nat p > Pos.to_nat q. + Pos.compare_cont p q Eq = Gt -> Pos.to_nat p > Pos.to_nat q. Proof (proj1 (Pos2Nat.inj_gt p q)). Lemma nat_of_P_lt_Lt_compare_complement_morphism p q : - Pos.to_nat p < Pos.to_nat q -> Pcompare p q Eq = Lt. + Pos.to_nat p < Pos.to_nat q -> Pos.compare_cont p q Eq = Lt. Proof (proj2 (Pos2Nat.inj_lt p q)). Definition nat_of_P_gt_Gt_compare_complement_morphism p q : - Pos.to_nat p > Pos.to_nat q -> Pcompare p q Eq = Gt. + Pos.to_nat p > Pos.to_nat q -> Pos.compare_cont p q Eq = Gt. Proof (proj2 (Pos2Nat.inj_gt p q)). (** Old intermediate results about [Pmult_nat] *) @@ -445,7 +446,7 @@ Proof. Qed. Lemma Pmult_nat_succ_morphism : - forall p n, Pmult_nat (Psucc p) n = n + Pmult_nat p n. + forall p n, Pmult_nat (Pos.succ p) n = n + Pmult_nat p n. Proof. intros. now rewrite !Pmult_nat_mult, Pos2Nat.inj_succ. Qed. @@ -457,7 +458,7 @@ Proof. Qed. Theorem Pmult_nat_plus_carry_morphism : - forall p q n, Pmult_nat (Pplus_carry p q) n = n + Pmult_nat (p + q) n. + forall p q n, Pmult_nat (Pos.add_carry p q) n = n + Pmult_nat (p + q) n. Proof. intros. now rewrite Pos.add_carry_spec, Pmult_nat_succ_morphism. Qed. diff --git a/theories/Program/Basics.v b/theories/Program/Basics.v index 7cef5c5a..22436de6 100644 --- a/theories/Program/Basics.v +++ b/theories/Program/Basics.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -29,7 +29,7 @@ Hint Unfold compose. Notation " g ∘ f " := (compose g f) (at level 40, left associativity) : program_scope. -Open Local Scope program_scope. +Local Open Scope program_scope. (** The non-dependent function space between [A] and [B]. *) diff --git a/theories/Program/Combinators.v b/theories/Program/Combinators.v index 81316ded..dcf09251 100644 --- a/theories/Program/Combinators.v +++ b/theories/Program/Combinators.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Program/Equality.v b/theories/Program/Equality.v index d408845e..323e80cc 100644 --- a/theories/Program/Equality.v +++ b/theories/Program/Equality.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -290,12 +290,14 @@ Lemma simplification_heq A B (x y : A) : (x = y -> B) -> (JMeq x y -> B). Proof. intros H J; apply H; apply (JMeq_eq J). Defined. +Definition conditional_eq {A} (x y : A) := eq x y. + Lemma simplification_existT2 A (P : A -> Type) B (p : A) (x y : P p) : - (x = y -> B) -> (existT P p x = existT P p y -> B). + (x = y -> B) -> (conditional_eq (existT P p x) (existT P p y) -> B). Proof. intros H E. apply H. apply inj_pair2. assumption. Defined. Lemma simplification_existT1 A (P : A -> Type) B (p q : A) (x : P p) (y : P q) : - (p = q -> existT P p x = existT P q y -> B) -> (existT P p x = existT P q y -> B). + (p = q -> conditional_eq (existT P p x) (existT P q y) -> B) -> (existT P p x = existT P q y -> B). Proof. injection 2. auto. Defined. Lemma simplification_K A (x : A) (B : x = x -> Type) : @@ -319,8 +321,10 @@ Ltac simplify_one_dep_elim_term c := | @JMeq _ _ _ _ -> _ => refine (simplification_heq _ _ _ _ _) | ?t = ?t -> _ => intros _ || refine (simplification_K _ t _ _) | eq (existT _ _ _) (existT _ _ _) -> _ => - refine (simplification_existT2 _ _ _ _ _ _ _) || refine (simplification_existT1 _ _ _ _ _ _ _ _) + | conditional_eq (existT _ _ _) (existT _ _ _) -> _ => + refine (simplification_existT2 _ _ _ _ _ _ _) || + (unfold conditional_eq; intro) | ?x = ?y -> _ => (* variables case *) (unfold x) || (unfold y) || (let hyp := fresh in intros hyp ; diff --git a/theories/Program/Program.v b/theories/Program/Program.v index 14a7ffca..be8d9a47 100644 --- a/theories/Program/Program.v +++ b/theories/Program/Program.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Program/Subset.v b/theories/Program/Subset.v index ca4002d7..34c27ed8 100644 --- a/theories/Program/Subset.v +++ b/theories/Program/Subset.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -10,7 +10,7 @@ Require Import Coq.Program.Utils. Require Import Coq.Program.Equality. -Open Local Scope program_scope. +Local Open Scope program_scope. (** The following tactics implement a poor-man's solution for proof-irrelevance: it tries to factorize every proof of the same proposition in a goal so that equality of such proofs becomes trivial. *) @@ -106,7 +106,7 @@ Ltac rewrite_match_eq H := [ |- ?T ] => match T with context [ match_eq ?A ?B ?t ?f ] => - rewrite (match_eq_rewrite A B t f (exist _ _ (sym_eq H))) + rewrite (match_eq_rewrite A B t f (exist _ _ (eq_sym H))) end end. diff --git a/theories/Program/Syntax.v b/theories/Program/Syntax.v index 61d389ed..a2948074 100644 --- a/theories/Program/Syntax.v +++ b/theories/Program/Syntax.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Program/Tactics.v b/theories/Program/Tactics.v index 9694e3fd..9aba9f53 100644 --- a/theories/Program/Tactics.v +++ b/theories/Program/Tactics.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -310,7 +310,7 @@ Ltac refine_hyp c := possibly using [program_simplify] to use standard goal-cleaning tactics. *) Ltac program_simplify := -simpl in |- *; intros ; destruct_all_rec_calls ; repeat (destruct_conjs; simpl proj1_sig in * ); +simpl; intros ; destruct_all_rec_calls ; repeat (destruct_conjs; simpl proj1_sig in * ); subst*; autoinjections ; try discriminates ; try (solve [ red ; intros ; destruct_conjs ; autoinjections ; discriminates ]). diff --git a/theories/Program/Utils.v b/theories/Program/Utils.v index 1885decf..94e88d57 100644 --- a/theories/Program/Utils.v +++ b/theories/Program/Utils.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Program/Wf.v b/theories/Program/Wf.v index a823aedd..6a030c7f 100644 --- a/theories/Program/Wf.v +++ b/theories/Program/Wf.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -12,7 +12,7 @@ Require Import Coq.Init.Wf. Require Import Coq.Program.Utils. Require Import ProofIrrelevance. -Open Local Scope program_scope. +Local Open Scope program_scope. Section Well_founded. Variable A : Type. @@ -52,7 +52,7 @@ Section Well_founded. Lemma Fix_eq : forall x:A, Fix_sub x = F_sub x (fun (y:A|R y x) => Fix_sub (proj1_sig y)). Proof. - intro x; unfold Fix_sub in |- *. + intro x; unfold Fix_sub. rewrite <- (Fix_F_eq ). apply F_ext; intros. apply Fix_F_inv. diff --git a/theories/QArith/QArith.v b/theories/QArith/QArith.v index fe8d639c..5d36ff12 100644 --- a/theories/QArith/QArith.v +++ b/theories/QArith/QArith.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/QArith/QArith_base.v b/theories/QArith/QArith_base.v index 94ea4906..cf5bb3f2 100644 --- a/theories/QArith/QArith_base.v +++ b/theories/QArith/QArith_base.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -20,7 +20,7 @@ Delimit Scope Q_scope with Q. Bind Scope Q_scope with Q. Arguments Qmake _%Z _%positive. Open Scope Q_scope. -Ltac simpl_mult := repeat rewrite Zpos_mult_morphism. +Ltac simpl_mult := rewrite ?Pos2Z.inj_mul. (** [a#b] denotes the fraction [a] over [b]. *) @@ -58,79 +58,65 @@ Qed. Definition Qcompare (p q : Q) := (Qnum p * QDen q ?= Qnum q * QDen p)%Z. Notation "p ?= q" := (Qcompare p q) : Q_scope. -Lemma Qeq_alt : forall p q, (p == q) <-> (p ?= q) = Eq. +Lemma Qeq_alt p q : (p == q) <-> (p ?= q) = Eq. Proof. -unfold Qeq, Qcompare; intros; split; intros. -rewrite H; apply Zcompare_refl. -apply Zcompare_Eq_eq; auto. +symmetry. apply Z.compare_eq_iff. Qed. -Lemma Qlt_alt : forall p q, (p<q) <-> (p?=q = Lt). +Lemma Qlt_alt p q : (p<q) <-> (p?=q = Lt). Proof. -unfold Qlt, Qcompare, Zlt; split; auto. +reflexivity. Qed. -Lemma Qgt_alt : forall p q, (p>q) <-> (p?=q = Gt). +Lemma Qgt_alt p q : (p>q) <-> (p?=q = Gt). Proof. -unfold Qlt, Qcompare, Zlt. -intros; rewrite Zcompare_Gt_Lt_antisym; split; auto. +symmetry. apply Z.gt_lt_iff. Qed. -Lemma Qle_alt : forall p q, (p<=q) <-> (p?=q <> Gt). +Lemma Qle_alt p q : (p<=q) <-> (p?=q <> Gt). Proof. -unfold Qle, Qcompare, Zle; split; auto. +reflexivity. Qed. -Lemma Qge_alt : forall p q, (p>=q) <-> (p?=q <> Lt). +Lemma Qge_alt p q : (p>=q) <-> (p?=q <> Lt). Proof. -unfold Qle, Qcompare, Zle. -split; intros; contradict H. -rewrite Zcompare_Gt_Lt_antisym; auto. -rewrite Zcompare_Gt_Lt_antisym in H; auto. +symmetry. apply Z.ge_le_iff. Qed. Hint Unfold Qeq Qlt Qle : qarith. Hint Extern 5 (?X1 <> ?X2) => intro; discriminate: qarith. -Lemma Qcompare_antisym : forall x y, CompOpp (x ?= y) = (y ?= x). +Lemma Qcompare_antisym x y : CompOpp (x ?= y) = (y ?= x). Proof. - unfold "?=". intros. apply Zcompare_antisym. + symmetry. apply Z.compare_antisym. Qed. -Lemma Qcompare_spec : forall x y, CompareSpec (x==y) (x<y) (y<x) (x ?= y). +Lemma Qcompare_spec x y : CompareSpec (x==y) (x<y) (y<x) (x ?= y). Proof. - intros. - destruct (x ?= y) as [ ]_eqn:H; constructor; auto. - rewrite Qeq_alt; auto. - rewrite Qlt_alt, <- Qcompare_antisym, H; auto. + unfold Qeq, Qlt, Qcompare. case Z.compare_spec; now constructor. Qed. (** * Properties of equality. *) -Theorem Qeq_refl : forall x, x == x. +Theorem Qeq_refl x : x == x. Proof. auto with qarith. Qed. -Theorem Qeq_sym : forall x y, x == y -> y == x. +Theorem Qeq_sym x y : x == y -> y == x. Proof. auto with qarith. Qed. -Theorem Qeq_trans : forall x y z, x == y -> y == z -> x == z. +Theorem Qeq_trans x y z : x == y -> y == z -> x == z. Proof. -unfold Qeq; intros. -apply Zmult_reg_l with (QDen y). -auto with qarith. -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. +unfold Qeq; intros XY YZ. +apply Z.mul_reg_r with (QDen y); [auto with qarith|]. +now rewrite Z.mul_shuffle0, XY, Z.mul_shuffle0, YZ, Z.mul_shuffle0. Qed. -Hint Resolve Qeq_refl : qarith. -Hint Resolve Qeq_sym : qarith. -Hint Resolve Qeq_trans : qarith. +Hint Immediate Qeq_sym : qarith. +Hint Resolve Qeq_refl Qeq_trans : qarith. (** In a word, [Qeq] is a setoid equality. *) @@ -139,50 +125,48 @@ Proof. split; red; eauto with qarith. Qed. (** Furthermore, this equality is decidable: *) -Theorem Qeq_dec : forall x y, {x==y} + {~ x==y}. +Theorem Qeq_dec x y : {x==y} + {~ x==y}. Proof. - intros; case (Z_eq_dec (Qnum x * QDen y) (Qnum y * QDen x)); auto. + apply Z.eq_dec. Defined. Definition Qeq_bool x y := (Zeq_bool (Qnum x * QDen y) (Qnum y * QDen x))%Z. Definition Qle_bool x y := - (Zle_bool (Qnum x * QDen y) (Qnum y * QDen x))%Z. + (Z.leb (Qnum x * QDen y) (Qnum y * QDen x))%Z. -Lemma Qeq_bool_iff : forall x y, Qeq_bool x y = true <-> x == y. +Lemma Qeq_bool_iff x y : Qeq_bool x y = true <-> x == y. Proof. - unfold Qeq_bool, Qeq; intros. symmetry; apply Zeq_is_eq_bool. Qed. -Lemma Qeq_bool_eq : forall x y, Qeq_bool x y = true -> x == y. +Lemma Qeq_bool_eq x y : Qeq_bool x y = true -> x == y. Proof. - intros; rewrite <- Qeq_bool_iff; auto. + apply Qeq_bool_iff. Qed. -Lemma Qeq_eq_bool : forall x y, x == y -> Qeq_bool x y = true. +Lemma Qeq_eq_bool x y : x == y -> Qeq_bool x y = true. Proof. - intros; rewrite Qeq_bool_iff; auto. + apply Qeq_bool_iff. Qed. -Lemma Qeq_bool_neq : forall x y, Qeq_bool x y = false -> ~ x == y. +Lemma Qeq_bool_neq x y : Qeq_bool x y = false -> ~ x == y. Proof. - intros x y H; rewrite <- Qeq_bool_iff, H; discriminate. + rewrite <- Qeq_bool_iff. now intros ->. Qed. -Lemma Qle_bool_iff : forall x y, Qle_bool x y = true <-> x <= y. +Lemma Qle_bool_iff x y : Qle_bool x y = true <-> x <= y. Proof. - unfold Qle_bool, Qle; intros. symmetry; apply Zle_is_le_bool. Qed. -Lemma Qle_bool_imp_le : forall x y, Qle_bool x y = true -> x <= y. +Lemma Qle_bool_imp_le x y : Qle_bool x y = true -> x <= y. Proof. - intros; rewrite <- Qle_bool_iff; auto. + apply Qle_bool_iff. Qed. -Theorem Qnot_eq_sym : forall x y, ~x == y -> ~y == x. +Theorem Qnot_eq_sym x y : ~x == y -> ~y == x. Proof. auto with qarith. Qed. @@ -223,12 +207,9 @@ Infix "/" := Qdiv : Q_scope. Notation " ' x " := (Zpos x) (at level 20, no associativity) : Z_scope. -Lemma Qmake_Qdiv : forall a b, a#b==inject_Z a/inject_Z ('b). +Lemma Qmake_Qdiv a b : a#b==inject_Z a/inject_Z ('b). Proof. -intros a b. -unfold Qeq. -simpl. -ring. +unfold Qeq. simpl. ring. Qed. (** * Setoid compatibility results *) @@ -281,17 +262,13 @@ Instance Qinv_comp : Proper (Qeq==>Qeq) Qinv. 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. + intros (p1, p2) (q1, q2) EQ; simpl in *. + destruct q1; simpl in *. + - apply Z.mul_eq_0 in EQ. destruct EQ; now subst. + - destruct p1; simpl in *; try discriminate. + now rewrite Pos.mul_comm, <- EQ, Pos.mul_comm. + - destruct p1; simpl in *; try discriminate. + now rewrite Pos.mul_comm, <- EQ, Pos.mul_comm. Close Scope Z_scope. Qed. @@ -368,7 +345,7 @@ Qed. Lemma Qplus_0_r : forall x, x+0 == x. Proof. intros (x1, x2); unfold Qeq, Qplus; simpl. - rewrite Pmult_comm; simpl; ring. + rewrite Pos.mul_comm; simpl; ring. Qed. (** Commutativity of addition: *) @@ -376,7 +353,7 @@ Qed. Theorem Qplus_comm : forall x y, x+y == y+x. Proof. intros (x1, x2); unfold Qeq, Qplus; simpl. - intros; rewrite Pmult_comm; ring. + intros; rewrite Pos.mul_comm; ring. Qed. @@ -419,7 +396,7 @@ Qed. 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 Pos.mul_assoc; ring. Qed. (** multiplication and zero *) @@ -444,15 +421,15 @@ 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. + rewrite Z.mul_1_r with (n := Qnum n). + rewrite Pos.mul_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 Pos.mul_comm; ring. Qed. (** Distributivity over [Qadd] *) @@ -474,17 +451,15 @@ Qed. 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. + unfold Qeq, Qmult; simpl. + now rewrite <- Z.mul_eq_0, !Z.mul_1_r. 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. + unfold Qeq, Qmult; simpl. + rewrite !Z.mul_1_r, Z.mul_eq_0. intuition. Qed. @@ -561,12 +536,12 @@ Qed. (** * Properties of order upon Q. *) -Lemma Qle_refl : forall x, x<=x. +Lemma Qle_refl x : x<=x. Proof. unfold Qle; auto with zarith. Qed. -Lemma Qle_antisym : forall x y, x<=y -> y<=x -> x==y. +Lemma Qle_antisym x y : x<=y -> y<=x -> x==y. Proof. unfold Qle, Qeq; auto with zarith. Qed. @@ -575,52 +550,46 @@ 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. + apply Z.mul_le_mono_pos_r with ('y2); [easy|]. + apply Z.le_trans with (y1 * 'x2 * 'z2). + - rewrite Z.mul_shuffle0. now apply Z.mul_le_mono_pos_r. + - rewrite Z.mul_shuffle0, (Z.mul_shuffle0 z1). + now apply Z.mul_le_mono_pos_r. Close Scope Z_scope. Qed. Hint Resolve Qle_trans : qarith. -Lemma Qlt_irrefl : forall x, ~x<x. +Lemma Qlt_irrefl x : ~x<x. Proof. unfold Qlt. auto with zarith. Qed. -Lemma Qlt_not_eq : forall x y, x<y -> ~ x==y. +Lemma Qlt_not_eq x y : x<y -> ~ x==y. Proof. unfold Qlt, Qeq; auto with zarith. Qed. Lemma Zle_Qle (x y: Z): (x <= y)%Z = (inject_Z x <= inject_Z y). Proof. - unfold Qle. intros. simpl. - do 2 rewrite Zmult_1_r. reflexivity. + unfold Qle. simpl. now rewrite !Z.mul_1_r. Qed. Lemma Zlt_Qlt (x y: Z): (x < y)%Z = (inject_Z x < inject_Z y). Proof. - unfold Qlt. intros. simpl. - do 2 rewrite Zmult_1_r. reflexivity. + unfold Qlt. simpl. now rewrite !Z.mul_1_r. Qed. (** Large = strict or equal *) -Lemma Qle_lteq : forall x y, x<=y <-> x<y \/ x==y. +Lemma Qle_lteq x y : x<=y <-> x<y \/ x==y. Proof. - intros. rewrite Qeq_alt, Qle_alt, Qlt_alt. destruct (x ?= y); intuition; discriminate. Qed. -Lemma Qlt_le_weak : forall x y, x<y -> x<=y. +Lemma Qlt_le_weak x y : x<y -> x<=y. Proof. unfold Qle, Qlt; auto with zarith. Qed. @@ -629,15 +598,11 @@ 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. + apply Z.mul_lt_mono_pos_r with ('y2); [easy|]. + apply Z.le_lt_trans with (y1 * 'x2 * 'z2). + - rewrite Z.mul_shuffle0. now apply Z.mul_le_mono_pos_r. + - rewrite Z.mul_shuffle0, (Z.mul_shuffle0 z1). + now apply Z.mul_lt_mono_pos_r. Close Scope Z_scope. Qed. @@ -645,15 +610,11 @@ 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. + apply Z.mul_lt_mono_pos_r with ('y2); [easy|]. + apply Z.lt_le_trans with (y1 * 'x2 * 'z2). + - rewrite Z.mul_shuffle0. now apply Z.mul_lt_mono_pos_r. + - rewrite Z.mul_shuffle0, (Z.mul_shuffle0 z1). + now apply Z.mul_le_mono_pos_r. Close Scope Z_scope. Qed. @@ -688,7 +649,7 @@ 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; now apply Z.lt_eq_cases. Qed. Hint Resolve Qle_not_lt Qlt_not_le Qnot_le_lt Qnot_lt_le @@ -713,7 +674,7 @@ Defined. 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. + rewrite !Z.mul_opp_l. omega. Qed. Hint Resolve Qopp_le_compat : qarith. @@ -721,15 +682,13 @@ Hint Resolve Qopp_le_compat : qarith. 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. + rewrite Z.mul_opp_l. 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. + rewrite Z.mul_opp_l. omega. Qed. Lemma Qplus_le_compat : @@ -740,8 +699,8 @@ Proof. Open Scope Z_scope. intros. match goal with |- ?a <= ?b => ring_simplify a b end. - rewrite Zplus_comm. - apply Zplus_le_compat. + rewrite Z.add_comm. + apply Z.add_le_mono. 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. @@ -757,13 +716,12 @@ Proof. Open Scope Z_scope. intros. match goal with |- ?a < ?b => ring_simplify a b end. - rewrite Zplus_comm. - apply Zplus_le_lt_compat. + rewrite Z.add_comm. + apply Z.add_le_lt_mono. 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. - assert (forall p, 0 < ' p) by reflexivity. - repeat (apply Zmult_lt_compat_r; auto). + do 2 (apply Z.mul_lt_mono_pos_r;try easy). Close Scope Z_scope. Qed. @@ -802,20 +760,20 @@ 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. + rewrite Z.mul_shuffle1, (Z.mul_shuffle1 b1). + apply Z.mul_le_mono_nonneg_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. +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. + rewrite Z.mul_shuffle1, (Z.mul_shuffle1 b1). + intros LT LE. + apply Z.mul_le_mono_pos_r in LE; trivial. + apply Z.mul_pos_pos; [omega|easy]. Close Scope Z_scope. Qed. @@ -837,12 +795,9 @@ 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. + rewrite Z.mul_shuffle1, (Z.mul_shuffle1 b1). + apply Z.mul_lt_mono_pos_r; auto with zarith. + apply Z.mul_pos_pos; [omega|reflexivity]. Close Scope Z_scope. Qed. @@ -852,15 +807,9 @@ Proof. intros (a1,a2) (b1,b2) (c1,c2). unfold Qle, Qlt; simpl. 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. - assert (forall p, 0 < ' p) by reflexivity. - split; intros. - apply Zmult_lt_reg_r with (c1*'c2); auto with zarith. - apply Zmult_lt_0_compat; auto with zarith. - apply Zmult_lt_compat_r; auto with zarith. - apply Zmult_lt_0_compat. omega. - compute; auto. + rewrite Z.mul_shuffle1, (Z.mul_shuffle1 b1). + intro LT. rewrite <- Z.mul_lt_mono_pos_r. reflexivity. + apply Z.mul_pos_pos; [omega|reflexivity]. Close Scope Z_scope. Qed. diff --git a/theories/QArith/QOrderedType.v b/theories/QArith/QOrderedType.v index 238de6fa..e146da25 100644 --- a/theories/QArith/QOrderedType.v +++ b/theories/QArith/QOrderedType.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/QArith/Qabs.v b/theories/QArith/Qabs.v index 557fabc8..50aee530 100644 --- a/theories/QArith/Qabs.v +++ b/theories/QArith/Qabs.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -11,7 +11,7 @@ Require Export Qreduction. Hint Resolve Qlt_le_weak : qarith. -Definition Qabs (x:Q) := let (n,d):=x in (Zabs n#d). +Definition Qabs (x:Q) := let (n,d):=x in (Z.abs n#d). Lemma Qabs_case : forall (x:Q) (P : Q -> Type), (0 <= x -> P x) -> (x <= 0 -> P (- x)) -> P (Qabs x). Proof. @@ -26,9 +26,9 @@ intros [xn xd] [yn yd] H. simpl. unfold Qeq in *. simpl in *. -change (' yd)%Z with (Zabs (' yd)). -change (' xd)%Z with (Zabs (' xd)). -repeat rewrite <- Zabs_Zmult. +change (' yd)%Z with (Z.abs (' yd)). +change (' xd)%Z with (Z.abs (' xd)). +repeat rewrite <- Z.abs_mul. congruence. Qed. @@ -61,7 +61,7 @@ auto. apply (Qopp_le_compat x 0). Qed. -Lemma Zabs_Qabs : forall n d, (Zabs n#d)==Qabs (n#d). +Lemma Zabs_Qabs : forall n d, (Z.abs n#d)==Qabs (n#d). Proof. intros [|n|n]; reflexivity. Qed. @@ -85,25 +85,25 @@ intros [xn xd] [yn yd]. unfold Qplus. unfold Qle. simpl. -apply Zmult_le_compat_r;auto with *. -change (' yd)%Z with (Zabs (' yd)). -change (' xd)%Z with (Zabs (' xd)). -repeat rewrite <- Zabs_Zmult. -apply Zabs_triangle. +apply Z.mul_le_mono_nonneg_r;auto with *. +change (' yd)%Z with (Z.abs (' yd)). +change (' xd)%Z with (Z.abs (' xd)). +repeat rewrite <- Z.abs_mul. +apply Z.abs_triangle. Qed. Lemma Qabs_Qmult : forall a b, Qabs (a*b) == (Qabs a)*(Qabs b). Proof. intros [an ad] [bn bd]. simpl. -rewrite Zabs_Zmult. +rewrite Z.abs_mul. reflexivity. Qed. Lemma Qabs_Qminus x y: Qabs (x - y) = Qabs (y - x). Proof. unfold Qminus, Qopp. simpl. - rewrite Pmult_comm, <- Zabs_Zopp. + rewrite Pos.mul_comm, <- Z.abs_opp. do 2 f_equal. ring. Qed. diff --git a/theories/QArith/Qcanon.v b/theories/QArith/Qcanon.v index fea2ba39..d1160cbe 100644 --- a/theories/QArith/Qcanon.v +++ b/theories/QArith/Qcanon.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -22,39 +22,39 @@ Arguments Qcmake this%Q _. Open Scope Qc_scope. Lemma Qred_identity : - forall q:Q, Zgcd (Qnum q) (QDen q) = 1%Z -> Qred q = q. + forall q:Q, Z.gcd (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)). + generalize (Z.ggcd_gcd a ('b)) (Z.ggcd_correct_divisors a ('b)). intros. rewrite H1 in H; clear H1. - destruct (Zggcd a ('b)) as (g,(aa,bb)); simpl in *; subst. + destruct (Z.ggcd a ('b)) as (g,(aa,bb)); simpl in *; subst. destruct H0. - rewrite Zmult_1_l in H, H0. + rewrite Z.mul_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. + forall q:Q, Qred q = q -> Z.gcd (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)). + generalize (Z.ggcd_gcd a ('b)) (Z.ggcd_correct_divisors a ('b)) (Z.gcd_nonneg a ('b)). intros. rewrite <- H; rewrite <- H in H1; clear H. - destruct (Zggcd a ('b)) as (g,(aa,bb)); simpl in *; subst. + destruct (Z.ggcd 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. + apply Pos.mul_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. +Lemma Qred_iff : forall q:Q, Qred q = q <-> Z.gcd (Qnum q) (QDen q) = 1%Z. Proof. split; intros. apply Qred_identity2; auto. @@ -488,7 +488,7 @@ Definition Qc_eq_bool (x y : Qc) := Lemma Qc_eq_bool_correct : forall x y : Qc, Qc_eq_bool x y = true -> x=y. Proof. - intros x y; unfold Qc_eq_bool in |- *; case (Qc_eq_dec x y); simpl in |- *; auto. + intros x y; unfold Qc_eq_bool; case (Qc_eq_dec x y); simpl; auto. intros _ H; inversion H. Qed. diff --git a/theories/QArith/Qfield.v b/theories/QArith/Qfield.v index 5e27f381..3e162cdc 100644 --- a/theories/QArith/Qfield.v +++ b/theories/QArith/Qfield.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -38,7 +38,7 @@ Proof. exact Hp. Qed. -Lemma Qpower_theory : power_theory 1 Qmult Qeq Z_of_N Qpower. +Lemma Qpower_theory : power_theory 1 Qmult Qeq Z.of_N Qpower. Proof. constructor. intros r [|n]; @@ -66,7 +66,7 @@ Ltac Qpow_tac t := match t with | Z0 => N0 | Zpos ?n => Ncst (Npos n) - | Z_of_N ?n => Ncst n + | Z.of_N ?n => Ncst n | NtoZ ?n => Ncst n | _ => NotConstant end. diff --git a/theories/QArith/Qminmax.v b/theories/QArith/Qminmax.v index 2da24ee6..2b6c3980 100644 --- a/theories/QArith/Qminmax.v +++ b/theories/QArith/Qminmax.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/QArith/Qpower.v b/theories/QArith/Qpower.v index b05ee649..5d494c7c 100644 --- a/theories/QArith/Qpower.v +++ b/theories/QArith/Qpower.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -101,10 +101,9 @@ Lemma Qpower_plus_positive : forall a n m, Qpower_positive a (n+m) == (Qpower_po Proof. intros a n m. unfold Qpower_positive. -apply pow_pos_Pplus. +apply pow_pos_add. apply Q_Setoid. apply Qmult_comp. -apply Qmult_comm. apply Qmult_assoc. Qed. @@ -114,21 +113,18 @@ intros a [|n|n]; simpl; try reflexivity. symmetry; apply Qinv_involutive. Qed. -Lemma Qpower_minus_positive : forall a (n m:positive), (Pcompare n m Eq=Gt)%positive -> Qpower_positive a (n-m)%positive == (Qpower_positive a n)/(Qpower_positive a m). +Lemma Qpower_minus_positive : forall a (n m:positive), + (m < n)%positive -> + Qpower_positive a (n-m)%positive == (Qpower_positive a n)/(Qpower_positive a m). Proof. intros a n m H. -destruct (Qeq_dec a 0). - rewrite q. - repeat rewrite Qpower_positive_0. - reflexivity. -rewrite <- (Qdiv_mult_l (Qpower_positive a (n - m)) (Qpower_positive a m)) by - (apply Qpower_not_0_positive; assumption). -apply Qdiv_comp;[|reflexivity]. -rewrite Qmult_comm. -rewrite <- Qpower_plus_positive. -rewrite Pplus_minus. -reflexivity. -assumption. +destruct (Qeq_dec a 0) as [EQ|NEQ]. +- now rewrite EQ, !Qpower_positive_0. +- rewrite <- (Qdiv_mult_l (Qpower_positive a (n - m)) (Qpower_positive a m)) by + (now apply Qpower_not_0_positive). + f_equiv. + rewrite <- Qpower_plus_positive. + now rewrite Pos.sub_add. Qed. Lemma Qpower_plus : forall a n m, ~a==0 -> a^(n+m) == a^n*a^m. @@ -140,8 +136,6 @@ rewrite ?Z.pos_sub_spec; case Pos.compare_spec; intros H0; simpl; subst; try rewrite Qpower_minus_positive; try (field; try split; apply Qpower_not_0_positive); - try assumption; - apply ZC2; assumption. Qed. @@ -158,13 +152,14 @@ apply Qpower_plus. assumption. Qed. -Lemma Qpower_mult_positive : forall a n m, Qpower_positive a (n*m) == Qpower_positive (Qpower_positive a n) m. +Lemma Qpower_mult_positive : forall a n m, + Qpower_positive a (n*m) == Qpower_positive (Qpower_positive a n) m. Proof. intros a n m. -induction n using Pind. +induction n using Pos.peano_ind. reflexivity. -rewrite Pmult_Sn_m. -rewrite Pplus_one_succ_l. +rewrite Pos.mul_succ_l. +rewrite <- Pos.add_1_l. do 2 rewrite Qpower_plus_positive. rewrite IHn. rewrite Qmult_power_positive. @@ -184,11 +179,11 @@ Qed. Lemma Zpower_Qpower : forall (a n:Z), (0<=n)%Z -> inject_Z (a^n) == (inject_Z a)^n. Proof. intros a [|n|n] H;[reflexivity| |elim H; reflexivity]. -induction n using Pind. +induction n using Pos.peano_ind. replace (a^1)%Z with a by ring. ring. -rewrite Zpos_succ_morphism. -unfold Zsucc. +rewrite Pos2Z.inj_succ. +unfold Z.succ. rewrite Zpower_exp; auto with *; try discriminate. rewrite Qpower_plus' by discriminate. rewrite <- IHn by discriminate. @@ -209,31 +204,20 @@ setoid_replace (0+ - a) with (-a) in A by ring. apply Qmult_le_0_compat; assumption. Qed. -Theorem Qpower_decomp: forall p x y, - Qpower_positive (x #y) p == x ^ Zpos p # (Z2P ((Zpos y) ^ Zpos p)). -Proof. -induction p; intros; unfold Qmult; simpl. -(* xI *) -rewrite IHp, xI_succ_xO, <-Pplus_diag, Pplus_one_succ_l. -repeat rewrite Zpower_pos_is_exp. -red; unfold Qmult, Qnum, Qden, Zpower. -repeat rewrite Zpos_mult_morphism. -repeat rewrite Z2P_correct. -repeat rewrite Zpower_pos_1_r; ring. -apply Zpower_pos_pos; red; auto. -repeat apply Zmult_lt_0_compat; red; auto; - apply Zpower_pos_pos; red; auto. -(* xO *) -rewrite IHp, <-Pplus_diag. -repeat rewrite Zpower_pos_is_exp. -red; unfold Qmult, Qnum, Qden, Zpower. -repeat rewrite Zpos_mult_morphism. -repeat rewrite Z2P_correct; try ring. -apply Zpower_pos_pos; red; auto. -repeat apply Zmult_lt_0_compat; auto; - apply Zpower_pos_pos; red; auto. -(* xO *) -unfold Qmult; simpl. -red; simpl; rewrite Zpower_pos_1_r; - rewrite Zpos_mult_morphism; ring. +Theorem Qpower_decomp p x y : + Qpower_positive (x#y) p = x ^ Zpos p # (y ^ p). +Proof. +induction p; intros; simpl Qpower_positive; rewrite ?IHp. +- (* xI *) + unfold Qmult, Qnum, Qden. f_equal. + + now rewrite <- Z.pow_twice_r, <- Z.pow_succ_r. + + apply Pos2Z.inj; rewrite !Pos2Z.inj_mul, !Pos2Z.inj_pow. + now rewrite <- Z.pow_twice_r, <- Z.pow_succ_r. +- (* xO *) + unfold Qmult, Qnum, Qden. f_equal. + + now rewrite <- Z.pow_twice_r. + + apply Pos2Z.inj; rewrite !Pos2Z.inj_mul, !Pos2Z.inj_pow. + now rewrite <- Z.pow_twice_r. +- (* xO *) + now rewrite Z.pow_1_r, Pos.pow_1_r. Qed. diff --git a/theories/QArith/Qreals.v b/theories/QArith/Qreals.v index 24f6d720..0c7a22bf 100644 --- a/theories/QArith/Qreals.v +++ b/theories/QArith/Qreals.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -21,7 +21,7 @@ Hint Resolve IZR_nz Rmult_integral_contrapositive. Lemma eqR_Qeq : forall x y : Q, Q2R x = Q2R y -> x==y. Proof. -unfold Qeq, Q2R in |- *; intros (x1, x2) (y1, y2); unfold Qnum, Qden in |- *; +unfold Qeq, Q2R; intros (x1, x2) (y1, y2); unfold Qnum, Qden; intros. apply eq_IZR. do 2 rewrite mult_IZR. @@ -36,24 +36,24 @@ Qed. Lemma Qeq_eqR : forall x y : Q, x==y -> Q2R x = Q2R y. Proof. -unfold Qeq, Q2R in |- *; intros (x1, x2) (y1, y2); unfold Qnum, Qden in |- *; +unfold Qeq, Q2R; intros (x1, x2) (y1, y2); unfold Qnum, Qden; intros. set (X1 := IZR x1) in *; assert (X2nz := IZR_nz x2); set (X2 := IZR (Zpos x2)) in *. set (Y1 := IZR y1) in *; assert (Y2nz := IZR_nz y2); set (Y2 := IZR (Zpos y2)) in *. assert ((X1 * Y2)%R = (Y1 * X2)%R). - unfold X1, X2, Y1, Y2 in |- *; do 2 rewrite <- mult_IZR. + unfold X1, X2, Y1, Y2; do 2 rewrite <- mult_IZR. apply IZR_eq; auto. clear H. field_simplify_eq; auto. ring_simplify X1 Y2 (Y2 * X1)%R. -rewrite H0 in |- *; ring. +rewrite H0; ring. Qed. Lemma Rle_Qle : forall x y : Q, (Q2R x <= Q2R y)%R -> x<=y. Proof. -unfold Qle, Q2R in |- *; intros (x1, x2) (y1, y2); unfold Qnum, Qden in |- *; +unfold Qle, Q2R; intros (x1, x2) (y1, y2); unfold Qnum, Qden; intros. apply le_IZR. do 2 rewrite mult_IZR. @@ -65,37 +65,37 @@ replace (X1 * Y2)%R with (X1 * / X2 * (X2 * Y2))%R; try (field; auto). replace (Y1 * X2)%R with (Y1 * / Y2 * (X2 * Y2))%R; try (field; auto). apply Rmult_le_compat_r; auto. apply Rmult_le_pos. -unfold X2 in |- *; replace 0%R with (IZR 0); auto; apply IZR_le; +unfold X2; replace 0%R with (IZR 0); auto; apply IZR_le; auto with zarith. -unfold Y2 in |- *; replace 0%R with (IZR 0); auto; apply IZR_le; +unfold Y2; replace 0%R with (IZR 0); auto; apply IZR_le; auto with zarith. Qed. Lemma Qle_Rle : forall x y : Q, x<=y -> (Q2R x <= Q2R y)%R. Proof. -unfold Qle, Q2R in |- *; intros (x1, x2) (y1, y2); unfold Qnum, Qden in |- *; +unfold Qle, Q2R; intros (x1, x2) (y1, y2); unfold Qnum, Qden; intros. set (X1 := IZR x1) in *; assert (X2nz := IZR_nz x2); set (X2 := IZR (Zpos x2)) in *. set (Y1 := IZR y1) in *; assert (Y2nz := IZR_nz y2); set (Y2 := IZR (Zpos y2)) in *. assert (X1 * Y2 <= Y1 * X2)%R. - unfold X1, X2, Y1, Y2 in |- *; do 2 rewrite <- mult_IZR. + unfold X1, X2, Y1, Y2; do 2 rewrite <- mult_IZR. apply IZR_le; auto. clear H. replace (X1 * / X2)%R with (X1 * Y2 * (/ X2 * / Y2))%R; try (field; auto). replace (Y1 * / Y2)%R with (Y1 * X2 * (/ X2 * / Y2))%R; try (field; auto). apply Rmult_le_compat_r; auto. apply Rmult_le_pos; apply Rlt_le; apply Rinv_0_lt_compat. -unfold X2 in |- *; replace 0%R with (IZR 0); auto; apply IZR_lt; red in |- *; +unfold X2; replace 0%R with (IZR 0); auto; apply IZR_lt; red; auto with zarith. -unfold Y2 in |- *; replace 0%R with (IZR 0); auto; apply IZR_lt; red in |- *; +unfold Y2; replace 0%R with (IZR 0); auto; apply IZR_lt; red; auto with zarith. Qed. Lemma Rlt_Qlt : forall x y : Q, (Q2R x < Q2R y)%R -> x<y. Proof. -unfold Qlt, Q2R in |- *; intros (x1, x2) (y1, y2); unfold Qnum, Qden in |- *; +unfold Qlt, Q2R; intros (x1, x2) (y1, y2); unfold Qnum, Qden; intros. apply lt_IZR. do 2 rewrite mult_IZR. @@ -107,38 +107,38 @@ replace (X1 * Y2)%R with (X1 * / X2 * (X2 * Y2))%R; try (field; auto). replace (Y1 * X2)%R with (Y1 * / Y2 * (X2 * Y2))%R; try (field; auto). apply Rmult_lt_compat_r; auto. apply Rmult_lt_0_compat. -unfold X2 in |- *; replace 0%R with (IZR 0); auto; apply IZR_lt; red in |- *; +unfold X2; replace 0%R with (IZR 0); auto; apply IZR_lt; red; auto with zarith. -unfold Y2 in |- *; replace 0%R with (IZR 0); auto; apply IZR_lt; red in |- *; +unfold Y2; replace 0%R with (IZR 0); auto; apply IZR_lt; red; auto with zarith. Qed. Lemma Qlt_Rlt : forall x y : Q, x<y -> (Q2R x < Q2R y)%R. Proof. -unfold Qlt, Q2R in |- *; intros (x1, x2) (y1, y2); unfold Qnum, Qden in |- *; +unfold Qlt, Q2R; intros (x1, x2) (y1, y2); unfold Qnum, Qden; intros. set (X1 := IZR x1) in *; assert (X2nz := IZR_nz x2); set (X2 := IZR (Zpos x2)) in *. set (Y1 := IZR y1) in *; assert (Y2nz := IZR_nz y2); set (Y2 := IZR (Zpos y2)) in *. assert (X1 * Y2 < Y1 * X2)%R. - unfold X1, X2, Y1, Y2 in |- *; do 2 rewrite <- mult_IZR. + unfold X1, X2, Y1, Y2; do 2 rewrite <- mult_IZR. apply IZR_lt; auto. clear H. replace (X1 * / X2)%R with (X1 * Y2 * (/ X2 * / Y2))%R; try (field; auto). replace (Y1 * / Y2)%R with (Y1 * X2 * (/ X2 * / Y2))%R; try (field; auto). apply Rmult_lt_compat_r; auto. apply Rmult_lt_0_compat; apply Rinv_0_lt_compat. -unfold X2 in |- *; replace 0%R with (IZR 0); auto; apply IZR_lt; red in |- *; +unfold X2; replace 0%R with (IZR 0); auto; apply IZR_lt; red; auto with zarith. -unfold Y2 in |- *; replace 0%R with (IZR 0); auto; apply IZR_lt; red in |- *; +unfold Y2; replace 0%R with (IZR 0); auto; apply IZR_lt; red; auto with zarith. Qed. Lemma Q2R_plus : forall x y : Q, Q2R (x+y) = (Q2R x + Q2R y)%R. Proof. -unfold Qplus, Qeq, Q2R in |- *; intros (x1, x2) (y1, y2); - unfold Qden, Qnum in |- *. +unfold Qplus, Qeq, Q2R; intros (x1, x2) (y1, y2); + unfold Qden, Qnum. simpl_mult. rewrite plus_IZR. do 3 rewrite mult_IZR. @@ -147,8 +147,8 @@ Qed. Lemma Q2R_mult : forall x y : Q, Q2R (x*y) = (Q2R x * Q2R y)%R. Proof. -unfold Qmult, Qeq, Q2R in |- *; intros (x1, x2) (y1, y2); - unfold Qden, Qnum in |- *. +unfold Qmult, Qeq, Q2R; intros (x1, x2) (y1, y2); + unfold Qden, Qnum. simpl_mult. do 2 rewrite mult_IZR. field; auto. @@ -156,24 +156,24 @@ Qed. Lemma Q2R_opp : forall x : Q, Q2R (- x) = (- Q2R x)%R. Proof. -unfold Qopp, Qeq, Q2R in |- *; intros (x1, x2); unfold Qden, Qnum in |- *. +unfold Qopp, Qeq, Q2R; intros (x1, x2); unfold Qden, Qnum. rewrite Ropp_Ropp_IZR. field; auto. Qed. Lemma Q2R_minus : forall x y : Q, Q2R (x-y) = (Q2R x - Q2R y)%R. -unfold Qminus in |- *; intros; rewrite Q2R_plus; rewrite Q2R_opp; auto. +unfold Qminus; intros; rewrite Q2R_plus; rewrite Q2R_opp; auto. Qed. Lemma Q2R_inv : forall x : Q, ~ x==0 -> Q2R (/x) = (/ Q2R x)%R. Proof. -unfold Qinv, Q2R, Qeq in |- *; intros (x1, x2); unfold Qden, Qnum in |- *. +unfold Qinv, Q2R, Qeq; intros (x1, x2); unfold Qden, Qnum. case x1. -simpl in |- *; intros; elim H; trivial. +simpl; intros; elim H; trivial. intros; field; auto. intros; - change (IZR (Zneg x2)) with (- IZR (' x2))%R in |- *; - change (IZR (Zneg p)) with (- IZR (' p))%R in |- *; + change (IZR (Zneg x2)) with (- IZR (' x2))%R; + change (IZR (Zneg p)) with (- IZR (' p))%R; field; (*auto 8 with real.*) repeat split; auto; auto with real. Qed. @@ -181,7 +181,7 @@ Qed. Lemma Q2R_div : forall x y : Q, ~ y==0 -> Q2R (x/y) = (Q2R x / Q2R y)%R. Proof. -unfold Qdiv, Rdiv in |- *. +unfold Qdiv, Rdiv. intros; rewrite Q2R_mult. rewrite Q2R_inv; auto. Qed. @@ -205,7 +205,7 @@ Qed. Let ex2 : forall x y : Q, ~ y==0 -> (x/y)*y == x. intros; QField. intro; apply H; apply eqR_Qeq. -rewrite H0; unfold Q2R in |- *; simpl in |- *; field; auto with real. +rewrite H0; unfold Q2R; simpl; field; auto with real. Qed. End LegacyQField. diff --git a/theories/QArith/Qreduction.v b/theories/QArith/Qreduction.v index e39eca0c..3b3a30eb 100644 --- a/theories/QArith/Qreduction.v +++ b/theories/QArith/Qreduction.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -11,46 +11,29 @@ Require Export QArith_base. Require Import Znumtheory. -(** First, a function that (tries to) build a positive back from a Z. *) +Notation Z2P := Z.to_pos (compat "8.3"). +Notation Z2P_correct := Z2Pos.id (compat "8.3"). -Definition Z2P (z : Z) := - match z with - | Z0 => 1%positive - | Zpos p => p - | Zneg p => p - end. - -Lemma Z2P_correct : forall z : Z, (0 < z)%Z -> Zpos (Z2P z) = z. -Proof. - simple destruct z; simpl in |- *; auto; intros; discriminate. -Qed. - -Lemma Z2P_correct2 : forall z : Z, 0%Z <> z -> Zpos (Z2P z) = Zabs z. -Proof. - simple destruct z; simpl in |- *; auto; intros; elim H; auto. -Qed. - -(** Simplification of fractions using [Zgcd]. +(** Simplification of fractions using [Z.gcd]. This version can compute within Coq. *) Definition Qred (q:Q) := let (q1,q2) := q in - let (r1,r2) := snd (Zggcd q1 ('q2)) - in r1#(Z2P r2). + let (r1,r2) := snd (Z.ggcd q1 ('q2)) + in r1#(Z.to_pos r2). Lemma Qred_correct : forall q, (Qred q) == q. Proof. unfold Qred, Qeq; intros (n,d); simpl. - generalize (Zggcd_gcd n ('d)) (Zgcd_nonneg n ('d)) - (Zggcd_correct_divisors n ('d)). - destruct (Zggcd n (Zpos d)) as (g,(nn,dd)); simpl. + generalize (Z.ggcd_gcd n ('d)) (Z.gcd_nonneg n ('d)) + (Z.ggcd_correct_divisors n ('d)). + destruct (Z.ggcd n (Zpos d)) as (g,(nn,dd)); simpl. Open Scope Z_scope. intros Hg LE (Hn,Hd). rewrite Hd, Hn. rewrite <- Hg in LE; clear Hg. assert (0 <> g) by (intro; subst; discriminate). - rewrite Z2P_correct. ring. - apply Zmult_gt_0_lt_0_reg_r with g; auto with zarith. - now rewrite Zmult_comm, <- Hd. + rewrite Z2Pos.id. ring. + rewrite <- (Z.mul_pos_cancel_l g); [now rewrite <- Hd | omega]. Close Scope Z_scope. Qed. @@ -59,68 +42,54 @@ 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_nonneg 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_nonneg 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) by (intro; subst g; discriminate). - assert (g' <> 0) by (intro; subst g'; discriminate). + intros H. + generalize (Z.ggcd_gcd a ('b)) (Zgcd_is_gcd a ('b)) + (Z.gcd_nonneg a ('b)) (Z.ggcd_correct_divisors a ('b)). + destruct (Z.ggcd a (Zpos b)) as (g,(aa,bb)). + simpl. intros <- Hg1 Hg2 (Hg3,Hg4). + assert (Hg0 : g <> 0) by (intro; now subst g). + generalize (Z.ggcd_gcd c ('d)) (Zgcd_is_gcd c ('d)) + (Z.gcd_nonneg c ('d)) (Z.ggcd_correct_divisors c ('d)). + destruct (Z.ggcd c (Zpos d)) as (g',(cc,dd)). + simpl. intros <- Hg'1 Hg'2 (Hg'3,Hg'4). + assert (Hg'0 : g' <> 0) by (intro; now subst g'). 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)) as (x',Hx). - 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 x'. - apply Zmult_reg_l with g; auto. rewrite Hx at 1; 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)) as (x',Hx). - 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 x'. - apply Zmult_reg_l with g'; auto. rewrite Hx at 1; 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]. - 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. + - congruence. + - (*rel_prime*) + constructor. + * exists aa; auto with zarith. + * exists bb; auto with zarith. + * intros x Ha Hb. + destruct Hg1 as (Hg11,Hg12,Hg13). + destruct (Hg13 (g*x)) as (x',Hx). + { rewrite Hg3. + destruct Ha as (xa,Hxa); exists xa; rewrite Hxa; ring. } + { rewrite Hg4. + destruct Hb as (xb,Hxb); exists xb; rewrite Hxb; ring. } + exists x'. + apply Z.mul_reg_l with g; auto. rewrite Hx at 1; ring. + - (* rel_prime *) + constructor. + * exists cc; auto with zarith. + * exists dd; auto with zarith. + * intros x Hc Hd. + inversion Hg'1 as (Hg'11,Hg'12,Hg'13). + destruct (Hg'13 (g'*x)) as (x',Hx). + { rewrite Hg'3. + destruct Hc as (xc,Hxc); exists xc; rewrite Hxc; ring. } + { rewrite Hg'4. + destruct Hd as (xd,Hxd); exists xd; rewrite Hxd; ring. } + exists x'. + apply Z.mul_reg_l with g'; auto. rewrite Hx at 1; ring. + - apply Z.lt_gt. + rewrite <- (Z.mul_pos_cancel_l g); [now rewrite <- Hg4 | omega]. + - apply Z.lt_gt. + rewrite <- (Z.mul_pos_cancel_l g'); [now rewrite <- Hg'4 | omega]. + - apply Z.mul_reg_l with (g*g'). + * rewrite Z.mul_eq_0. now destruct 1. + * rewrite Z.mul_shuffle1, <- Hg3, <- Hg'4. + now rewrite Z.mul_shuffle1, <- Hg'3, <- Hg4, H, Z.mul_comm. Close Scope Z_scope. Qed. @@ -137,39 +106,39 @@ Definition Qminus' x y := Qred (Qminus x y). 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'; 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'; apply Qred_correct; auto. Qed. Lemma Qminus'_correct : forall p q : Q, (Qminus' p q)==(Qminus p q). Proof. - intros; unfold Qminus' in |- *; apply Qred_correct; auto. + intros; unfold Qminus'; 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'. + rewrite H, H0; auto with qarith. Qed. Add Morphism Qmult' : Qmult'_comp. - intros; unfold Qmult' in |- *. - rewrite H; rewrite H0; auto with qarith. + intros; unfold Qmult'. + rewrite H, H0; auto with qarith. Qed. Add Morphism Qminus' : Qminus'_comp. - intros; unfold Qminus' in |- *. - rewrite H; rewrite H0; auto with qarith. + intros; unfold Qminus'. + rewrite H, H0; auto with qarith. Qed. Lemma Qred_opp: forall q, Qred (-q) = - (Qred q). Proof. intros (x, y); unfold Qred; simpl. - rewrite Zggcd_opp; case Zggcd; intros p1 (p2, p3); simpl. + rewrite Z.ggcd_opp; case Z.ggcd; intros p1 (p2, p3); simpl. unfold Qopp; auto. Qed. @@ -178,4 +147,3 @@ Theorem Qred_compare: forall x y, Proof. intros x y; apply Qcompare_comp; apply Qeq_sym; apply Qred_correct. Qed. - diff --git a/theories/QArith/Qring.v b/theories/QArith/Qring.v index c88a8141..39e023cf 100644 --- a/theories/QArith/Qring.v +++ b/theories/QArith/Qring.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/QArith/Qround.v b/theories/QArith/Qround.v index ce363a33..be328c27 100644 --- a/theories/QArith/Qround.v +++ b/theories/QArith/Qround.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -11,16 +11,16 @@ Require Import QArith. Lemma Qopp_lt_compat: forall p q : Q, p < q -> - q < - p. Proof. intros (a1,a2) (b1,b2); unfold Qle, Qlt; simpl. -do 2 rewrite <- Zopp_mult_distr_l; omega. +rewrite !Z.mul_opp_l; omega. Qed. Hint Resolve Qopp_lt_compat : qarith. (************) -Coercion Local inject_Z : Z >-> Q. +Local Coercion inject_Z : Z >-> Q. -Definition Qfloor (x:Q) := let (n,d) := x in Zdiv n (Zpos d). +Definition Qfloor (x:Q) := let (n,d) := x in Z.div n (Zpos d). Definition Qceiling (x:Q) := (-(Qfloor (-x)))%Z. Lemma Qfloor_Z : forall z:Z, Qfloor z = z. @@ -46,7 +46,7 @@ simpl. unfold Qle. simpl. replace (n*1)%Z with n by ring. -rewrite Zmult_comm. +rewrite Z.mul_comm. apply Z_mult_div_ge. auto with *. Qed. @@ -81,7 +81,7 @@ ring_simplify. replace (n / ' d * ' d + ' d)%Z with (('d * (n / 'd) + n mod 'd) + 'd - n mod 'd)%Z by ring. rewrite <- Z_div_mod_eq; auto with*. -rewrite <- Zlt_plus_swap. +rewrite <- Z.lt_add_lt_sub_r. destruct (Z_mod_lt n ('d)); auto with *. Qed. @@ -107,7 +107,7 @@ unfold Qle in *. simpl in *. rewrite <- (Zdiv_mult_cancel_r xn ('xd) ('yd)); auto with *. rewrite <- (Zdiv_mult_cancel_r yn ('yd) ('xd)); auto with *. -rewrite (Zmult_comm ('yd) ('xd)). +rewrite (Z.mul_comm ('yd) ('xd)). apply Z_div_le; auto with *. Qed. @@ -125,7 +125,7 @@ Hint Resolve Qceiling_resp_le : qarith. Add Morphism Qfloor with signature Qeq ==> eq as Qfloor_comp. Proof. intros x y H. -apply Zle_antisym. +apply Z.le_antisymm. auto with *. symmetry in H; auto with *. Qed. @@ -133,7 +133,7 @@ Qed. Add Morphism Qceiling with signature Qeq ==> eq as Qceiling_comp. Proof. intros x y H. -apply Zle_antisym. +apply Z.le_antisymm. auto with *. symmetry in H; auto with *. Qed. @@ -142,9 +142,9 @@ Lemma Zdiv_Qdiv (n m: Z): (n / m)%Z = Qfloor (n / m). Proof. unfold Qfloor. intros. simpl. destruct m as [?|?|p]; simpl. - now rewrite Zdiv_0_r, Zmult_0_r. - now rewrite Zmult_1_r. - rewrite <- Zopp_eq_mult_neg_1. - rewrite <- (Zopp_involutive (Zpos p)). + now rewrite Zdiv_0_r, Z.mul_0_r. + now rewrite Z.mul_1_r. + rewrite <- Z.opp_eq_mul_m1. + rewrite <- (Z.opp_involutive (Zpos p)). now rewrite Zdiv_opp_opp. Qed. diff --git a/theories/Reals/Alembert.v b/theories/Reals/Alembert.v index 18612a68..13b33301 100644 --- a/theories/Reals/Alembert.v +++ b/theories/Reals/Alembert.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -13,7 +13,7 @@ Require Import SeqProp. Require Import PartSum. Require Import Max. -Open Local Scope R_scope. +Local Open Scope R_scope. (***************************************************) (* Various versions of the criterion of D'Alembert *) @@ -31,23 +31,23 @@ Proof. { 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); + unfold Un_cv in H0; unfold bound; 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. + unfold is_upper_bound; 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; + pattern (sum_f_R0 An x1) at 1; 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; + symmetry ; apply tech2; assumption. + rewrite b; pattern (sum_f_R0 An x) at 1; 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 @@ -64,14 +64,14 @@ Proof. 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); + unfold Rdiv; rewrite Rinv_involutive. + pattern 2 at 3; 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; + rewrite <- (Rplus_comm 1); pattern 1 at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l. apply pow_lt; apply Rinv_0_lt_compat; prove_sup0. discrR. @@ -80,14 +80,14 @@ Proof. ring. discrR. discrR. - pattern 1 at 3 in |- *; replace 1 with (/ 1); + pattern 1 at 3; 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 H6; unfold ge; 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. @@ -96,20 +96,20 @@ Proof. 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; + unfold Rminus; 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 |- *; + unfold Rdiv; reflexivity. + left; unfold Rdiv; change (0 < An (S n) * / An n); 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; + red; 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. + symmetry ; apply tech2; assumption. + exists (sum_f_R0 An 0); unfold EUn; exists 0%nat; reflexivity. intro X; elim X; intros. exists x; apply Un_cv_crit_lub; - [ unfold Un_growing in |- *; intro; rewrite tech5; - pattern (sum_f_R0 An n) at 1 in |- *; rewrite <- Rplus_0_r; + [ unfold Un_growing; intro; rewrite tech5; + pattern (sum_f_R0 An n) at 1; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; apply H | apply p ]. Defined. @@ -131,14 +131,14 @@ Proof. assert (H6 := Alembert_C1 Wn H2 H4). elim H5; intros. elim H6; intros. - exists (x - x0); unfold Un_cv in |- *; unfold Un_cv in p; + exists (x - x0); unfold Un_cv; 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 |- *; + unfold R_dist; 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 @@ -146,29 +146,29 @@ Proof. 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)); + unfold R_dist in H9; apply H9; unfold ge; apply le_trans with N; + [ unfold N; apply le_max_l | assumption ]. + unfold R_dist in H10; apply H10; unfold ge; apply le_trans with N; + [ unfold N; apply le_max_r | assumption ]. + right; symmetry ; apply double_var. + symmetry ; apply tech11; intro; unfold Vn, Wn; + unfold Rdiv; 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; + unfold Rdiv; 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; unfold Un_cv; 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; + unfold R_dist; unfold Rminus; 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. @@ -179,13 +179,13 @@ Proof. 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 |- *; + left; change (0 < Wn (S n) / Wn n); unfold Rdiv; apply Rmult_lt_0_compat. apply H2. apply Rinv_0_lt_compat; apply H2. - unfold Rdiv in |- *; apply Rmult_lt_0_compat; + unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. - intro; unfold Rdiv in |- *; rewrite Rabs_mult; rewrite <- Rmult_assoc; + intro; unfold Rdiv; 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)). @@ -218,32 +218,32 @@ Proof. 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; + red; 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)); + unfold Wn; unfold Rdiv; 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. + pattern (Rabs (An n)) at 1; rewrite <- Rplus_0_r; rewrite double; + unfold Rminus; 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)); + unfold Wn; unfold Rdiv; 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; + unfold Rminus; 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; unfold Un_cv; 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; + unfold R_dist; unfold Rminus; 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. @@ -254,13 +254,13 @@ Proof. 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 |- *; + left; change (0 < Vn (S n) / Vn n); unfold Rdiv; apply Rmult_lt_0_compat. apply H1. apply Rinv_0_lt_compat; apply H1. - unfold Rdiv in |- *; apply Rmult_lt_0_compat; + unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. - intro; unfold Rdiv in |- *; rewrite Rabs_mult; rewrite <- Rmult_assoc; + intro; unfold Rdiv; 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)). @@ -293,44 +293,44 @@ Proof. 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; + red; 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)); + unfold Vn; unfold Rdiv; 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; + pattern (Rabs (An n)) at 1; 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)); + unfold Vn; unfold Rdiv; 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; + unfold Rminus; 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)); + intro; unfold Wn; unfold Rdiv; 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 |- *; + apply Rplus_lt_reg_r with (An n); rewrite Rplus_0_r; unfold Rminus; 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; + rewrite double; pattern (Rabs (An n)) at 1; 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)); + intro; unfold Vn; unfold Rdiv; 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 |- *; + apply Rplus_lt_reg_r with (- An n); rewrite Rplus_0_r; unfold Rminus; 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; + rewrite double; pattern (Rabs (An n)) at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; apply Rabs_pos_lt; apply H. Defined. @@ -347,11 +347,11 @@ Proof. intro; assert (H4 := Alembert_C2 Bn H2 H3). elim H4; intros. exists x0; unfold Bn in p; apply tech12; assumption. - unfold Un_cv in |- *; intros; unfold Un_cv in H1; cut (0 < eps / Rabs x). + unfold Un_cv; 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 |- *; + exists x0; intros; unfold R_dist; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; - unfold Bn in |- *; + unfold Bn; 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. @@ -360,22 +360,22 @@ Proof. 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 |- *; + unfold R_dist; unfold Rminus; rewrite Ropp_0; + rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold Rdiv; 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. + unfold Rdiv; 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. + simpl; ring. apply pow_nonzero; assumption. apply H0. apply pow_nonzero; assumption. - unfold Rdiv in |- *; apply Rmult_lt_0_compat; + unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption ]. - intro; unfold Bn in |- *; apply prod_neq_R0; + intro; unfold Bn; apply prod_neq_R0; [ apply H0 | apply pow_nonzero; assumption ]. Defined. @@ -383,14 +383,14 @@ Lemma AlembertC3_step2 : forall (An:nat -> R) (x:R), x = 0 -> { l:R | Pser An x l }. Proof. intros; exists (An 0%nat). - unfold Pser in |- *; unfold infinite_sum in |- *; intros; exists 0%nat; intros; + unfold Pser; unfold infinite_sum; 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; + unfold R_dist; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. induction n as [| n Hrecn]. - simpl in |- *; ring. + simpl; ring. rewrite tech5; rewrite Hrecn; - [ rewrite H; simpl in |- *; ring | unfold ge in |- *; apply le_O_n ]. + [ rewrite H; simpl; ring | unfold ge; apply le_O_n ]. Qed. (** A useful criterion of convergence for power series *) @@ -404,11 +404,11 @@ Proof. elim s; intro. cut (x <> 0). intro; apply AlembertC3_step1; assumption. - red in |- *; intro; rewrite H1 in a; elim (Rlt_irrefl _ a). + red; 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). + red; intro; rewrite H1 in r; elim (Rlt_irrefl _ r). Defined. Lemma Alembert_C4 : @@ -428,8 +428,8 @@ Proof. 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. + unfold bound; exists (sum_f_R0 An x0 + / (1 - x) * An (S x0)). + unfold is_upper_bound; intros; unfold EUn in H6. elim H6; intros. rewrite H7. assert (H8 := lt_eq_lt_dec x2 x0). @@ -437,7 +437,7 @@ Proof. 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. + pattern (sum_f_R0 An x2) at 1; rewrite <- Rplus_0_r. rewrite Rplus_assoc; apply Rplus_le_compat_l. left; apply Rplus_lt_0_compat. apply tech1. @@ -446,8 +446,8 @@ Proof. 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; + symmetry ; apply tech2; assumption. + rewrite b; pattern (sum_f_R0 An x0) at 1; 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; @@ -465,7 +465,7 @@ Proof. 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). + unfold Rdiv; 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)). @@ -473,17 +473,17 @@ Proof. 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; + rewrite <- (Rplus_comm 1); pattern 1 at 1; 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. + red; intro. elim H3; intros. rewrite H10 in H12; elim (Rlt_irrefl _ H12). - red in |- *; intro. + red; intro. elim H3; intros. rewrite H10 in H12; elim (Rlt_irrefl _ H12). replace (An (S x0)) with (An (S x0 + 0)%nat). @@ -496,7 +496,7 @@ Proof. intro. replace (S x0 + S i)%nat with (S (S x0 + i)). apply H9. - unfold ge in |- *. + unfold ge. apply tech8. apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; do 2 rewrite S_INR; ring. @@ -510,21 +510,21 @@ Proof. 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 |- *; + unfold Rdiv; reflexivity. + left; unfold Rdiv; change (0 < An (S n) * / An n); apply Rmult_lt_0_compat. apply H. apply Rinv_0_lt_compat; apply H. - red in |- *; intro. + red; 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. + symmetry ; apply tech2; assumption. + exists (sum_f_R0 An 0); unfold EUn; exists 0%nat; reflexivity. intro X; elim X; intros. exists x; apply Un_cv_crit_lub; - [ unfold Un_growing in |- *; intro; rewrite tech5; - pattern (sum_f_R0 An n) at 1 in |- *; rewrite <- Rplus_0_r; + [ unfold Un_growing; intro; rewrite tech5; + pattern (sum_f_R0 An n) at 1; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; apply H | apply p ]. Qed. @@ -551,9 +551,9 @@ Proof. 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. unfold Un_cv in H1. - unfold Rdiv in |- *. + unfold Rdiv. intros. elim (H1 eps H2); intros. exists x; intros. @@ -590,22 +590,22 @@ Lemma Alembert_C6 : elim s; intro. eapply Alembert_C5 with (k * Rabs x). split. - unfold Rdiv in |- *; apply Rmult_le_pos. + unfold Rdiv; apply Rmult_le_pos. left; assumption. left; apply Rabs_pos_lt. - red in |- *; intro; rewrite H3 in a; elim (Rlt_irrefl _ a). + red; 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). + red; 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. + red; intro; rewrite H3 in a; elim (Rlt_irrefl _ a). + unfold Un_cv; unfold Un_cv in H1. intros. cut (0 < eps / Rabs x). intro. @@ -613,7 +613,7 @@ Lemma Alembert_C6 : 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 |- *. + unfold R_dist. 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 ]. @@ -621,18 +621,18 @@ Lemma Alembert_C6 : 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). + red; 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. + unfold Rdiv; 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 ]. + red; intro; rewrite H7 in a; elim (Rlt_irrefl _ a). + unfold Rdiv; replace (S n) with (n + 1)%nat; [ idtac | ring ]. rewrite pow_add. - simpl in |- *. + simpl. rewrite Rmult_1_r. rewrite Rinv_mult_distr. replace (An (n + 1)%nat * (x ^ n * x) * (/ An n * / x ^ n)) with @@ -641,46 +641,46 @@ Lemma Alembert_C6 : rewrite <- Rinv_r_sym. rewrite Rmult_1_r; reflexivity. apply pow_nonzero. - red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a). + red; 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. + red; intro; rewrite H7 in a; elim (Rlt_irrefl _ a). + unfold Rdiv; 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). + red; intro H7; rewrite H7 in a; elim (Rlt_irrefl _ a). exists (An 0%nat). - unfold Un_cv in |- *. + unfold Un_cv. intros. exists 0%nat. intros. - unfold R_dist in |- *. + unfold R_dist. 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. + unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. induction n as [| n Hrecn]. - simpl in |- *; ring. + simpl; ring. rewrite tech5. rewrite <- Hrecn. - rewrite b; simpl in |- *; ring. - unfold ge in |- *; apply le_O_n. + rewrite b; simpl; ring. + unfold ge; apply le_O_n. eapply Alembert_C5 with (k * Rabs x). split. - unfold Rdiv in |- *; apply Rmult_le_pos. + unfold Rdiv; apply Rmult_le_pos. left; assumption. left; apply Rabs_pos_lt. - red in |- *; intro; rewrite H3 in r; elim (Rlt_irrefl _ r). + red; 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). + red; 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. + red; intro; rewrite H3 in r; elim (Rlt_irrefl _ r). + unfold Un_cv; unfold Un_cv in H1. intros. cut (0 < eps / Rabs x). intro. @@ -688,7 +688,7 @@ Lemma Alembert_C6 : 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 |- *. + unfold R_dist. 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 ]. @@ -696,18 +696,18 @@ Lemma Alembert_C6 : 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). + red; 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. + unfold Rdiv; 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 ]. + red; intro; rewrite H7 in r; elim (Rlt_irrefl _ r). + unfold Rdiv; replace (S n) with (n + 1)%nat; [ idtac | ring ]. rewrite pow_add. - simpl in |- *. + simpl. rewrite Rmult_1_r. rewrite Rinv_mult_distr. replace (An (n + 1)%nat * (x ^ n * x) * (/ An n * / x ^ n)) with @@ -716,12 +716,12 @@ Lemma Alembert_C6 : rewrite <- Rinv_r_sym. rewrite Rmult_1_r; reflexivity. apply pow_nonzero. - red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r). + red; 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. + red; intro; rewrite H7 in r; elim (Rlt_irrefl _ r). + unfold Rdiv; 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). + red; intro H7; rewrite H7 in r; elim (Rlt_irrefl _ r). Qed. diff --git a/theories/Reals/AltSeries.v b/theories/Reals/AltSeries.v index 07a26929..69f29781 100644 --- a/theories/Reals/AltSeries.v +++ b/theories/Reals/AltSeries.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -12,7 +12,7 @@ Require Import Rseries. Require Import SeqProp. Require Import PartSum. Require Import Max. -Open Local Scope R_scope. +Local Open Scope R_scope. (**********) (** * Formalization of alternated series *) @@ -24,13 +24,13 @@ Lemma CV_ALT_step0 : Un_decreasing Un -> Un_growing (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N))). Proof. - intros; unfold Un_growing in |- *; intro. + intros; unfold Un_growing; 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. + pattern (tg_alt Un (S (2 * n))) at 1; rewrite <- Rplus_0_r. apply Rplus_le_compat_l. - unfold tg_alt in |- *; rewrite <- H0; rewrite pow_1_odd; rewrite pow_1_even; + unfold tg_alt; 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; @@ -46,12 +46,12 @@ Lemma CV_ALT_step1 : Un_decreasing Un -> Un_decreasing (fun N:nat => sum_f_R0 (tg_alt Un) (2 * N)). Proof. - intros; unfold Un_decreasing in |- *; intro. + intros; unfold Un_decreasing; 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. + pattern (sum_f_R0 (tg_alt Un) (2 * n)) at 2; rewrite <- Rplus_0_r. apply Rplus_le_compat_l. - unfold tg_alt in |- *; rewrite <- H0; rewrite pow_1_odd; rewrite pow_1_even; + unfold tg_alt; 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; @@ -70,7 +70,7 @@ Lemma CV_ALT_step2 : 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. + simpl; unfold tg_alt; simpl; 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); @@ -78,10 +78,10 @@ Proof. 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 |- *; + pattern (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N))) at 2; rewrite <- Rplus_0_r. rewrite Rplus_assoc; apply Rplus_le_compat_l. - unfold tg_alt in |- *; rewrite <- H1. + unfold tg_alt; 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. @@ -102,7 +102,7 @@ Lemma CV_ALT_step3 : 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. + simpl; unfold tg_alt; simpl; 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 ]. @@ -112,10 +112,10 @@ Proof. 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 |- *; + pattern (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * x))) at 2; rewrite <- Rplus_0_r. apply Rplus_le_compat_l. - unfold tg_alt in |- *; simpl in |- *. + unfold tg_alt; simpl. 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 @@ -133,15 +133,15 @@ Lemma CV_ALT_step4 : 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 |- *. + intros; unfold has_ub; unfold bound. exists (Un 0%nat). - unfold is_upper_bound in |- *; intros; elim H1; intros. + unfold is_upper_bound; 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. + pattern (Un 0%nat) at 2; rewrite <- Rplus_0_r. apply Rplus_le_compat_l. apply CV_ALT_step3; assumption. - unfold tg_alt in |- *; simpl in |- *; ring. + unfold tg_alt; simpl; ring. apply lt_O_Sn. Qed. @@ -159,11 +159,11 @@ Proof. assert (X := growing_cv _ H2 H3). elim X; intros. exists x. - unfold Un_cv in |- *; unfold R_dist in |- *; unfold Un_cv in H1; + unfold Un_cv; unfold R_dist; 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; + | unfold Rdiv; 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. @@ -180,32 +180,32 @@ Proof. 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 Rabs_Ropp; unfold tg_alt; 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 ]. + unfold ge; apply le_trans with n. + apply le_trans with N; [ unfold N; 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. + unfold Rdiv; 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; + pattern eps at 1; 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)); + unfold N; 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)). + unfold N; apply lt_le_trans with (S (2 * N1)). apply lt_n_Sn. apply le_max_l. assumption. @@ -222,7 +222,7 @@ Theorem alternated_series : Proof. intros; apply CV_ALT. assumption. - unfold positivity_seq in |- *; apply decreasing_ineq; assumption. + unfold positivity_seq; apply decreasing_ineq; assumption. assumption. Qed. @@ -243,31 +243,31 @@ Proof. 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 Un_cv; unfold R_dist; 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. + unfold ge; 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 ]. + [ intro; elim H7; symmetry ; assumption | discriminate ]. assumption. apply le_n_Sn. - unfold Un_cv in |- *; unfold R_dist in |- *; unfold Un_cv in H1; + unfold Un_cv; unfold R_dist; 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. + unfold ge; 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 ]. + [ intro; elim H7; symmetry ; assumption | discriminate ]. assumption. Qed. @@ -279,13 +279,13 @@ Definition PI_tg (n:nat) := / INR (2 * n + 1). Lemma PI_tg_pos : forall n:nat, 0 <= PI_tg n. Proof. - intro; unfold PI_tg in |- *; left; apply Rinv_0_lt_compat; apply lt_INR_0; + intro; unfold PI_tg; 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. Proof. - unfold PI_tg, Un_decreasing in |- *; intro. + unfold PI_tg, Un_decreasing; 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 ]. @@ -306,7 +306,7 @@ Qed. Lemma PI_tg_cv : Un_cv PI_tg 0. Proof. - unfold Un_cv in |- *; unfold R_dist in |- *; intros. + unfold Un_cv; unfold R_dist; intros. cut (0 < 2 * eps); [ intro | apply Rmult_lt_0_compat; [ prove_sup0 | assumption ] ]. assert (H1 := archimed (/ (2 * eps))). @@ -316,9 +316,9 @@ Proof. cut (0 < N)%nat. intro; exists N; intros. cut (0 < n)%nat. - intro; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; + intro; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_right. - unfold PI_tg in |- *; apply Rlt_trans with (/ INR (2 * n)). + unfold PI_tg; 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 ]. @@ -337,27 +337,27 @@ Proof. [ discriminate | ring ]. replace n with (S (pred n)). apply not_O_INR; discriminate. - symmetry in |- *; apply S_pred with 0%nat. + symmetry ; 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 ]. + [ simpl; 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 ]. + [ simpl; 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. + symmetry ; 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. + symmetry ; apply S_pred with 0%nat. assumption. rewrite mult_INR. rewrite Rinv_mult_distr. @@ -374,17 +374,17 @@ Proof. 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 Rmult_1_r; replace (INR N) with (IZR (Z.of_nat N)). rewrite <- H4. elim H1; intros; assumption. - symmetry in |- *; apply INR_IZR_INZ. + symmetry ; apply INR_IZR_INZ. apply prod_neq_R0; - [ discrR | red in |- *; intro; rewrite H8 in H; elim (Rlt_irrefl _ H) ]. + [ discrR | red; intro; rewrite H8 in H; elim (Rlt_irrefl _ H) ]. apply not_O_INR. - red in |- *; intro; rewrite H8 in H5; elim (lt_irrefl _ H5). + red; 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). + red; 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 _. @@ -399,7 +399,7 @@ Proof. elim (Rlt_irrefl _ (Rlt_trans _ _ _ H7 H5)). elim (lt_n_O _ b). apply le_IZR. - simpl in |- *. + simpl. left; apply Rlt_trans with (/ (2 * eps)). apply Rinv_0_lt_compat; assumption. elim H1; intros; assumption. @@ -414,41 +414,41 @@ Proof. Qed. (** Now, PI is defined *) -Definition PI : R := 4 * (let (a,_) := exist_PI in a). +Definition Alt_PI : R := 4 * (let (a,_) := exist_PI in a). (** We can get an approximation of PI with the following inequality *) -Lemma PI_ineq : +Lemma Alt_PI_ineq : forall N:nat, - sum_f_R0 (tg_alt PI_tg) (S (2 * N)) <= PI / 4 <= + sum_f_R0 (tg_alt PI_tg) (S (2 * N)) <= Alt_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. + unfold Alt_PI; case exist_PI; intro. replace (4 * x / 4) with x. trivial. - unfold Rdiv in |- *; rewrite (Rmult_comm 4); rewrite Rmult_assoc; + unfold Rdiv; rewrite (Rmult_comm 4); rewrite Rmult_assoc; rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r; reflexivity | discrR ]. Qed. -Lemma PI_RGT_0 : 0 < PI. +Lemma Alt_PI_RGT_0 : 0 < Alt_PI. Proof. - assert (H := PI_ineq 0). + assert (H := Alt_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; + simpl; unfold tg_alt; simpl; 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. + [ unfold PI_tg | ring ]. + simpl; 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; + rewrite Rplus_comm; pattern 1 at 1; 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 620561dc..c817bdfa 100644 --- a/theories/Reals/ArithProp.v +++ b/theories/Reals/ArithProp.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -12,12 +12,12 @@ Require Import Even. Require Import Div2. Require Import ArithRing. -Open Local Scope Z_scope. -Open Local Scope R_scope. +Local Open Scope Z_scope. +Local Open Scope R_scope. Lemma minus_neq_O : forall n i:nat, (i < n)%nat -> (n - i)%nat <> 0%nat. Proof. - intros; red in |- *; intro. + intros; red; 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). @@ -27,11 +27,11 @@ Proof. 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); + unfold R; intros; inversion H2; reflexivity. + unfold R; intros; simpl in H3; assumption. + unfold R; 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. + unfold R; intros; apply H1; assumption. Qed. Lemma le_minusni_n : forall n i:nat, (i <= n)%nat -> (n - i <= n)%nat. @@ -41,20 +41,20 @@ Proof. ((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. + unfold R; intros; simpl; apply le_n. + unfold R; intros; simpl; apply le_n. + unfold R; intros; simpl; apply le_trans with n. apply H0; apply le_S_n; assumption. apply le_n_Sn. - unfold R in |- *; intros; apply H; assumption. + unfold R; intros; apply H; assumption. Qed. Lemma lt_minus_O_lt : forall m n:nat, (m < n)%nat -> (0 < n - m)%nat. Proof. - intros n m; pattern n, m in |- *; apply nat_double_ind; + intros n m; pattern n, m; 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 ]. + | intros; simpl; apply H; apply lt_S_n; assumption ]. Qed. Lemma even_odd_cor : @@ -73,7 +73,7 @@ Proof. apply H3; assumption. right. apply H4; assumption. - unfold double in |- *;ring. + unfold double;ring. Qed. (* 2m <= 2n => m<=n *) @@ -105,9 +105,9 @@ Proof. 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 |- *. + unfold k0; case (Rcase_abs y); intro. + assert (H0 := archimed (x / - y)); rewrite <- Z_R_minus; simpl; + unfold Rminus. replace (- ((1 + - IZR (up (x / - y))) * y)) with ((IZR (up (x / - y)) - 1) * y); [ idtac | ring ]. split. @@ -118,7 +118,7 @@ Proof. 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 Rplus_0_r; unfold Rdiv; pattern (/ - y) at 4; rewrite <- Ropp_inv_permute; [ idtac | assumption ]. replace (IZR (up (x * / - y)) - x * - / y + @@ -138,11 +138,11 @@ Proof. 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. + unfold Rdiv; intros H1 _; exact H1. apply Ropp_neq_0_compat; assumption. - assert (H0 := archimed (x / y)); rewrite <- Z_R_minus; simpl in |- *; + assert (H0 := archimed (x / y)); rewrite <- Z_R_minus; simpl; cut (0 < y). - intro; unfold Rminus in |- *; + intro; unfold Rminus; replace (- ((IZR (up (x / y)) + -1) * y)) with ((1 - IZR (up (x / y))) * y); [ idtac | ring ]. split. @@ -152,7 +152,7 @@ Proof. 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 |- *; + rewrite Rplus_0_r; unfold Rdiv; 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; @@ -166,12 +166,12 @@ Proof. 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 |- *; + (x * / y); [ idtac | ring ]; elim H0; unfold Rdiv; intros H2 _; exact H2. case (total_order_T 0 y); intro. elim s; intro. assumption. - elim H; symmetry in |- *; exact b. + elim H; symmetry ; exact b. assert (H1 := Rge_le _ _ r); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 r0)). Qed. diff --git a/theories/Reals/Binomial.v b/theories/Reals/Binomial.v index 412f6442..ad076c48 100644 --- a/theories/Reals/Binomial.v +++ b/theories/Reals/Binomial.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -9,14 +9,14 @@ Require Import Rbase. Require Import Rfunctions. Require Import PartSum. -Open Local Scope R_scope. +Local Open Scope R_scope. 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). Proof. - intros; unfold C in |- *; replace (n - (n - i))%nat with i. + intros; unfold C; replace (n - (n - i))%nat with i. rewrite Rmult_comm. reflexivity. apply plus_minus; rewrite plus_comm; apply le_plus_minus; assumption. @@ -26,10 +26,10 @@ Lemma pascal_step2 : 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)). + intros; unfold C; 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. + unfold Rdiv; repeat rewrite mult_INR; repeat rewrite Rinv_mult_distr. ring. apply INR_fact_neq_0. apply INR_fact_neq_0. @@ -46,13 +46,13 @@ Qed. Lemma pascal_step3 : 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 |- *. + intros; unfold C. 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; + pattern (n - i)%nat at 2; rewrite H1. + repeat rewrite H0; unfold Rdiv; 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))); @@ -68,7 +68,7 @@ Proof. 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. + simpl; reflexivity. apply lt_le_S; assumption. intro; reflexivity. Qed. @@ -95,13 +95,13 @@ Proof. rewrite <- minus_Sn_m. cut ((n - (n - i))%nat = i). intro; rewrite H0; reflexivity. - symmetry in |- *; apply plus_minus. + symmetry ; 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 |- *. + unfold Rdiv. repeat rewrite S_INR. rewrite minus_INR. cut (INR i + 1 <> 0). @@ -125,18 +125,18 @@ Lemma binomial : (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 |- *; + unfold C; simpl; unfold Rdiv; repeat rewrite Rmult_1_r; rewrite Rinv_1; ring. - pattern (S n) at 1 in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ]. + pattern (S n) at 1; 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 ]. + replace ((x + y) ^ 1) with (x + y); [ idtac | simpl; 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 ]. + replace (y ^ 0) with 1; [ rewrite Rmult_1_r | simpl; reflexivity ]. induction n as [| n Hrecn0]. - simpl in |- *; do 2 rewrite H; ring. + simpl; do 2 rewrite H; ring. (* N >= 1 *) set (N := S n). rewrite Rmult_plus_distr_l. @@ -158,7 +158,7 @@ Proof. rewrite (Rplus_comm (sum_f_R0 An n)). repeat rewrite Rplus_assoc. rewrite <- tech5. - fold N in |- *. + fold N. 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). @@ -166,42 +166,42 @@ Proof. 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. + unfold N; simpl; reflexivity. + unfold N; apply lt_O_Sn. + unfold Cn; rewrite H; simpl; 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 |- *. + unfold N; apply le_lt_trans with n; [ assumption | apply lt_n_Sn ]. + intros; unfold Bn, Cn. 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. + unfold An; fold N; rewrite <- minus_n_n; rewrite H0; + simpl; ring. apply sum_eq. - intros; unfold An, Bn in |- *; replace (S N - S i)%nat with (N - i)%nat; + intros; unfold An, Bn; 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. + | apply le_lt_trans with n; [ assumption | unfold N; apply lt_n_Sn ] ]. + unfold N; reflexivity. + unfold N; 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 ]; + rewrite pow_add; replace (y ^ 1) with y; [ idtac | simpl; 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 ]; + replace (x ^ 1) with x; [ idtac | simpl; ring ]; ring. - intro; unfold C in |- *. + intro; unfold C. 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; + rewrite Rmult_1_l; unfold Rdiv; rewrite <- Rinv_r_sym; [ reflexivity | apply INR_fact_neq_0 ]. - intro; unfold C in |- *. + intro; unfold C. 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; + rewrite Rmult_1_r; unfold Rdiv; 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 a9d5cde3..f6a48adc 100644 --- a/theories/Reals/Cauchy_prod.v +++ b/theories/Reals/Cauchy_prod.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -10,7 +10,7 @@ Require Import Rbase. Require Import Rfunctions. Require Import Rseries. Require Import PartSum. -Open Local Scope R_scope. +Local Open Scope R_scope. (**********) Lemma sum_N_predN : @@ -21,7 +21,7 @@ Proof. replace N with (S (pred N)). rewrite tech5. reflexivity. - symmetry in |- *; apply S_pred with 0%nat; assumption. + symmetry ; apply S_pred with 0%nat; assumption. Qed. (**********) @@ -51,7 +51,7 @@ Proof. elim (lt_irrefl _ H). cut (N = 0%nat \/ (0 < N)%nat). intro; elim H0; intro. - rewrite H1; simpl in |- *; ring. + rewrite H1; simpl; 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). @@ -66,7 +66,7 @@ Proof. 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. + rewrite H3; simpl; ring. replace (sum_f_R0 (fun k:nat => @@ -147,7 +147,7 @@ Proof. (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. + simpl; 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))). @@ -161,11 +161,11 @@ Proof. 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)). + pattern N at 1; 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. + symmetry ; 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) @@ -259,7 +259,7 @@ Proof. 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. + simpl; 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. @@ -274,7 +274,7 @@ Proof. apply le_trans with (pred (pred N)). assumption. apply le_pred_n. - symmetry in |- *; apply S_pred with 0%nat; assumption. + symmetry ; 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. @@ -427,7 +427,7 @@ Proof. apply le_trans with (pred (pred N)). assumption. apply le_pred_n. - symmetry in |- *; apply S_pred with 0%nat; assumption. + symmetry ; 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. @@ -441,11 +441,11 @@ Proof. inversion H1. left; reflexivity. right; apply le_n_S; assumption. - simpl in |- *. + simpl. replace (S (pred N)) with N. reflexivity. apply S_pred with 0%nat; assumption. - simpl in |- *. + simpl. cut ((N - pred N)%nat = 1%nat). intro; rewrite H2; reflexivity. rewrite pred_of_minus. @@ -453,7 +453,7 @@ Proof. 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. + simpl; symmetry ; 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 ]. diff --git a/theories/Reals/Cos_plus.v b/theories/Reals/Cos_plus.v index ec1eeddf..c296d427 100644 --- a/theories/Reals/Cos_plus.v +++ b/theories/Reals/Cos_plus.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -12,8 +12,8 @@ Require Import SeqSeries. Require Import Rtrigo_def. Require Import Cos_rel. Require Import Max. -Open Local Scope nat_scope. -Open Local Scope R_scope. +Local Open Scope nat_scope. +Local Open Scope R_scope. Definition Majxy (x y:R) (n:nat) : R := Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S n) / INR (fact n). @@ -29,23 +29,23 @@ Proof. 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. + unfold Un_cv; unfold R_dist; intros. cut (0 < eps / C0); [ intro - | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + | unfold Rdiv; 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 |- *. + simpl. 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). + red; intro; rewrite H6 in H0; elim (Rlt_irrefl _ H0). rewrite <- Rabs_mult. - unfold Rminus in |- *; rewrite Rmult_plus_distr_l. + unfold Rminus; rewrite Rmult_plus_distr_l. rewrite Ropp_0; rewrite Rmult_0_r. - unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc. + unfold Rdiv; repeat rewrite <- Rmult_assoc. rewrite <- Rinv_l_sym. rewrite Rmult_1_l. rewrite (Rabs_right (/ C0)). @@ -54,15 +54,15 @@ Proof. [ 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 |- *. + red; intro; rewrite H6 in H0; elim (Rlt_irrefl _ H0). + unfold Majxy. + unfold C0. rewrite pow_mult. - unfold C in |- *; reflexivity. - unfold C0 in |- *; apply pow_lt; assumption. + unfold C; reflexivity. + unfold C0; apply pow_lt; assumption. apply Rlt_le_trans with 1. apply Rlt_0_1. - unfold C in |- *. + unfold C. apply RmaxLess1. Qed. @@ -72,7 +72,7 @@ Lemma reste1_maj : Proof. intros. set (C := Rmax 1 (Rmax (Rabs x) (Rabs y))). - unfold Reste1 in |- *. + unfold Reste1. apply Rle_trans with (sum_f_R0 (fun k:nat => @@ -120,7 +120,7 @@ Proof. 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. + unfold Rdiv; 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))))). @@ -142,7 +142,7 @@ Proof. apply pow_incr. split. apply Rabs_pos. - unfold C in |- *. + unfold C. 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)))). @@ -150,11 +150,11 @@ Proof. apply pow_le. apply Rle_trans with 1. left; apply Rlt_0_1. - unfold C in |- *; apply RmaxLess1. + unfold C; apply RmaxLess1. apply pow_incr. split. apply Rabs_pos. - unfold C in |- *; apply Rle_trans with (Rmax (Rabs x) (Rabs y)). + unfold C; apply Rle_trans with (Rmax (Rabs x) (Rabs y)). apply RmaxLess1. apply RmaxLess2. right. @@ -203,7 +203,7 @@ Proof. 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. + unfold C; 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)). @@ -223,33 +223,33 @@ Proof. apply pow_le. left; apply Rlt_le_trans with 1. apply Rlt_0_1. - unfold C in |- *; apply RmaxLess1. + unfold C; 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 |- *; + unfold Rdiv; 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. + unfold Rdiv; rewrite Rmult_comm. + unfold Binomial.C. + unfold Rdiv; 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. + unfold Rsqr; 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. + unfold Rdiv; rewrite Rmult_comm. + unfold Binomial.C. + unfold Rdiv; 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. @@ -271,17 +271,17 @@ Proof. apply pow_le. left; apply Rlt_le_trans with 1. apply Rlt_0_1. - unfold C in |- *; apply RmaxLess1. + unfold C; 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. + rewrite Rmult_comm; unfold Rdiv; 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 |- *. + pattern (/ INR (fact (S (N + n)))) at 2; rewrite <- Rmult_1_r. + unfold Rsqr. 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)))). @@ -313,14 +313,14 @@ Proof. 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. + unfold Rdiv; 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. + unfold C; apply RmaxLess1. cut (S (pred N) = N). intro; rewrite H0. - pattern N at 2 in |- *; rewrite <- H0. + pattern N at 2; rewrite <- H0. do 2 rewrite fact_simpl. rewrite H0. repeat rewrite mult_INR. @@ -329,7 +329,7 @@ Proof. repeat rewrite <- Rmult_assoc. rewrite <- Rinv_r_sym. rewrite Rmult_1_l. - pattern (/ INR (fact (pred N))) at 2 in |- *; rewrite <- Rmult_1_r. + pattern (/ INR (fact (pred N))) at 2; rewrite <- Rmult_1_r. rewrite Rmult_assoc. apply Rmult_le_compat_l. left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. @@ -340,19 +340,19 @@ Proof. 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). + red; intro; rewrite H1 in H; elim (lt_irrefl _ H). apply not_O_INR. - red in |- *; intro; rewrite H1 in H; elim (lt_irrefl _ H). + red; 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). + red; intro; rewrite H1 in H; elim (lt_irrefl _ H). apply INR_fact_neq_0. - symmetry in |- *; apply S_pred with 0%nat; assumption. + symmetry ; apply S_pred with 0%nat; assumption. right. - unfold Majxy in |- *. - unfold C in |- *. + unfold Majxy. + unfold C. replace (S (pred N)) with N. reflexivity. apply S_pred with 0%nat; assumption. @@ -363,7 +363,7 @@ Lemma reste2_maj : Proof. intros. set (C := Rmax 1 (Rmax (Rabs x) (Rabs y))). - unfold Reste2 in |- *. + unfold Reste2. apply Rle_trans with (sum_f_R0 (fun k:nat => @@ -415,7 +415,7 @@ Proof. pred N)). apply sum_Rle; intros. apply sum_Rle; intros. - unfold Rdiv in |- *; repeat rewrite Rabs_mult. + unfold Rdiv; 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)))). @@ -437,7 +437,7 @@ Proof. apply pow_incr. split. apply Rabs_pos. - unfold C in |- *. + unfold C. 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))). @@ -445,11 +445,11 @@ Proof. apply pow_le. apply Rle_trans with 1. left; apply Rlt_0_1. - unfold C in |- *; apply RmaxLess1. + unfold C; apply RmaxLess1. apply pow_incr. split. apply Rabs_pos. - unfold C in |- *; apply Rle_trans with (Rmax (Rabs x) (Rabs y)). + unfold C; apply Rle_trans with (Rmax (Rabs x) (Rabs y)). apply RmaxLess1. apply RmaxLess2. right. @@ -477,7 +477,7 @@ Proof. 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. + unfold C; 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))). @@ -500,14 +500,14 @@ Proof. apply pow_le. left; apply Rlt_le_trans with 1. apply Rlt_0_1. - unfold C in |- *; apply RmaxLess1. + unfold C; 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 |- *; + unfold Rdiv; 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. @@ -518,21 +518,21 @@ Proof. ring. omega. right. - unfold Rdiv in |- *; rewrite Rmult_comm. - unfold Binomial.C in |- *. - unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc. + unfold Rdiv; rewrite Rmult_comm. + unfold Binomial.C. + unfold Rdiv; 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. + unfold Rsqr; 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. + unfold Rdiv; rewrite Rmult_comm. + unfold Binomial.C. + unfold Rdiv; 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 @@ -556,7 +556,7 @@ Proof. apply pow_le. left; apply Rlt_le_trans with 1. apply Rlt_0_1. - unfold C in |- *; apply RmaxLess1. + unfold C; apply RmaxLess1. apply Rle_trans with (Rsqr (/ INR (fact (S (S (N + n))))) * INR N). apply Rmult_le_compat_l. apply Rle_0_sqr. @@ -564,11 +564,11 @@ Proof. apply le_INR. omega. omega. - rewrite Rmult_comm; unfold Rdiv in |- *; apply Rmult_le_compat_l. + rewrite Rmult_comm; unfold Rdiv; 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 |- *. + pattern (/ INR (fact (S (S (N + n))))) at 2; rewrite <- Rmult_1_r. + unfold Rsqr. 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))))). @@ -599,11 +599,11 @@ Proof. 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. + unfold Rdiv; 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. + unfold C; apply RmaxLess1. cut (S (pred N) = N). intro; rewrite H0. do 2 rewrite fact_simpl. @@ -642,10 +642,10 @@ Proof. 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. + symmetry ; apply S_pred with 0%nat; assumption. right. - unfold Majxy in |- *. - unfold C in |- *. + unfold Majxy. + unfold C. reflexivity. Qed. @@ -654,10 +654,10 @@ 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. + unfold Un_cv; unfold R_dist; intros. elim (H eps H0); intros N0 H1. exists (S N0); intros. - unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r. + unfold Rminus; 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. @@ -665,8 +665,8 @@ Proof. apply lt_O_Sn. assumption. apply Rle_ge. - unfold Majxy in |- *. - unfold Rdiv in |- *; apply Rmult_le_pos. + unfold Majxy. + unfold Rdiv; apply Rmult_le_pos. apply pow_le. apply Rle_trans with 1. left; apply Rlt_0_1. @@ -674,7 +674,7 @@ Proof. 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. + unfold ge; apply le_S_n. replace (S (pred n)) with n. assumption. apply S_pred with 0%nat. @@ -686,10 +686,10 @@ 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. + unfold Un_cv; unfold R_dist; intros. elim (H eps H0); intros N0 H1. exists (S N0); intros. - unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r. + unfold Rminus; 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. @@ -697,8 +697,8 @@ Proof. apply lt_O_Sn. assumption. apply Rle_ge. - unfold Majxy in |- *. - unfold Rdiv in |- *; apply Rmult_le_pos. + unfold Majxy. + unfold Rdiv; apply Rmult_le_pos. apply pow_le. apply Rle_trans with 1. left; apply Rlt_0_1. @@ -706,7 +706,7 @@ Proof. 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). + unfold ge; apply le_trans with (S N0). apply le_n_Sn. exact H2. Qed. @@ -714,7 +714,7 @@ Qed. Lemma reste_cv_R0 : forall x y:R, Un_cv (Reste x y) 0. Proof. intros. - unfold Reste in |- *. + unfold Reste. set (An := fun n:nat => Reste2 x y n). set (Bn := fun n:nat => Reste1 x y (S n)). cut @@ -723,21 +723,21 @@ Proof. intro. apply H. apply CV_minus. - unfold An in |- *. + unfold An. replace (fun n:nat => Reste2 x y n) with (Reste2 x y). apply reste2_cv_R0. reflexivity. - unfold Bn in |- *. + unfold Bn. 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. + unfold Un_cv; unfold R_dist; intros. elim (H0 eps H1); intros N0 H2. exists N0; intros. apply H2. - unfold ge in |- *; apply le_trans with (S N0). + unfold ge; apply le_trans with (S N0). apply le_n_Sn. apply le_n_S; assumption. - unfold An, Bn in |- *. + unfold An, Bn. intro. replace 0 with (0 - 0); [ idtac | ring ]. exact H. @@ -751,7 +751,7 @@ Proof. intros. apply UL_sequence with (C1 x y); assumption. apply C1_cvg. - unfold Un_cv in |- *; unfold R_dist in |- *. + unfold Un_cv; unfold R_dist. intros. assert (H0 := A1_cvg x). assert (H1 := A1_cvg y). @@ -764,7 +764,7 @@ Proof. 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; + | unfold Rdiv; 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. @@ -788,8 +788,8 @@ Proof. 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 |- *. + unfold ge; apply le_trans with N. + unfold N. apply le_trans with (max N1 N2). apply le_max_l. apply le_trans with (max (max N1 N2) N3). @@ -804,12 +804,12 @@ Proof. rewrite <- Rabs_Ropp. rewrite Ropp_minus_distr. apply H9. - unfold ge in |- *; apply le_trans with (max N1 N2). + unfold ge; 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 |- *. + unfold N. apply le_n_S. apply le_trans with (max (max N1 N2) N3). apply le_max_l. @@ -817,35 +817,35 @@ Proof. assumption. replace (Reste x y (pred n)) with (Reste x y (pred n) - 0). apply H10. - unfold ge in |- *. + unfold ge. apply le_S_n. rewrite <- H12. apply le_trans with N. - unfold N in |- *. + unfold N. 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)). + pattern eps at 4; replace eps with (3 * (eps / 3)). ring. - unfold Rdiv in |- *. + unfold Rdiv. 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. + unfold N; simpl; apply lt_O_Sn. apply le_S_n. rewrite <- H12. replace (S (pred N)) with N. assumption. - unfold N in |- *; simpl in |- *; reflexivity. + unfold N; simpl; 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. + unfold N; apply lt_O_Sn. Qed. diff --git a/theories/Reals/Cos_rel.v b/theories/Reals/Cos_rel.v index 73f3c0c6..9c7472fe 100644 --- a/theories/Reals/Cos_rel.v +++ b/theories/Reals/Cos_rel.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -10,7 +10,7 @@ Require Import Rbase. Require Import Rfunctions. Require Import SeqSeries. Require Import Rtrigo_def. -Open Local Scope R_scope. +Local Open Scope R_scope. Definition A1 (x:R) (N:nat) : R := sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * x ^ (2 * k)) N. @@ -50,7 +50,7 @@ Theorem cos_plus_form : (0 < n)%nat -> A1 x (S n) * A1 y (S n) - B1 x n * B1 y n + Reste x y n = C1 x y (S n). intros. -unfold A1, B1 in |- *. +unfold A1, B1. rewrite (cauchy_finite (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * x ^ (2 * k)) (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * y ^ (2 * k)) ( @@ -60,7 +60,7 @@ rewrite (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * x ^ (2 * k + 1)) (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * y ^ (2 * k + 1)) n H) . -unfold Reste in |- *. +unfold Reste. replace (sum_f_R0 (fun k:nat => @@ -119,13 +119,13 @@ replace ((-1) ^ (k - p) / INR (fact (2 * (k - p) + 1)) * y ^ (2 * (k - p) + 1))) k) n) with (sum_f_R0 sin_nnn (S n)). rewrite <- sum_plus. -unfold C1 in |- *. +unfold C1. apply sum_eq; intros. induction i as [| i Hreci]. -simpl in |- *. -unfold C in |- *; simpl in |- *. +simpl. +unfold C; simpl. field; discrR. -unfold sin_nnn in |- *. +unfold sin_nnn. rewrite <- Rmult_plus_distr_l. apply Rmult_eq_compat_l. rewrite binomial. @@ -141,13 +141,13 @@ replace (sum_f_R0 (fun l:nat => Wn (S (2 * l))) i). apply sum_decomposition. apply sum_eq; intros. -unfold Wn in |- *. +unfold Wn. apply Rmult_eq_compat_l. replace (2 * S i - S (2 * i0))%nat with (S (2 * (i - i0))). reflexivity. omega. apply sum_eq; intros. -unfold Wn in |- *. +unfold Wn. apply Rmult_eq_compat_l. replace (2 * S i - 2 * i0)%nat with (2 * (S i - i0))%nat. reflexivity. @@ -177,11 +177,11 @@ change (pred (S n)) with n. (* replace (pred (S n)) with n; [ idtac | reflexivity ]. *) apply sum_eq; intros. rewrite Rmult_comm. -unfold sin_nnn in |- *. +unfold sin_nnn. rewrite scal_sum. rewrite scal_sum. apply sum_eq; intros. -unfold Rdiv in |- *. +unfold Rdiv. (*repeat rewrite Rmult_assoc.*) (* rewrite (Rmult_comm (/ INR (fact (2 * S i)))). *) repeat rewrite <- Rmult_assoc. @@ -193,13 +193,13 @@ replace (S (2 * i0)) with (2 * i0 + 1)%nat; [ idtac | ring ]. replace (S (2 * (i - i0))) with (2 * (i - i0) + 1)%nat; [ idtac | ring ]. replace ((-1) ^ S i) with (-1 * (-1) ^ i0 * (-1) ^ (i - i0)). ring. -simpl in |- *. -pattern i at 2 in |- *; replace i with (i0 + (i - i0))%nat. +simpl. +pattern i at 2; replace i with (i0 + (i - i0))%nat. rewrite pow_add. ring. -symmetry in |- *; apply le_plus_minus; assumption. -unfold C in |- *. -unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc. +symmetry ; apply le_plus_minus; assumption. +unfold C. +unfold Rdiv; repeat rewrite <- Rmult_assoc. rewrite <- Rinv_l_sym. rewrite Rmult_1_l. rewrite Rinv_mult_distr. @@ -217,7 +217,7 @@ apply lt_O_Sn. apply sum_eq; intros. rewrite scal_sum. apply sum_eq; intros. -unfold Rdiv in |- *. +unfold Rdiv. repeat rewrite <- Rmult_assoc. rewrite <- (Rmult_comm (/ INR (fact (2 * i)))). repeat rewrite <- Rmult_assoc. @@ -225,12 +225,12 @@ replace (/ INR (fact (2 * i)) * C (2 * i) (2 * i0)) with (/ INR (fact (2 * i0)) * / INR (fact (2 * (i - i0)))). replace ((-1) ^ i) with ((-1) ^ i0 * (-1) ^ (i - i0)). ring. -pattern i at 2 in |- *; replace i with (i0 + (i - i0))%nat. +pattern i at 2; replace i with (i0 + (i - i0))%nat. rewrite pow_add. ring. -symmetry in |- *; apply le_plus_minus; assumption. -unfold C in |- *. -unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc. +symmetry ; apply le_plus_minus; assumption. +unfold C. +unfold Rdiv; repeat rewrite <- Rmult_assoc. rewrite <- Rinv_l_sym. rewrite Rmult_1_l. rewrite Rinv_mult_distr. @@ -240,12 +240,12 @@ omega. apply INR_fact_neq_0. apply INR_fact_neq_0. apply INR_fact_neq_0. -unfold Reste2 in |- *; apply sum_eq; intros. +unfold Reste2; apply sum_eq; intros. apply sum_eq; intros. -unfold Rdiv in |- *; ring. -unfold Reste1 in |- *; apply sum_eq; intros. +unfold Rdiv; ring. +unfold Reste1; apply sum_eq; intros. apply sum_eq; intros. -unfold Rdiv in |- *; ring. +unfold Rdiv; ring. apply lt_O_Sn. Qed. @@ -266,10 +266,10 @@ unfold R_dist in p. cut (cos x = x0). intro. rewrite H0. -unfold Un_cv in |- *; unfold R_dist in |- *; intros. +unfold Un_cv; unfold R_dist; intros. elim (p eps H1); intros. exists x1; intros. -unfold A1 in |- *. +unfold A1. replace (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * x ^ (2 * k)) n) with (sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i)) * (x * x) ^ i) n). @@ -279,9 +279,9 @@ intros. replace ((x * x) ^ i) with (x ^ (2 * i)). reflexivity. apply pow_sqr. -unfold cos in |- *. +unfold cos. case (exist_cos (Rsqr x)). -unfold Rsqr in |- *; intros. +unfold Rsqr; intros. unfold cos_in in p_i. unfold cos_in in c. apply uniqueness_sum with (fun i:nat => cos_n i * (x * x) ^ i); assumption. @@ -298,10 +298,10 @@ unfold R_dist in p. cut (cos (x + y) = x0). intro. rewrite H0. -unfold Un_cv in |- *; unfold R_dist in |- *; intros. +unfold Un_cv; unfold R_dist; intros. elim (p eps H1); intros. exists x1; intros. -unfold C1 in |- *. +unfold C1. replace (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * (x + y) ^ (2 * k)) n) with @@ -313,9 +313,9 @@ intros. replace (((x + y) * (x + y)) ^ i) with ((x + y) ^ (2 * i)). reflexivity. apply pow_sqr. -unfold cos in |- *. +unfold cos. case (exist_cos (Rsqr (x + y))). -unfold Rsqr in |- *; intros. +unfold Rsqr; intros. unfold cos_in in p_i. unfold cos_in in c. apply uniqueness_sum with (fun i:nat => cos_n i * ((x + y) * (x + y)) ^ i); @@ -327,17 +327,17 @@ intro. case (Req_dec x 0); intro. rewrite H. rewrite sin_0. -unfold B1 in |- *. -unfold Un_cv in |- *; unfold R_dist in |- *; intros; exists 0%nat; intros. +unfold B1. +unfold Un_cv; unfold R_dist; intros; exists 0%nat; intros. replace (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * 0 ^ (2 * k + 1)) n) with 0. -unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. +unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. induction n as [| n Hrecn]. -simpl in |- *; ring. +simpl; ring. rewrite tech5; rewrite <- Hrecn. -simpl in |- *; ring. -unfold ge in |- *; apply le_O_n. +simpl; ring. +unfold ge; apply le_O_n. assert (H0 := exist_sin (x * x)). elim H0; intros. assert (p_i := p). @@ -347,14 +347,14 @@ unfold R_dist in p. cut (sin x = x * x0). intro. rewrite H1. -unfold Un_cv in |- *; unfold R_dist in |- *; intros. +unfold Un_cv; unfold R_dist; intros. cut (0 < eps / Rabs x); [ intro - | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + | unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption ] ]. elim (p (eps / Rabs x) H3); intros. exists x1; intros. -unfold B1 in |- *. +unfold B1. replace (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * x ^ (2 * k + 1)) n) with @@ -380,11 +380,11 @@ apply sum_eq. intros. rewrite pow_add. rewrite pow_sqr. -simpl in |- *. +simpl. ring. -unfold sin in |- *. +unfold sin. case (exist_sin (Rsqr x)). -unfold Rsqr in |- *; intros. +unfold Rsqr; intros. unfold sin_in in p_i. unfold sin_in in s. assert diff --git a/theories/Reals/DiscrR.v b/theories/Reals/DiscrR.v index 144de09e..1ec399d1 100644 --- a/theories/Reals/DiscrR.v +++ b/theories/Reals/DiscrR.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,7 +8,7 @@ Require Import RIneq. Require Import Omega. -Open Local Scope R_scope. +Local Open Scope R_scope. Lemma Rlt_R0_R2 : 0 < 2. change 2 with (INR 2); apply lt_INR_0; apply lt_O_Sn. @@ -21,7 +21,7 @@ intros; rewrite H; reflexivity. Qed. Lemma IZR_neq : forall z1 z2:Z, z1 <> z2 -> IZR z1 <> IZR z2. -intros; red in |- *; intro; elim H; apply eq_IZR; assumption. +intros; red; intro; elim H; apply eq_IZR; assumption. Qed. Ltac discrR := @@ -45,7 +45,7 @@ Ltac prove_sup0 := repeat (apply Rmult_lt_0_compat || apply Rplus_lt_pos; try apply Rlt_0_1 || apply Rlt_R0_R2) - | |- (?X1 > 0) => change (0 < X1) in |- *; prove_sup0 + | |- (?X1 > 0) => change (0 < X1); prove_sup0 end. Ltac omega_sup := @@ -59,7 +59,7 @@ Ltac omega_sup := Ltac prove_sup := match goal with - | |- (?X1 > ?X2) => change (X2 < X1) in |- *; prove_sup + | |- (?X1 > ?X2) => change (X2 < X1); prove_sup | |- (0 < ?X1) => prove_sup0 | |- (- ?X1 < 0) => rewrite <- Ropp_0; prove_sup | |- (- ?X1 < - ?X2) => apply Ropp_lt_gt_contravar; prove_sup diff --git a/theories/Reals/Exp_prop.v b/theories/Reals/Exp_prop.v index dd97b865..b65ab045 100644 --- a/theories/Reals/Exp_prop.v +++ b/theories/Reals/Exp_prop.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -9,23 +9,23 @@ Require Import Rbase. Require Import Rfunctions. Require Import SeqSeries. -Require Import Rtrigo. +Require Import Rtrigo1. Require Import Ranalysis1. Require Import PSeries_reg. Require Import Div2. Require Import Even. Require Import Max. -Open Local Scope nat_scope. -Open Local Scope R_scope. +Local Open Scope nat_scope. +Local Open Scope R_scope. 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). Proof. - intro; unfold exp in |- *; unfold projT1 in |- *. + intro; unfold exp; unfold projT1. case (exist_exp x); intro. - unfold exp_in, Un_cv in |- *; unfold infinite_sum, E1 in |- *; trivial. + unfold exp_in, Un_cv; unfold infinite_sum, E1; trivial. Qed. Definition Reste_E (x y:R) (N:nat) : R := @@ -41,14 +41,14 @@ 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. Proof. - intros; unfold E1 in |- *. + intros; unfold E1. rewrite cauchy_finite. - unfold Reste_E in |- *; unfold Rminus in |- *; rewrite Rplus_assoc; + unfold Reste_E; unfold Rminus; 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; + unfold C; unfold Rdiv; 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. @@ -64,27 +64,13 @@ Definition maj_Reste_E (x y:R) (N:nat) : R := (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * N) / Rsqr (INR (fact (div2 (pred N))))). -Lemma Rle_Rinv : forall x y:R, 0 < x -> 0 < y -> x <= y -> / y <= / x. -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. 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. + simpl; simpl in HrecN; rewrite HrecN; reflexivity. ring. Qed. @@ -93,7 +79,7 @@ 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. + simpl; simpl in HrecN; rewrite HrecN; reflexivity. ring. Qed. @@ -107,7 +93,7 @@ Proof. 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. + rewrite H1; simpl; apply lt_O_Sn. inversion H. right; reflexivity. left; apply lt_le_trans with 2%nat; [ apply lt_n_Sn | apply H1 ]. @@ -124,7 +110,7 @@ Proof. (fun k:nat => sum_f_R0 (fun l:nat => / Rsqr (INR (fact (div2 (S N))))) (pred (N - k))) (pred N)). - unfold Reste_E in |- *. + unfold Reste_E. apply Rle_trans with (sum_f_R0 (fun k:nat => @@ -203,25 +189,25 @@ Proof. apply Rabs_pos. apply Rle_trans with (Rmax (Rabs x) (Rabs y)). apply RmaxLess1. - unfold M in |- *; apply RmaxLess2. + unfold M; 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. + unfold M; 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. + unfold M; 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. + unfold M; 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. + symmetry ; 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. @@ -260,7 +246,7 @@ Proof. apply pow_le. apply Rle_trans with 1. left; apply Rlt_0_1. - unfold M in |- *; apply RmaxLess1. + unfold M; apply RmaxLess1. assert (H2 := even_odd_cor N). elim H2; intros N0 H3. elim H3; intro. @@ -276,9 +262,9 @@ Proof. 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. + pattern N at 1; rewrite H4. apply Rle_trans with (C N N0 / INR (fact N)). - unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ INR (fact N))). + unfold Rdiv; 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. @@ -308,7 +294,7 @@ Proof. 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 |- *. + unfold Rsqr, C, Rdiv. repeat rewrite Rinv_mult_distr. rewrite (Rmult_comm (INR (fact N))). repeat rewrite Rmult_assoc. @@ -316,7 +302,7 @@ Proof. rewrite Rmult_1_r; replace (N - N0)%nat with N0. ring. replace N with (N0 + N0)%nat. - symmetry in |- *; apply minus_plus. + symmetry ; apply minus_plus. rewrite H4. ring. apply INR_fact_neq_0. @@ -324,7 +310,7 @@ Proof. apply INR_fact_neq_0. apply INR_fact_neq_0. apply INR_fact_neq_0. - unfold C, Rdiv in |- *. + unfold C, Rdiv. rewrite (Rmult_comm (INR (fact N))). repeat rewrite Rmult_assoc. rewrite <- Rinv_r_sym. @@ -336,7 +322,7 @@ Proof. 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)))). + unfold Rdiv; 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). @@ -371,7 +357,7 @@ Proof. 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 |- *. + unfold Rsqr, C, Rdiv. repeat rewrite Rinv_mult_distr. replace (S N - S N0)%nat with (S N0). rewrite (Rmult_comm (INR (fact (S N)))). @@ -380,14 +366,14 @@ Proof. rewrite Rmult_1_r; reflexivity. apply INR_fact_neq_0. replace (S N) with (S N0 + S N0)%nat. - symmetry in |- *; apply minus_plus. + symmetry ; 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. - unfold C, Rdiv in |- *. + unfold C, Rdiv. rewrite (Rmult_comm (INR (fact (S N)))). rewrite Rmult_assoc; rewrite <- Rinv_r_sym. rewrite Rmult_1_r; rewrite Rinv_mult_distr. @@ -395,8 +381,8 @@ Proof. 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). + unfold maj_Reste_E. + unfold Rdiv; rewrite (Rmult_comm 4). rewrite Rmult_assoc. apply Rmult_le_compat_l. apply pow_le. @@ -447,7 +433,7 @@ Proof. 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. + apply not_O_INR; red; intro. cut (1 < S N)%nat. intro; assert (H4 := div2_not_R0 _ H3). rewrite H2 in H4; elim (lt_n_O _ H4). @@ -470,17 +456,17 @@ Proof. 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; + intro; unfold Rsqr; 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. + pattern N at 2; rewrite H3. rewrite div2_S_double. right; rewrite H3; reflexivity. - pattern N at 2 in |- *; rewrite H3. + pattern N at 2; rewrite H3. replace (S (S (2 * N0))) with (2 * S N0)%nat. rewrite div2_double. rewrite H3. @@ -489,12 +475,12 @@ Proof. 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; + simpl. + pattern 1 at 1; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; apply Rlt_0_1. 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. + unfold Rsqr; apply prod_neq_R0; apply INR_fact_neq_0. + unfold Rsqr; apply prod_neq_R0; apply not_O_INR; discriminate. assert (H0 := even_odd_cor N). elim H0; intros N0 H1. elim H1; intro. @@ -520,15 +506,15 @@ Qed. Lemma maj_Reste_cv_R0 : forall x y:R, Un_cv (maj_Reste_E x y) 0. Proof. intros; assert (H := Majxy_cv_R0 x y). - unfold Un_cv in H; unfold Un_cv in |- *; intros. + unfold Un_cv in H; unfold Un_cv; intros. cut (0 < eps / 4); [ intro - | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + | unfold Rdiv; 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 |- *. + unfold R_dist in H2; unfold R_dist; rewrite Rminus_0_r; + unfold Majxy in H2; unfold maj_Reste_E. rewrite Rabs_right. apply Rle_lt_trans with (4 * @@ -536,7 +522,7 @@ Proof. INR (fact (div2 (pred n))))). apply Rmult_le_compat_l. left; prove_sup0. - unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr. + unfold Rdiv, Rsqr; 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))))) @@ -544,7 +530,7 @@ Proof. 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 |- *; + pattern (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n)) at 2; rewrite <- Rmult_1_r; apply Rmult_le_compat_l. apply pow_le; apply Rle_trans with 1. left; apply Rlt_0_1. @@ -598,11 +584,11 @@ Proof. (Rabs (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n))) / INR (fact (div2 (pred n))) - 0)). - apply H2; unfold ge in |- *. + apply H2; unfold ge. 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. + simpl; prove_sup0. do 2 rewrite <- mult_INR; apply le_INR. apply le_trans with n. apply H4. @@ -620,12 +606,12 @@ Proof. 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)). + pattern N1 at 2; replace N1 with (S (pred N1)). ring. - symmetry in |- *; apply S_pred with 0%nat; apply H8. + symmetry ; apply S_pred with 0%nat; apply H8. apply INR_lt. apply Rmult_lt_reg_l with (INR 2). - simpl in |- *; prove_sup0. + simpl; prove_sup0. rewrite Rmult_0_r; rewrite <- mult_INR. apply lt_INR_0. rewrite <- H7. @@ -646,7 +632,7 @@ Proof. apply H3. rewrite Rminus_0_r; apply Rabs_right. apply Rle_ge. - unfold Rdiv in |- *; apply Rmult_le_pos. + unfold Rdiv; apply Rmult_le_pos. apply pow_le. apply Rle_trans with 1. left; apply Rlt_0_1. @@ -654,7 +640,7 @@ Proof. left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. discrR. apply Rle_ge. - unfold Rdiv in |- *; apply Rmult_le_pos. + unfold Rdiv; apply Rmult_le_pos. left; prove_sup0. apply Rmult_le_pos. apply pow_le. @@ -668,9 +654,9 @@ Qed. Lemma Reste_E_cv : forall x y:R, Un_cv (Reste_E x y) 0. Proof. intros; assert (H := maj_Reste_cv_R0 x y). - unfold Un_cv in H; unfold Un_cv in |- *; intros; elim (H _ H0); intros. + unfold Un_cv in H; unfold Un_cv; intros; elim (H _ H0); intros. exists (max x0 1); intros. - unfold R_dist in |- *; rewrite Rminus_0_r. + unfold R_dist; 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. @@ -680,10 +666,10 @@ Proof. 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). + unfold ge; apply le_trans with (max x0 1). apply le_max_l. apply H2. - unfold R_dist in |- *; rewrite Rminus_0_r; apply Rabs_right. + unfold R_dist; 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. @@ -704,13 +690,13 @@ Proof. 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. + unfold Un_cv; 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). + unfold ge; apply le_trans with (S x0). apply le_n_Sn. apply H6. apply lt_le_trans with (S x0). @@ -724,15 +710,15 @@ 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; + unfold An; simpl; 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. + intro; unfold An; 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 infinite_sum, Un_cv in |- *; trivial. + unfold exp; unfold projT1; case (exist_exp x); intro. + unfold exp_in; unfold infinite_sum, Un_cv; trivial. Qed. (**********) @@ -743,12 +729,12 @@ Proof. 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. + unfold Rdiv; 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)). + intro; unfold Rdiv; 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. @@ -756,7 +742,7 @@ Proof. 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. + red; intro; rewrite H0 in H. rewrite Rmult_0_r in H. elim R1_neq_R0; assumption. Qed. @@ -764,7 +750,7 @@ Qed. (* ((exp h)-1)/h -> 0 quand h->0 *) Lemma derivable_pt_lim_exp_0 : derivable_pt_lim exp 0 1. Proof. - unfold derivable_pt_lim in |- *; intros. + unfold derivable_pt_lim; intros. set (fn := fun (N:nat) (x:R) => x ^ N / INR (fact (S N))). cut (CVN_R fn). intro; cut (forall x:R, { l:R | Un_cv (fun N:nat => SP fn N x) l }). @@ -782,41 +768,41 @@ Proof. replace 1 with (SFL fn cv 0). apply H5. split. - unfold D_x, no_cond in |- *; split. + unfold D_x, no_cond; split. trivial. - apply (sym_not_eq H6). + apply (not_eq_sym H6). rewrite Rminus_0_r; apply H7. - unfold SFL in |- *. + unfold SFL. case (cv 0); intros. eapply UL_sequence. apply u. - unfold Un_cv, SP in |- *. + unfold Un_cv, SP. intros; exists 1%nat; intros. - unfold R_dist in |- *; rewrite decomp_sum. + unfold R_dist; 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; + unfold Rminus; 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. + symmetry ; apply sum_eq_R0; intros. + unfold fn. + simpl. + unfold Rdiv; do 2 rewrite Rmult_0_l; reflexivity. + unfold fn; simpl. + unfold Rdiv; 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 SFL, exp. case (cv h); case (exist_exp h); simpl; intros. eapply UL_sequence. apply u. - unfold Un_cv in |- *; intros. + unfold Un_cv; intros. unfold exp_in in e. unfold infinite_sum in e. cut (0 < eps0 * Rabs h). intro; elim (e _ H9); intros N0 H10. exists N0; intros. - unfold R_dist in |- *. + unfold R_dist. apply Rmult_lt_reg_l with (Rabs h). apply Rabs_pos_lt; assumption. rewrite <- Rabs_mult. @@ -827,47 +813,47 @@ Proof. (sum_f_R0 (fun i:nat => / INR (fact i) * h ^ i) (S n) - x). rewrite (Rmult_comm (Rabs h)). apply H10. - unfold ge in |- *. + unfold ge. 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 |- *. + unfold Rminus. 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 |- *. + unfold SP. rewrite scal_sum. apply sum_eq; intros. - unfold fn in |- *. + unfold fn. 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. + unfold Rdiv; ring. + simpl; ring. + simpl; rewrite Rinv_1; rewrite Rmult_1_r; reflexivity. apply lt_O_Sn. - unfold Rdiv in |- *. + unfold Rdiv. rewrite <- Rmult_assoc. - symmetry in |- *; apply Rinv_r_simpl_m. + symmetry ; 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 |- *. + intro; unfold fn. 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. + intro; unfold fct_cte; apply INR_fact_neq_0. apply (CVN_R_CVS _ X). assert (H0 := Alembert_exp). - unfold CVN_R in |- *. - intro; unfold CVN_r in |- *. + unfold CVN_R. + intro; unfold CVN_r. exists (fun N:nat => r ^ N / INR (fact (S N))). cut { l:R | @@ -879,10 +865,10 @@ Proof. exists x; intros. split. apply p. - unfold Boule in |- *; intros. + unfold Boule; intros. rewrite Rminus_0_r in H1. - unfold fn in |- *. - unfold Rdiv in |- *; rewrite Rabs_mult. + unfold fn. + unfold Rdiv; rewrite Rabs_mult. cut (0 < INR (fact (S n))). intro. rewrite (Rabs_right (/ INR (fact (S n)))). @@ -897,14 +883,14 @@ Proof. cut ((r:R) <> 0). intro; apply Alembert_C2. intro; apply Rabs_no_R0. - unfold Rdiv in |- *; apply prod_neq_R0. + unfold Rdiv; 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. + unfold Un_cv; intros. cut (0 < eps0 / r); [ intro - | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + | unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; apply (cond_pos r) ] ]. elim (H0 _ H3); intros N0 H4. exists N0; intros. @@ -913,7 +899,7 @@ Proof. 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. + unfold R_dist; rewrite Rminus_0_r. rewrite Rabs_Rabsolu. replace (Rabs (r ^ S n / INR (fact (S (S n)))) / Rabs (r ^ n / INR (fact (S n)))) @@ -927,7 +913,7 @@ Proof. apply H6. assumption. apply Rle_ge; left; apply (cond_pos r). - unfold Rdiv in |- *. + unfold Rdiv. repeat rewrite Rabs_mult. repeat rewrite Rabs_Rinv. rewrite Rinv_mult_distr. @@ -940,7 +926,7 @@ Proof. rewrite (Rmult_comm r). rewrite <- Rmult_assoc; rewrite <- (Rmult_comm (INR (fact (S n)))). apply Rmult_eq_compat_l. - simpl in |- *. + simpl. rewrite Rmult_assoc; rewrite <- Rinv_r_sym. ring. apply pow_nonzero; assumption. @@ -953,10 +939,10 @@ Proof. 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. + unfold ge; apply le_trans with n. apply H5. apply le_n_Sn. - assert (H1 := cond_pos r); red in |- *; intro; rewrite H2 in H1; + assert (H1 := cond_pos r); red; intro; rewrite H2 in H1; elim (Rlt_irrefl _ H1). Qed. @@ -964,10 +950,10 @@ Qed. Lemma derivable_pt_lim_exp : forall x:R, derivable_pt_lim exp x (exp x). Proof. intro; assert (H0 := derivable_pt_lim_exp_0). - unfold derivable_pt_lim in H0; unfold derivable_pt_lim in |- *; intros. + unfold derivable_pt_lim in H0; unfold derivable_pt_lim; intros. cut (0 < eps / exp x); [ intro - | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + | unfold Rdiv; apply Rmult_lt_0_compat; [ apply H | apply Rinv_0_lt_compat; apply exp_pos ] ]. elim (H0 _ H1); intros del H2. exists del; intros. @@ -981,11 +967,11 @@ Proof. 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; + assert (H6 := exp_pos x); red; 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_1_r; unfold Rdiv; rewrite <- Rmult_assoc; rewrite Rmult_minus_distr_l. rewrite Rmult_1_r; rewrite exp_plus; reflexivity. Qed. diff --git a/theories/Reals/Integration.v b/theories/Reals/Integration.v index da1742ca..d7b3ab04 100644 --- a/theories/Reals/Integration.v +++ b/theories/Reals/Integration.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/LegacyRfield.v b/theories/Reals/LegacyRfield.v index 49a94021..c45d1c5f 100644 --- a/theories/Reals/LegacyRfield.v +++ b/theories/Reals/LegacyRfield.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -17,9 +17,9 @@ 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. + symmetry ; apply Rplus_assoc. exact Rmult_comm. - symmetry in |- *; apply Rmult_assoc. + symmetry ; apply Rmult_assoc. intro; apply Rplus_0_l. intro; apply Rmult_1_l. exact Rplus_opp_r. diff --git a/theories/Reals/MVT.v b/theories/Reals/MVT.v index 29ebd46d..2ee22b6d 100644 --- a/theories/Reals/MVT.v +++ b/theories/Reals/MVT.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -10,7 +10,7 @@ Require Import Rbase. Require Import Rfunctions. Require Import Ranalysis1. Require Import Rtopology. -Open Local Scope R_scope. +Local Open Scope R_scope. (* The Mean Value Theorem *) Theorem MVT : @@ -55,13 +55,13 @@ Proof. split. apply Rmult_lt_reg_l with 2. prove_sup0. - unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + unfold Rdiv; 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; + unfold Rdiv; 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. @@ -103,7 +103,7 @@ Proof. inversion H13. apply H14. rewrite H8 in H10; rewrite <- H14 in H10; elim H10; reflexivity. - intros; unfold h in |- *; + intros; unfold h; replace (derive_pt (fun y:R => (g b - g a) * f y - (f b - f a) * g y) c (X c P)) with @@ -115,11 +115,11 @@ Proof. 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 |- *; + unfold h; ring. + intros; unfold h; change (continuity_pt ((fct_cte (g b - g a) * f)%F - (fct_cte (f b - f a) * g)%F) - c) in |- *. + c). apply continuity_pt_minus; apply continuity_pt_mult. apply derivable_continuous_pt; apply derivable_const. apply H0; apply H3. @@ -128,7 +128,7 @@ Proof. intros; change (derivable_pt ((fct_cte (g b - g a) * f)%F - (fct_cte (f b - f a) * g)%F) - c) in |- *. + c). apply derivable_pt_minus; apply derivable_pt_mult. apply derivable_pt_const. apply (pr1 _ H3). @@ -178,7 +178,7 @@ Proof. 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 |- *; + rewrite Rmult_1_r in H3; rewrite Rmult_comm; symmetry ; assumption. apply derive_pt_eq_0; apply H0; elim x0; intros; split; left; assumption. apply derive_pt_eq_0; apply derivable_pt_lim_id. @@ -188,7 +188,7 @@ Proof. 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 |- *; exists (f' c); apply H0; + intros; unfold derivable_pt; exists (f' c); apply H0; apply H1. Qed. @@ -221,7 +221,7 @@ Proof. 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; + | apply Rminus_eq_contra; red; intro; rewrite H7 in H0; elim (Rlt_irrefl _ H0) ]. Qed. @@ -231,7 +231,7 @@ Lemma nonneg_derivative_1 : (forall x:R, 0 <= derive_pt f x (pr x)) -> increasing f. Proof. intros. - unfold increasing in |- *. + unfold increasing. intros. case (total_order_T x y); intro. elim s; intro. @@ -268,12 +268,12 @@ Proof. 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 |- *; + intro; unfold Rabs; 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 |- *. + (l / 2) H14); unfold Rminus. 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))). @@ -290,7 +290,7 @@ Proof. (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. + pattern l at 3; rewrite double_var. ring. intros. generalize @@ -303,22 +303,22 @@ Proof. H15)). replace (- ((f (x + delta / 2) - f x) / (delta / 2) - l)) with ((f x - f (x + delta / 2)) / (delta / 2) + l). - unfold Rminus in |- *. + unfold Rminus. apply Rplus_le_lt_0_compat. - unfold Rdiv in |- *; apply Rmult_le_pos. + unfold Rdiv; 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; + pattern x at 1; 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 |- *. + unfold Rminus. rewrite (Rplus_comm l). - unfold Rdiv in |- *. + unfold Rdiv. rewrite <- Ropp_mult_distr_l_reverse. rewrite Ropp_plus_distr. rewrite Ropp_involutive. @@ -329,38 +329,38 @@ Proof. rewrite <- Ropp_0. apply Ropp_ge_le_contravar. apply Rle_ge. - unfold Rdiv in |- *; apply Rmult_le_pos. + unfold Rdiv; 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; + pattern x at 1; 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. + unfold Rdiv; 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; + unfold Rdiv; apply prod_neq_R0. + generalize (cond_pos delta); intro; red; 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; + unfold Rdiv; 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. + unfold Rdiv; 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 Rmult_1_l; rewrite double; pattern (pos delta) at 1; 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 Rle_ge; unfold Rdiv; 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; + unfold Rdiv; apply Rmult_lt_0_compat; [ apply H4 | apply Rinv_0_lt_compat; prove_sup0 ]. Qed. @@ -368,7 +368,7 @@ Qed. Lemma increasing_decreasing_opp : forall f:R -> R, increasing f -> decreasing (- f)%F. Proof. - unfold increasing, decreasing, opp_fct in |- *; intros; generalize (H x y H0); + unfold increasing, decreasing, opp_fct; intros; generalize (H x y H0); intro; apply Ropp_ge_le_contravar; apply Rle_ge; assumption. Qed. @@ -381,8 +381,8 @@ Proof. cut (forall h:R, - - f h = f h). intro. generalize (increasing_decreasing_opp (- f)%F). - unfold decreasing in |- *. - unfold opp_fct in |- *. + unfold decreasing. + unfold opp_fct. intros. rewrite <- (H0 x); rewrite <- (H0 y). apply H1. @@ -410,7 +410,7 @@ Lemma positive_derivative : (forall x:R, 0 < derive_pt f x (pr x)) -> strict_increasing f. Proof. intros. - unfold strict_increasing in |- *. + unfold strict_increasing. intros. apply Rplus_lt_reg_r with (- f x). rewrite Rplus_opp_l; rewrite Rplus_comm. @@ -429,7 +429,7 @@ Qed. Lemma strictincreasing_strictdecreasing_opp : forall f:R -> R, strict_increasing f -> strict_decreasing (- f)%F. Proof. - unfold strict_increasing, strict_decreasing, opp_fct in |- *; intros; + unfold strict_increasing, strict_decreasing, opp_fct; intros; generalize (H x y H0); intro; apply Ropp_lt_gt_contravar; assumption. Qed. @@ -443,7 +443,7 @@ Proof. cut (forall h:R, - - f h = f h). intros. generalize (strictincreasing_strictdecreasing_opp (- f)%F). - unfold strict_decreasing, opp_fct in |- *. + unfold strict_decreasing, opp_fct. intros. rewrite <- (H0 x). rewrite <- (H0 y). @@ -470,8 +470,8 @@ 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 |- *; + intros; exists (mkposreal 1 Rlt_0_1); simpl; intros. + rewrite (H x (x + h)); unfold Rminus; unfold Rdiv; rewrite Rplus_opp_r; rewrite Rmult_0_l; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. Qed. @@ -480,13 +480,13 @@ Qed. Lemma increasing_decreasing : forall f:R -> R, increasing f -> decreasing f -> constant f. Proof. - unfold increasing, decreasing, constant in |- *; intros; + unfold increasing, decreasing, constant; 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 |- *; + generalize (Rlt_le y x H2); intro; symmetry ; apply (Rle_antisym (f y) (f x) (H y x H3) (H0 y x H3)). Qed. @@ -502,7 +502,7 @@ Proof. 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; symmetry ; apply (H x). intro; right; apply (H x). Qed. @@ -601,7 +601,7 @@ Proof. elim H4; intros. split; left; assumption. rewrite b0. - unfold Rminus in |- *; do 2 rewrite Rplus_opp_r. + unfold Rminus; do 2 rewrite Rplus_opp_r. rewrite Rmult_0_r; right; reflexivity. elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). Qed. @@ -648,7 +648,7 @@ Lemma null_derivative_loc : (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. + intros; unfold constant_D_eq; 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. @@ -674,7 +674,7 @@ Proof. 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 |- *; + rewrite Rmult_1_r in H9; apply Rminus_diag_uniq; symmetry ; assumption. rewrite H1; reflexivity. assert (H2 : x = a). @@ -691,15 +691,15 @@ Lemma antiderivative_Ucte : antiderivative f g2 a b -> exists c : R, (forall x:R, a <= x <= b -> g1 x = g2 x + c). Proof. - unfold antiderivative in |- *; intros; elim H; clear H; intros; elim H0; + unfold antiderivative; 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 |- *; exists (f x0); elim (H x0 H3); - intros; eapply derive_pt_eq_1; symmetry in |- *; + intros; unfold derivable_pt; exists (f x0); elim (H x0 H3); + intros; eapply derive_pt_eq_1; symmetry ; apply H4. assert (H4 : forall x:R, a <= x <= b -> derivable_pt g2 x). - intros; unfold derivable_pt in |- *; exists (f x0); - elim (H0 x0 H4); intros; eapply derive_pt_eq_1; symmetry in |- *; + intros; unfold derivable_pt; exists (f x0); + elim (H0 x0 H4); intros; eapply derive_pt_eq_1; symmetry ; apply H5. assert (H5 : forall x:R, a < x < b -> derivable_pt (g1 - g2) x). intros; elim H5; intros; apply derivable_pt_minus; @@ -713,7 +713,7 @@ Proof. 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. + eapply derive_pt_eq_1; symmetry ; 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. diff --git a/theories/Reals/Machin.v b/theories/Reals/Machin.v new file mode 100644 index 00000000..6b91719d --- /dev/null +++ b/theories/Reals/Machin.v @@ -0,0 +1,168 @@ +Require Import Fourier. +Require Import Rbase. +Require Import Rtrigo1. +Require Import Ranalysis_reg. +Require Import Rfunctions. +Require Import AltSeries. +Require Import Rseries. +Require Import SeqProp. +Require Import PartSum. +Require Import Ratan. + +Local Open Scope R_scope. + +(* Proving a few formulas in the style of John Machin to compute Pi *) + +Definition atan_sub u v := (u - v)/(1 + u * v). + +Lemma atan_sub_correct : + forall u v, 1 + u * v <> 0 -> -PI/2 < atan u - atan v < PI/2 -> + -PI/2 < atan (atan_sub u v) < PI/2 -> + atan u = atan v + atan (atan_sub u v). +intros u v pn0 uvint aint. +assert (cos (atan u) <> 0). + destruct (atan_bound u); apply Rgt_not_eq, cos_gt_0; auto. + rewrite <- Ropp_div; assumption. +assert (cos (atan v) <> 0). + destruct (atan_bound v); apply Rgt_not_eq, cos_gt_0; auto. + rewrite <- Ropp_div; assumption. +assert (t : forall a b c, a - b = c -> a = b + c) by (intros; subst; field). +apply t, tan_is_inj; clear t; try assumption. +rewrite tan_minus; auto. + rewrite !atan_right_inv; reflexivity. +apply Rgt_not_eq, cos_gt_0; rewrite <- ?Ropp_div; tauto. +rewrite !atan_right_inv; assumption. +Qed. + +Lemma tech : forall x y , -1 <= x <= 1 -> -1 < y < 1 -> + -PI/2 < atan x - atan y < PI/2. +assert (ut := PI_RGT_0). +intros x y [xm1 x1] [ym1 y1]. +assert (-(PI/4) <= atan x). + destruct xm1 as [xm1 | xm1]. + rewrite <- atan_1, <- atan_opp; apply Rlt_le, atan_increasing. + assumption. + solve[rewrite <- xm1, atan_opp, atan_1; apply Rle_refl]. +assert (-(PI/4) < atan y). + rewrite <- atan_1, <- atan_opp; apply atan_increasing. + assumption. +assert (atan x <= PI/4). + destruct x1 as [x1 | x1]. + rewrite <- atan_1; apply Rlt_le, atan_increasing. + assumption. + solve[rewrite x1, atan_1; apply Rle_refl]. +assert (atan y < PI/4). + rewrite <- atan_1; apply atan_increasing. + assumption. +rewrite Ropp_div; split; fourier. +Qed. + +(* A simple formula, reasonably efficient. *) +Lemma Machin_2_3 : PI/4 = atan(/2) + atan(/3). +assert (utility : 0 < PI/2) by (apply PI2_RGT_0). +rewrite <- atan_1. +rewrite (atan_sub_correct 1 (/2)). + apply f_equal, f_equal; unfold atan_sub; field. + apply Rgt_not_eq; fourier. + apply tech; try split; try fourier. +apply atan_bound. +Qed. + +Lemma Machin_4_5_239 : PI/4 = 4 * atan (/5) - atan(/239). +rewrite <- atan_1. +rewrite (atan_sub_correct 1 (/5)); + [ | apply Rgt_not_eq; fourier | apply tech; try split; fourier | + apply atan_bound ]. +replace (4 * atan (/5) - atan (/239)) with + (atan (/5) + (atan (/5) + (atan (/5) + (atan (/5) + - + atan (/239))))) by ring. +apply f_equal. +replace (atan_sub 1 (/5)) with (2/3) by + (unfold atan_sub; field). +rewrite (atan_sub_correct (2/3) (/5)); + [apply f_equal | apply Rgt_not_eq; fourier | apply tech; try split; fourier | + apply atan_bound ]. +replace (atan_sub (2/3) (/5)) with (7/17) by + (unfold atan_sub; field). +rewrite (atan_sub_correct (7/17) (/5)); + [apply f_equal | apply Rgt_not_eq; fourier | apply tech; try split; fourier | + apply atan_bound ]. +replace (atan_sub (7/17) (/5)) with (9/46) by + (unfold atan_sub; field). +rewrite (atan_sub_correct (9/46) (/5)); + [apply f_equal | apply Rgt_not_eq; fourier | apply tech; try split; fourier | + apply atan_bound ]. +rewrite <- atan_opp; apply f_equal. +unfold atan_sub; field. +Qed. + +Lemma Machin_2_3_7 : PI/4 = 2 * atan(/3) + (atan (/7)). +rewrite <- atan_1. +rewrite (atan_sub_correct 1 (/3)); + [ | apply Rgt_not_eq; fourier | apply tech; try split; fourier | + apply atan_bound ]. +replace (2 * atan (/3) + atan (/7)) with + (atan (/3) + (atan (/3) + atan (/7))) by ring. +apply f_equal. +replace (atan_sub 1 (/3)) with (/2) by + (unfold atan_sub; field). +rewrite (atan_sub_correct (/2) (/3)); + [apply f_equal | apply Rgt_not_eq; fourier | apply tech; try split; fourier | + apply atan_bound ]. +apply f_equal; unfold atan_sub; field. +Qed. + +(* More efficient way to compute approximations of PI. *) + +Definition PI_2_3_7_tg n := + 2 * Ratan_seq (/3) n + Ratan_seq (/7) n. + +Lemma PI_2_3_7_ineq : + forall N : nat, + sum_f_R0 (tg_alt PI_2_3_7_tg) (S (2 * N)) <= PI / 4 <= + sum_f_R0 (tg_alt PI_2_3_7_tg) (2 * N). +Proof. +assert (dec3 : 0 <= /3 <= 1) by (split; fourier). +assert (dec7 : 0 <= /7 <= 1) by (split; fourier). +assert (decr : Un_decreasing PI_2_3_7_tg). + apply Ratan_seq_decreasing in dec3. + apply Ratan_seq_decreasing in dec7. + intros n; apply Rplus_le_compat. + apply Rmult_le_compat_l; [ fourier | exact (dec3 n)]. + exact (dec7 n). +assert (cv : Un_cv PI_2_3_7_tg 0). + apply Ratan_seq_converging in dec3. + apply Ratan_seq_converging in dec7. + intros eps ep. + assert (ep' : 0 < eps /3) by fourier. + destruct (dec3 _ ep') as [N1 Pn1]; destruct (dec7 _ ep') as [N2 Pn2]. + exists (N1 + N2)%nat; intros n Nn. + unfold PI_2_3_7_tg. + rewrite <- (Rplus_0_l 0). + apply Rle_lt_trans with + (1 := R_dist_plus (2 * Ratan_seq (/3) n) 0 (Ratan_seq (/7) n) 0). + replace eps with (2 * eps/3 + eps/3) by field. + apply Rplus_lt_compat. + unfold R_dist, Rminus, Rdiv. + rewrite <- (Rmult_0_r 2), <- Ropp_mult_distr_r_reverse. + rewrite <- Rmult_plus_distr_l, Rabs_mult, (Rabs_pos_eq 2);[|fourier]. + rewrite Rmult_assoc; apply Rmult_lt_compat_l;[fourier | ]. + apply (Pn1 n); omega. + apply (Pn2 n); omega. +rewrite Machin_2_3_7. +rewrite !atan_eq_ps_atan; try (split; fourier). +unfold ps_atan; destruct (in_int (/3)); destruct (in_int (/7)); + try match goal with id : ~ _ |- _ => case id; split; fourier end. +destruct (ps_atan_exists_1 (/3)) as [v3 Pv3]. +destruct (ps_atan_exists_1 (/7)) as [v7 Pv7]. +assert (main : Un_cv (sum_f_R0 (tg_alt PI_2_3_7_tg)) (2 * v3 + v7)). + assert (main :Un_cv (fun n => 2 * sum_f_R0 (tg_alt (Ratan_seq (/3))) n + + sum_f_R0 (tg_alt (Ratan_seq (/7))) n) (2 * v3 + v7)). + apply CV_plus;[ | assumption]. + apply CV_mult;[ | assumption]. + exists 0%nat; intros; rewrite R_dist_eq; assumption. + apply Un_cv_ext with (2 := main). + intros n; rewrite scal_sum, <- plus_sum; apply sum_eq; intros. + rewrite Rmult_comm; unfold PI_2_3_7_tg, tg_alt; field. +intros N; apply (alternated_series_ineq _ _ _ decr cv main). +Qed. diff --git a/theories/Reals/NewtonInt.v b/theories/Reals/NewtonInt.v index a4233021..67e353ee 100644 --- a/theories/Reals/NewtonInt.v +++ b/theories/Reals/NewtonInt.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -9,9 +9,9 @@ Require Import Rbase. Require Import Rfunctions. Require Import SeqSeries. -Require Import Rtrigo. +Require Import Rtrigo1. Require Import Ranalysis. -Open Local Scope R_scope. +Local Open Scope R_scope. (*******************************************) (* Newton's Integral *) @@ -28,8 +28,8 @@ Lemma FTCN_step1 : 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 |- *; exists (d1 f); - unfold antiderivative in |- *; intros; case (Rle_dec a b); + intros f a b; unfold Newton_integrable; exists (d1 f); + unfold antiderivative; intros; case (Rle_dec a b); intro; [ left; split; [ intros; exists (cond_diff f x); reflexivity | assumption ] | right; split; @@ -42,26 +42,26 @@ Lemma FTC_Newton : 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. + intros; unfold NewtonInt; 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. Proof. - intros f a; unfold Newton_integrable in |- *; + intros f a; unfold Newton_integrable; exists (fct_cte (f a) * id)%F; left; - unfold antiderivative in |- *; split. + unfold antiderivative; 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; + symmetry ; 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 ]. + | unfold id, fct_cte; rewrite H2; ring ]. right; reflexivity. Defined. @@ -69,8 +69,8 @@ Defined. Lemma NewtonInt_P2 : 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. + intros; unfold NewtonInt; simpl; + unfold mult_fct, fct_cte, id; ring. Qed. (* If $\int_a^b f$ exists, then $\int_b^a f$ exists too *) @@ -78,7 +78,7 @@ Lemma NewtonInt_P3 : 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; + unfold Newton_integrable; intros; elim X; intros g H; exists g; tauto. Defined. @@ -88,7 +88,7 @@ Lemma NewtonInt_P4 : 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 |- *; + unfold NewtonInt; case (NewtonInt_P3 f a b (exist @@ -106,7 +106,7 @@ Proof. 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 |- *; + unfold NewtonInt; case (NewtonInt_P3 f a b (exist @@ -132,37 +132,37 @@ Lemma NewtonInt_P5 : 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; + unfold Newton_integrable; 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; + left; unfold antiderivative; 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. + exists H5; symmetry ; 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. + left; rewrite <- H5; unfold antiderivative; 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 ]. + split; right; [ symmetry ; assumption | rewrite <- H5; assumption ]. assert (H11 : b <= x1 <= a). - split; right; [ rewrite <- H5; symmetry in |- *; assumption | assumption ]. + split; right; [ rewrite <- H5; symmetry ; 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. + unfold derivable_pt; exists (f x1); elim (H3 _ H10); intros; + eapply derive_pt_eq_1; symmetry ; 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. + unfold derivable_pt; exists (g x1); elim (H1 _ H11); intros; + eapply derive_pt_eq_1; symmetry ; apply H13. assert (H14 : derivable_pt (fun y:R => l * x y + x0 y) x1). reg. - exists H14; symmetry in |- *; reg. + exists H14; symmetry ; 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). @@ -172,34 +172,34 @@ Proof. 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. + left; rewrite H5; unfold antiderivative; 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 ]. + split; right; [ symmetry ; assumption | rewrite H5; assumption ]. assert (H11 : b <= x1 <= a). - split; right; [ rewrite H5; symmetry in |- *; assumption | assumption ]. + split; right; [ rewrite H5; symmetry ; 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. + unfold derivable_pt; exists (f x1); elim (H3 _ H11); intros; + eapply derive_pt_eq_1; symmetry ; 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. + unfold derivable_pt; exists (g x1); elim (H1 _ H10); intros; + eapply derive_pt_eq_1; symmetry ; apply H13. assert (H14 : derivable_pt (fun y:R => l * x y + x0 y) x1). reg. - exists H14; symmetry in |- *; reg. + exists H14; symmetry ; 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; + right; unfold antiderivative; 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. + exists H5; symmetry ; reg; rewrite <- H3; rewrite <- H4; reflexivity. assumption. Defined. @@ -210,12 +210,12 @@ Lemma antiderivative_P1 : 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; + unfold antiderivative; 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. + exists H6; symmetry ; reg; rewrite <- H4; rewrite <- H5; ring. assumption. Qed. @@ -226,7 +226,7 @@ Lemma NewtonInt_P6 : 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 |- *; + intros f g l a b pr1 pr2; unfold NewtonInt; case (NewtonInt_P5 f g l a b pr1 pr2); intros; case pr1; intros; case pr2; intros; case (total_order_T a b); intro. @@ -277,7 +277,7 @@ Lemma antiderivative_P2 : | right _ => F1 x + (F0 b - F1 b) end) a c. Proof. - unfold antiderivative in |- *; intros; elim H; clear H; intros; elim H0; + unfold antiderivative; 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. @@ -293,25 +293,25 @@ Proof. | 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. + unfold derivable_pt_lim; assert (H7 : derive_pt F0 x x0 = f x). + symmetry ; 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. + unfold D; unfold Rmin; 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 ]. + apply Rlt_le_trans with D; [ assumption | unfold D; 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 |- *; + rewrite Rplus_0_l; rewrite Rplus_comm; unfold D; apply Rmin_r. elim n; left; assumption. assert @@ -322,16 +322,16 @@ Proof. | left _ => F0 x | right _ => F1 x + (F0 b - F1 b) end) x). - unfold derivable_pt in |- *; exists (f x); apply H7. - exists H8; symmetry in |- *; apply derive_pt_eq_0; apply H7. + unfold derivable_pt; exists (f x); apply H7. + exists H8; symmetry ; 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 ]. + split; [ right; symmetry ; assumption | assumption ]. elim (H _ H5); elim (H0 _ H6); intros; assert (H9 : derive_pt F0 x x1 = f x). - symmetry in |- *; assumption. + symmetry ; assumption. assert (H10 : derive_pt F1 x x0 = f x). - symmetry in |- *; assumption. + symmetry ; 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 @@ -342,21 +342,21 @@ Proof. | 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; + unfold derivable_pt_lim; 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. + unfold D; unfold Rmin; 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 ]. + apply Rlt_le_trans with D; [ assumption | unfold D; 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 ]. + apply Rlt_le_trans with D; [ assumption | unfold D; apply Rmin_l ]. rewrite b0; ring. elim n; right; assumption. assert @@ -367,8 +367,8 @@ Proof. | left _ => F0 x | right _ => F1 x + (F0 b - F1 b) end) x). - unfold derivable_pt in |- *; exists (f x); apply H13. - exists H14; symmetry in |- *; apply derive_pt_eq_0; apply H13. + unfold derivable_pt; exists (f x); apply H13. + exists H14; symmetry ; 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; @@ -380,12 +380,12 @@ Proof. | 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. + unfold derivable_pt_lim; assert (H7 : derive_pt F1 x x0 = f x). + symmetry ; 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. + unfold D; unfold Rmin; 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. @@ -399,13 +399,13 @@ Proof. rewrite <- Rabs_Ropp; apply RRle_abs. apply Rlt_le_trans with D. apply H13. - unfold D in |- *; apply Rmin_r. + unfold D; 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. + unfold D; apply Rmin_l. assert (H8 : derivable_pt @@ -414,8 +414,8 @@ Proof. | left _ => F0 x | right _ => F1 x + (F0 b - F1 b) end) x). - unfold derivable_pt in |- *; exists (f x); apply H7. - exists H8; symmetry in |- *; apply derive_pt_eq_0; apply H7. + unfold derivable_pt; exists (f x); apply H7. + exists H8; symmetry ; apply derive_pt_eq_0; apply H7. Qed. Lemma antiderivative_P3 : @@ -427,15 +427,15 @@ 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. + right; unfold antiderivative; split. intros; apply H1; elim H3; intros; split; [ assumption | apply Rle_trans with c; assumption ]. left; assumption. - right; unfold antiderivative in |- *; split. + right; unfold antiderivative; split. intros; apply H1; elim H3; intros; split; [ assumption | apply Rle_trans with c; assumption ]. right; assumption. - left; unfold antiderivative in |- *; split. + left; unfold antiderivative; split. intros; apply H; elim H3; intros; split; [ assumption | apply Rle_trans with a; assumption ]. left; assumption. @@ -450,15 +450,15 @@ 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. + right; unfold antiderivative; split. intros; apply H1; elim H3; intros; split; [ apply Rle_trans with c; assumption | assumption ]. left; assumption. - right; unfold antiderivative in |- *; split. + right; unfold antiderivative; split. intros; apply H1; elim H3; intros; split; [ apply Rle_trans with c; assumption | assumption ]. right; assumption. - left; unfold antiderivative in |- *; split. + left; unfold antiderivative; split. intros; apply H; elim H3; intros; split; [ apply Rle_trans with b; assumption | assumption ]. left; assumption. @@ -471,7 +471,7 @@ Lemma NewtonInt_P7 : 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; + unfold Newton_integrable; 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 := @@ -479,7 +479,7 @@ Proof. match Rle_dec x b with | left _ => F0 x | right _ => F1 x + (F0 b - F1 b) - end); exists g; left; unfold g in |- *; + end); exists g; left; unfold g; apply antiderivative_P2. elim H0; intro. assumption. @@ -504,7 +504,7 @@ Proof. case (total_order_T b c); intro. elim s0; intro. (* a<b & b<c *) - unfold Newton_integrable in |- *; + unfold Newton_integrable; exists (fun x:R => match Rle_dec x b with @@ -523,7 +523,7 @@ Proof. (* a<b & b>c *) case (total_order_T a c); intro. elim s0; intro. - unfold Newton_integrable in |- *; exists F0. + unfold Newton_integrable; exists F0. left. elim H1; intro. unfold antiderivative in H; elim H; clear H; intros _ H. @@ -537,7 +537,7 @@ Proof. 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 |- *; exists F1. + unfold Newton_integrable; exists F1. right. elim H1; intro. unfold antiderivative in H; elim H; clear H; intros _ H. @@ -557,7 +557,7 @@ Proof. (* a>b & b<c *) case (total_order_T a c); intro. elim s0; intro. - unfold Newton_integrable in |- *; exists F1. + unfold Newton_integrable; exists F1. left. elim H1; intro. (*****************) @@ -572,7 +572,7 @@ Proof. 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 |- *; exists F0. + unfold Newton_integrable; exists F0. right. elim H0; intro. unfold antiderivative in H; elim H; clear H; intros _ H. @@ -601,7 +601,7 @@ Lemma NewtonInt_P9 : 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 |- *. + intros; unfold NewtonInt. case (NewtonInt_P8 f a b c pr1 pr2); intros. case pr1; intros. case pr2; intros. @@ -641,7 +641,7 @@ Proof. 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. + unfold Rminus; rewrite Rplus_opp_r; rewrite Rplus_0_r. rewrite <- b0 in o. elim o0; intro. elim o; intro. @@ -759,7 +759,7 @@ Proof. 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. + unfold Rminus; 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. diff --git a/theories/Reals/PSeries_reg.v b/theories/Reals/PSeries_reg.v index aa588e38..d4d91137 100644 --- a/theories/Reals/PSeries_reg.v +++ b/theories/Reals/PSeries_reg.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -12,7 +12,7 @@ Require Import SeqSeries. Require Import Ranalysis1. Require Import Max. Require Import Even. -Open Local Scope R_scope. +Local Open Scope R_scope. Definition Boule (x:R) (r:posreal) (y:R) : Prop := Rabs (y - x) < r. @@ -44,7 +44,7 @@ Lemma CVN_CVU : (cv:forall x:R, {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. + intros; unfold CVU; intros. unfold CVN_r in X. elim X; intros An X0. elim X0; intros s H0. @@ -58,7 +58,7 @@ Proof. 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. + unfold SFL; case (cv y); intro. trivial. apply H1. intro; elim H0; intros. @@ -69,7 +69,7 @@ Proof. 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_0_r; unfold Rminus; rewrite (Rplus_comm s); rewrite <- Rplus_assoc; rewrite Rplus_opp_r; rewrite Rplus_0_l; apply sum_incr. apply H1. @@ -77,10 +77,10 @@ Proof. 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. + unfold Un_cv in H1; unfold Un_cv; intros. elim (H1 _ H3); intros. exists x; intros. - unfold R_dist in |- *; unfold R_dist in H4. + unfold R_dist; unfold R_dist in H4. rewrite Rminus_0_r; apply H4; assumption. Qed. @@ -91,13 +91,13 @@ Lemma CVU_continuity : (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. + intros; unfold continuity_pt; unfold continue_in; + unfold limit1_in; unfold limit_in; + simpl; unfold R_dist; intros. unfold CVU in H. cut (0 < eps / 3); [ intro - | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + | unfold Rdiv; 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). @@ -110,7 +110,7 @@ Proof. set (del := Rmin del1 del2). exists del; intros. split. - unfold del in |- *; unfold Rmin in |- *; case (Rle_dec del1 del2); intro. + unfold del; unfold Rmin; case (Rle_dec del1 del2); intro. apply (cond_pos del1). elim H8; intros; assumption. intros; @@ -130,27 +130,27 @@ Proof. elim H9; intros. apply Rlt_le_trans with del. assumption. - unfold del in |- *; apply Rmin_l. + unfold del; 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. + unfold del; 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; + do 2 rewrite Rmult_plus_distr_l; unfold Rdiv; 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)); + simpl; intros. + unfold Boule; 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)). @@ -173,8 +173,8 @@ Lemma continuity_pt_finite_SF : 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 |- *; + simpl; apply (H 0%nat); apply le_n. + simpl; 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 ]. @@ -197,7 +197,7 @@ Proof. intros; eapply CVU_continuity. apply CVN_CVU. apply X. - intros; unfold SP in |- *; apply continuity_pt_finite_SF. + intros; unfold SP; apply continuity_pt_finite_SF. intros; apply H. apply H1. apply H0. @@ -208,7 +208,7 @@ Lemma SFL_continuity : (cv:forall x:R, { 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. + intros; unfold continuity; 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). @@ -216,8 +216,8 @@ Proof. 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; + unfold Boule; simpl; rewrite Rminus_0_r; + pattern (Rabs x) at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; apply Rlt_0_1. Qed. @@ -227,10 +227,10 @@ Lemma CVN_R_CVS : CVN_R fn -> forall x:R, { 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 |- *. + unfold SP; set (An := fun N:nat => fn N x). + change (Cauchy_crit_series An). apply cauchy_abs. - unfold Cauchy_crit_series in |- *; apply CV_Cauchy. + unfold Cauchy_crit_series; 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. @@ -239,13 +239,13 @@ Proof. apply Rseries_CV_comp with Bn. intro; split. apply Rabs_pos. - unfold An in |- *; apply H4; unfold Boule in |- *; simpl in |- *; + unfold An; apply H4; unfold Boule; simpl; rewrite Rminus_0_r. - pattern (Rabs x) at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + pattern (Rabs x) at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; apply Rlt_0_1. exists l. cut (forall n:nat, 0 <= Bn n). - intro; unfold Un_cv in H3; unfold Un_cv in |- *; intros. + intro; unfold Un_cv in H3; unfold Un_cv; 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). @@ -253,8 +253,8 @@ Proof. 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 |- *; + unfold An; apply H4; unfold Boule; simpl; + rewrite Rminus_0_r; pattern (Rabs x) at 1; 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 3f90f15a..d765cf78 100644 --- a/theories/Reals/PartSum.v +++ b/theories/Reals/PartSum.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -11,15 +11,15 @@ Require Import Rfunctions. Require Import Rseries. Require Import Rcomplete. Require Import Max. -Open Local Scope R_scope. +Local Open 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. Proof. intros; induction N as [| N HrecN]. - simpl in |- *; apply H; apply le_n. - simpl in |- *; apply Rplus_lt_0_compat. + simpl; apply H; apply le_n. + simpl; apply Rplus_lt_0_compat. apply HrecN; intros; apply H; apply le_S; assumption. apply H; apply le_n. Qed. @@ -52,7 +52,7 @@ Proof. 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 |- *. + rewrite H1; rewrite <- minus_n_n; simpl. replace (n + 0)%nat with n; [ reflexivity | ring ]. inversion H. right; reflexivity. @@ -66,7 +66,7 @@ Lemma tech3 : 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. + simpl; rewrite Rmult_1_r; unfold Rdiv; rewrite <- Rinv_r_sym. reflexivity. apply H0. replace (sum_f_R0 (fun i:nat => k ^ i) (S N)) with @@ -75,15 +75,15 @@ Proof. 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))); + unfold Rdiv; 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 ]. + [ do 2 rewrite Rmult_1_l; simpl; ring | apply H0 ]. apply H0. - unfold Rdiv in |- *; rewrite Rmult_plus_distr_r; rewrite (Rmult_comm (1 - k)); + unfold Rdiv; 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 |- *; + apply Rminus_eq_contra; red; intro; elim H; symmetry ; assumption. Qed. @@ -92,11 +92,11 @@ Lemma tech4 : 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. + simpl; 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; + rewrite pow_add; simpl; 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. @@ -116,7 +116,7 @@ Lemma tech6 : 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. + simpl; 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. @@ -127,13 +127,13 @@ Qed. Lemma tech7 : forall r1 r2:R, r1 <> 0 -> r2 <> 0 -> r1 <> r2 -> / r1 <> / r2. Proof. - intros; red in |- *; intro. + intros; red; 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. + elim H1; symmetry ; assumption. Qed. Lemma tech11 : @@ -142,7 +142,7 @@ Lemma tech11 : 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. + simpl; apply H. do 3 rewrite tech5; rewrite HrecN; rewrite (H (S N)); ring. Qed. @@ -151,7 +151,7 @@ Lemma tech12 : 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 infinite_sum in |- *; unfold Un_cv in H; + intros; unfold Pser; unfold infinite_sum; unfold Un_cv in H; assumption. Qed. @@ -160,7 +160,7 @@ Lemma scal_sum : 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. + simpl; ring. do 2 rewrite tech5. rewrite Rmult_plus_distr_l; rewrite <- HrecN; ring. Qed. @@ -179,14 +179,14 @@ Proof. do 2 rewrite tech5. replace (S (S (pred N))) with (S N). rewrite (HrecN H1); ring. - rewrite H2; simpl in |- *; reflexivity. + rewrite H2; simpl; reflexivity. assert (H2 := O_or_S N). elim H2; intros. elim a; intros. rewrite <- p. - simpl in |- *; reflexivity. + simpl; reflexivity. rewrite <- b in H1; elim (lt_irrefl _ H1). - rewrite H1; simpl in |- *; reflexivity. + rewrite H1; simpl; reflexivity. inversion H. right; reflexivity. left; apply lt_le_trans with 1%nat; [ apply lt_O_Sn | assumption ]. @@ -197,7 +197,7 @@ Lemma plus_sum : 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. + simpl; ring. do 3 rewrite tech5; rewrite HrecN; ring. Qed. @@ -207,7 +207,7 @@ Lemma sum_eq : sum_f_R0 An N = sum_f_R0 Bn N. Proof. intros; induction N as [| N HrecN]. - simpl in |- *; apply H; apply le_n. + simpl; 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 ]. @@ -218,7 +218,7 @@ Lemma uniqueness_sum : forall (An:nat -> R) (l1 l2:R), infinite_sum An l1 -> infinite_sum An l2 -> l1 = l2. Proof. - unfold infinite_sum in |- *; intros. + unfold infinite_sum; intros. case (Req_dec l1 l2); intro. assumption. cut (0 < Rabs ((l1 - l2) / 2)); [ intro | apply Rabs_pos_lt ]. @@ -235,19 +235,19 @@ Proof. 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; + apply Rabs_right; left; change (0 < / 2); 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 H20; generalize (lt_INR_0 2 (neq_O_lt 2 H20)); unfold INR; intro; assumption | discriminate ]. - unfold R_dist in |- *; rewrite <- (Rabs_Ropp (sum_f_R0 An N - l1)); + unfold R_dist; 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. + unfold ge; unfold N; apply le_max_r. + unfold ge; unfold N; apply le_max_l. + unfold Rdiv; apply prod_neq_R0. apply Rminus_eq_contra; assumption. apply Rinv_neq_0_compat; discrR. Qed. @@ -257,7 +257,7 @@ Lemma minus_sum : 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. + simpl; ring. do 3 rewrite tech5; rewrite HrecN; ring. Qed. @@ -268,7 +268,7 @@ Lemma sum_decomposition : Proof. intros. induction N as [| N HrecN]. - simpl in |- *; ring. + simpl; 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))). @@ -286,7 +286,7 @@ Lemma sum_Rle : Proof. intros. induction N as [| N HrecN]. - simpl in |- *; apply H. + simpl; apply H. apply le_n. do 2 rewrite tech5. apply Rle_trans with (sum_f_R0 An N + Bn (S N)). @@ -306,7 +306,7 @@ Lemma Rsum_abs : Proof. intros. induction N as [| N HrecN]. - simpl in |- *. + simpl. right; reflexivity. do 2 rewrite tech5. apply Rle_trans with (Rabs (sum_f_R0 An N) + Rabs (An (S N))). @@ -321,7 +321,7 @@ Lemma sum_cte : Proof. intros. induction N as [| N HrecN]. - simpl in |- *; ring. + simpl; ring. rewrite tech5. rewrite HrecN; repeat rewrite S_INR; ring. Qed. @@ -333,7 +333,7 @@ Lemma sum_growing : Proof. intros. induction N as [| N HrecN]. - simpl in |- *; apply H. + simpl; 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. @@ -348,7 +348,7 @@ Lemma Rabs_triang_gen : Proof. intros. induction N as [| N HrecN]. - simpl in |- *. + simpl. right; reflexivity. do 2 rewrite tech5. apply Rle_trans with (Rabs (sum_f_R0 An N) + Rabs (An (S N))). @@ -364,7 +364,7 @@ Lemma cond_pos_sum : Proof. intros. induction N as [| N HrecN]. - simpl in |- *; apply H. + simpl; apply H. rewrite tech5. apply Rplus_le_le_0_compat. apply HrecN. @@ -380,7 +380,7 @@ Lemma cauchy_abs : 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 |- *. + unfold Cauchy_crit_series; unfold Cauchy_crit. intros. elim (H eps H0); intros. exists x. @@ -400,8 +400,8 @@ Proof. 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 |- *. + unfold R_dist. + unfold Rminus. do 2 rewrite Ropp_plus_distr. do 2 rewrite <- Rplus_assoc. do 2 rewrite Rplus_opp_r. @@ -414,18 +414,18 @@ Proof. 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. + unfold Bn; 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. + unfold R_dist. + unfold Rminus; 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 |- *. + unfold R_dist. + unfold Rminus. 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)). @@ -439,7 +439,7 @@ Proof. 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. + unfold Bn; reflexivity. apply Rle_ge. apply cond_pos_sum. intro; apply Rabs_pos. @@ -454,7 +454,7 @@ Proof. intros An X. elim X; intros. unfold Un_cv in p. - unfold Cauchy_crit_series in |- *; unfold Cauchy_crit in |- *. + unfold Cauchy_crit_series; unfold Cauchy_crit. intros. cut (0 < eps / 2). intro. @@ -462,7 +462,7 @@ Proof. 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 |- *. + unfold R_dist. 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)). @@ -471,8 +471,8 @@ Proof. apply Rplus_lt_compat. apply H1; assumption. apply H1; assumption. - right; symmetry in |- *; apply double_var. - unfold Rdiv in |- *; apply Rmult_lt_0_compat; + right; symmetry ; apply double_var. + unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. Qed. @@ -493,7 +493,7 @@ Lemma sum_eq_R0 : (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. + simpl; 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 ] ]. @@ -530,15 +530,15 @@ Proof. [ idtac | ring ]; apply Rle_trans with l1. left; apply r. apply H6. - unfold l1 in |- *; apply Rge_le; + unfold l1; 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. + unfold ge, N0; apply le_max_r. + unfold ge, N0; 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; + unfold Un_growing; intro; simpl; + pattern (sum_f_R0 An n) at 1; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; apply H0. Qed. @@ -572,7 +572,7 @@ Proof. 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; + unfold Rdiv; 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. @@ -581,18 +581,18 @@ Proof. 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; + unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; apply H7. - unfold Rdiv in |- *; rewrite Rmult_plus_distr_r; + unfold Rdiv; 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. + repeat rewrite (Rmult_comm (/ 2)); pattern (Rabs l1) at 1; + rewrite double_var; unfold Rdiv; 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 (double l2); unfold Rdiv; 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. @@ -600,23 +600,23 @@ Proof. 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)); + unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite Rmult_minus_distr_l; rewrite Rmult_plus_distr_r; - pattern l2 at 2 in |- *; rewrite double_var; + pattern l2 at 2; rewrite double_var; repeat rewrite (Rmult_comm (/ 2)); rewrite Ropp_plus_distr; - unfold Rdiv in |- *; ring. + unfold Rdiv; 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 H4; unfold ge, N; apply le_max_l. + apply H5; unfold ge, N; apply le_max_r. + unfold Rdiv; 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 |- *. + unfold SP; simpl; apply H1. + unfold SP; simpl. apply Rle_trans with (Rabs (sum_f_R0 (fun k:nat => fn k x) n0) + Rabs (fn (S n0) x)). apply Rabs_triang. diff --git a/theories/Reals/RIneq.v b/theories/Reals/RIneq.v index 70f4ff0d..5fc7d8fb 100644 --- a/theories/Reals/RIneq.v +++ b/theories/Reals/RIneq.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -52,13 +52,13 @@ Proof. exact Rlt_irrefl. 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. + red; intros r1 r2 H H0; apply (Rlt_irrefl r1). + pattern r1 at 2; rewrite H0; trivial. Qed. Lemma Rgt_not_eq : forall r1 r2, r1 > r2 -> r1 <> r2. Proof. - intros; apply sym_not_eq; apply Rlt_not_eq; auto with real. + intros; apply not_eq_sym; apply Rlt_not_eq; auto with real. Qed. (**********) @@ -102,7 +102,7 @@ Qed. Lemma Rlt_le : forall r1 r2, r1 < r2 -> r1 <= r2. Proof. - intros; red in |- *; tauto. + intros; red; tauto. Qed. Hint Resolve Rlt_le: real. @@ -114,14 +114,14 @@ Qed. (**********) Lemma Rle_ge : forall r1 r2, r1 <= r2 -> r2 >= r1. Proof. - destruct 1; red in |- *; auto with real. + destruct 1; red; auto with real. Qed. Hint Immediate Rle_ge: real. Hint Resolve Rle_ge: rorders. Lemma Rge_le : forall r1 r2, r1 >= r2 -> r2 <= r1. Proof. - destruct 1; red in |- *; auto with real. + destruct 1; red; auto with real. Qed. Hint Resolve Rge_le: real. Hint Immediate Rge_le: rorders. @@ -143,7 +143,7 @@ Hint Immediate Rgt_lt: rorders. Lemma Rnot_le_lt : forall r1 r2, ~ r1 <= r2 -> r2 < r1. Proof. - intros r1 r2; generalize (Rtotal_order r1 r2); unfold Rle in |- *; tauto. + intros r1 r2; generalize (Rtotal_order r1 r2); unfold Rle; tauto. Qed. Hint Immediate Rnot_le_lt: real. @@ -174,7 +174,7 @@ Proof. eauto using Rnot_gt_ge with rorders. Qed. (**********) Lemma Rlt_not_le : forall r1 r2, r2 < r1 -> ~ r1 <= r2. Proof. - generalize Rlt_asym Rlt_dichotomy_converse; unfold Rle in |- *. + generalize Rlt_asym Rlt_dichotomy_converse; unfold Rle. intuition eauto 3. Qed. Hint Immediate Rlt_not_le: real. @@ -192,7 +192,7 @@ Proof. exact Rlt_not_ge. Qed. Lemma Rle_not_lt : forall r1 r2, r2 <= r1 -> ~ r1 < r2. Proof. intros r1 r2. generalize (Rlt_asym r1 r2) (Rlt_dichotomy_converse r1 r2). - unfold Rle in |- *; intuition. + unfold Rle; intuition. Qed. Lemma Rge_not_lt : forall r1 r2, r1 >= r2 -> ~ r1 < r2. @@ -207,25 +207,25 @@ Proof. do 2 intro; apply Rge_not_lt. Qed. (**********) Lemma Req_le : forall r1 r2, r1 = r2 -> r1 <= r2. Proof. - unfold Rle in |- *; tauto. + unfold Rle; tauto. Qed. Hint Immediate Req_le: real. Lemma Req_ge : forall r1 r2, r1 = r2 -> r1 >= r2. Proof. - unfold Rge in |- *; tauto. + unfold Rge; tauto. Qed. Hint Immediate Req_ge: real. Lemma Req_le_sym : forall r1 r2, r2 = r1 -> r1 <= r2. Proof. - unfold Rle in |- *; auto. + unfold Rle; auto. Qed. Hint Immediate Req_le_sym: real. Lemma Req_ge_sym : forall r1 r2, r2 = r1 -> r1 >= r2. Proof. - unfold Rge in |- *; auto. + unfold Rge; auto. Qed. Hint Immediate Req_ge_sym: real. @@ -240,7 +240,7 @@ Proof. do 2 intro; apply Rlt_asym. Qed. Lemma Rle_antisym : forall r1 r2, r1 <= r2 -> r2 <= r1 -> r1 = r2. Proof. - intros r1 r2; generalize (Rlt_asym r1 r2); unfold Rle in |- *; intuition. + intros r1 r2; generalize (Rlt_asym r1 r2); unfold Rle; intuition. Qed. Hint Resolve Rle_antisym: real. @@ -276,8 +276,8 @@ Proof. intros; red; apply Rlt_eq_compat with (r2:=r4) (r4:=r2); auto. Qed. Lemma Rle_trans : forall r1 r2 r3, r1 <= r2 -> r2 <= r3 -> r1 <= r3. Proof. - generalize trans_eq Rlt_trans Rlt_eq_compat. - unfold Rle in |- *. + generalize eq_trans Rlt_trans Rlt_eq_compat. + unfold Rle. intuition eauto 2. Qed. @@ -291,13 +291,13 @@ Proof. eauto using Rlt_trans with rorders. Qed. Lemma Rle_lt_trans : forall r1 r2 r3, r1 <= r2 -> r2 < r3 -> r1 < r3. Proof. generalize Rlt_trans Rlt_eq_compat. - unfold Rle in |- *. + unfold Rle. intuition eauto 2. Qed. Lemma Rlt_le_trans : forall r1 r2 r3, r1 < r2 -> r2 <= r3 -> r1 < r3. Proof. - generalize Rlt_trans Rlt_eq_compat; unfold Rle in |- *; intuition eauto 2. + generalize Rlt_trans Rlt_eq_compat; unfold Rle; intuition eauto 2. Qed. Lemma Rge_gt_trans : forall r1 r2 r3, r1 >= r2 -> r2 > r3 -> r1 > r3. @@ -430,7 +430,7 @@ 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. + intros r b; pattern r at 2; replace r with (r + 0); eauto with real. Qed. (***********) @@ -441,7 +441,7 @@ Proof. absurd (0 < a + b). rewrite H1; auto with real. apply Rle_lt_trans with (a + 0). - rewrite Rplus_0_r in |- *; assumption. + rewrite Rplus_0_r; assumption. auto using Rplus_lt_compat_l with real. rewrite <- H0, Rplus_0_r in H1; assumption. Qed. @@ -570,14 +570,14 @@ Qed. (**********) Lemma Rmult_neq_0_reg : forall r1 r2, r1 * r2 <> 0 -> r1 <> 0 /\ r2 <> 0. Proof. - intros r1 r2 H; split; red in |- *; intro; apply H; auto with real. + intros r1 r2 H; split; red; intro; apply H; auto with real. Qed. (**********) Lemma Rmult_integral_contrapositive : forall r1 r2, r1 <> 0 /\ r2 <> 0 -> r1 * r2 <> 0. Proof. - red in |- *; intros r1 r2 [H1 H2] H. + red; intros r1 r2 [H1 H2] H. case (Rmult_integral r1 r2); auto with real. Qed. Hint Resolve Rmult_integral_contrapositive: real. @@ -604,12 +604,12 @@ Notation "r ²" := (Rsqr r) (at level 1, format "r ²") : R_scope. (***********) Lemma Rsqr_0 : Rsqr 0 = 0. - unfold Rsqr in |- *; auto with real. + unfold Rsqr; auto with real. 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; intros; elim (Rmult_integral r r H); trivial. Qed. (*********************************************************) @@ -647,7 +647,7 @@ Hint Resolve Ropp_involutive: real. (*********) Lemma Ropp_neq_0_compat : forall r, r <> 0 -> - r <> 0. Proof. - red in |- *; intros r H H0. + red; intros r H H0. apply H. transitivity (- - r); auto with real. Qed. @@ -720,7 +720,7 @@ 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. + intros r1 r2; unfold Rminus; rewrite Rplus_comm; intro. rewrite <- (Ropp_involutive r2); apply (Rplus_opp_r_uniq (- r2) r1 H). Qed. Hint Immediate Rminus_diag_uniq: real. @@ -741,20 +741,20 @@ Hint Resolve Rplus_minus: real. (**********) Lemma Rminus_eq_contra : forall r1 r2, r1 <> r2 -> r1 - r2 <> 0. Proof. - red in |- *; intros r1 r2 H H0. + red; 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. Proof. - red in |- *; intros; elim H; apply Rminus_diag_eq; auto. + red; 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. Proof. - red in |- *; intros; elim H; rewrite H0; ring. + red; intros; elim H; rewrite H0; ring. Qed. Hint Resolve Rminus_not_eq_right: real. @@ -778,7 +778,7 @@ Hint Resolve Rinv_1: real. (*********) Lemma Rinv_neq_0_compat : forall r, r <> 0 -> / r <> 0. Proof. - red in |- *; intros; apply R1_neq_R0. + red; intros; apply R1_neq_R0. replace 1 with (/ r * r); auto with real. Qed. Hint Resolve Rinv_neq_0_compat: real. @@ -858,7 +858,7 @@ Proof. do 3 intro; apply Rplus_lt_compat_r. Qed. (**********) Lemma Rplus_le_compat_l : forall r r1 r2, r1 <= r2 -> r + r1 <= r + r2. Proof. - unfold Rle in |- *; intros; elim H; intro. + unfold Rle; intros; elim H; intro. left; apply (Rplus_lt_compat_l r r1 r2 H0). right; rewrite <- H0; auto with zarith real. Qed. @@ -870,7 +870,7 @@ Hint Resolve Rplus_ge_compat_l: real. (**********) Lemma Rplus_le_compat_r : forall r r1 r2, r1 <= r2 -> r1 + r <= r2 + r. Proof. - unfold Rle in |- *; intros; elim H; intro. + unfold Rle; intros; elim H; intro. left; apply (Rplus_lt_compat_r r r1 r2 H0). right; rewrite <- H0; auto with real. Qed. @@ -931,7 +931,7 @@ Lemma Rplus_lt_0_compat : forall r1 r2, 0 < r1 -> 0 < r2 -> 0 < r1 + r2. 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; + | pattern x at 1; rewrite <- (Rplus_0_r x); apply Rplus_lt_compat_l; assumption ]. Qed. @@ -939,7 +939,7 @@ Lemma Rplus_le_lt_0_compat : forall r1 r2, 0 <= r1 -> 0 < r2 -> 0 < r1 + r2. 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; + | pattern x at 1; rewrite <- (Rplus_0_r x); apply Rplus_lt_compat_l; assumption ]. Qed. @@ -953,7 +953,7 @@ Lemma Rplus_le_le_0_compat : forall r1 r2, 0 <= r1 -> 0 <= r2 -> 0 <= r1 + r2. 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; + | pattern x at 1; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; assumption ]. Qed. @@ -981,7 +981,7 @@ Qed. Lemma Rplus_le_reg_l : forall r r1 r2, r + r1 <= r + r2 -> r1 <= r2. Proof. - unfold Rle in |- *; intros; elim H; intro. + unfold Rle; 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. @@ -995,7 +995,7 @@ Qed. Lemma Rplus_gt_reg_l : forall r r1 r2, r + r1 > r + r2 -> r1 > r2. Proof. - unfold Rgt in |- *; intros; apply (Rplus_lt_reg_r r r2 r1 H). + unfold Rgt; intros; apply (Rplus_lt_reg_r r r2 r1 H). Qed. Lemma Rplus_ge_reg_l : forall r r1 r2, r + r1 >= r + r2 -> r1 >= r2. @@ -1046,7 +1046,7 @@ Qed. Lemma Ropp_gt_lt_contravar : forall r1 r2, r1 > r2 -> - r1 < - r2. Proof. - unfold Rgt in |- *; intros. + unfold Rgt; intros. apply (Rplus_lt_reg_r (r2 + r1)). replace (r2 + r1 + - r1) with r2. replace (r2 + r1 + - r2) with r1. @@ -1058,7 +1058,7 @@ Hint Resolve Ropp_gt_lt_contravar. Lemma Ropp_lt_gt_contravar : forall r1 r2, r1 < r2 -> - r1 > - r2. Proof. - unfold Rgt in |- *; auto with real. + unfold Rgt; auto with real. Qed. Hint Resolve Ropp_lt_gt_contravar: real. @@ -1183,7 +1183,7 @@ Proof. eauto using Rmult_lt_compat_l with rorders. Qed. Lemma Rmult_le_compat_l : 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 |- *; + intros r r1 r2 H H0; destruct H; destruct H0; unfold Rle; auto with real. right; rewrite <- H; do 2 rewrite Rmult_0_l; reflexivity. Qed. @@ -1342,7 +1342,7 @@ Qed. (**********) Lemma Rle_minus : forall r1 r2, r1 <= r2 -> r1 - r2 <= 0. Proof. - destruct 1; unfold Rle in |- *; auto with real. + destruct 1; unfold Rle; auto with real. Qed. Lemma Rge_minus : forall r1 r2, r1 >= r2 -> r1 - r2 >= 0. @@ -1356,7 +1356,7 @@ Qed. Lemma Rminus_lt : forall r1 r2, r1 - r2 < 0 -> r1 < r2. Proof. intros; replace r1 with (r1 - r2 + r2). - pattern r2 at 3 in |- *; replace r2 with (0 + r2); auto with real. + pattern r2 at 3; replace r2 with (0 + r2); auto with real. ring. Qed. @@ -1372,7 +1372,7 @@ Qed. Lemma Rminus_le : forall r1 r2, r1 - r2 <= 0 -> r1 <= r2. Proof. intros; replace r1 with (r1 - r2 + r2). - pattern r2 at 3 in |- *; replace r2 with (0 + r2); auto with real. + pattern r2 at 3; replace r2 with (0 + r2); auto with real. ring. Qed. @@ -1387,7 +1387,7 @@ Qed. (**********) Lemma tech_Rplus : forall r (s:R), 0 <= r -> 0 < s -> r + s <> 0. Proof. - intros; apply sym_not_eq; apply Rlt_not_eq. + intros; apply not_eq_sym; apply Rlt_not_eq. rewrite Rplus_comm; replace 0 with (0 + 0); auto with real. Qed. Hint Immediate tech_Rplus: real. @@ -1398,7 +1398,7 @@ Hint Immediate tech_Rplus: real. Lemma Rle_0_sqr : forall r, 0 <= Rsqr r. Proof. - intro; case (Rlt_le_dec r 0); unfold Rsqr in |- *; intro. + intro; case (Rlt_le_dec r 0); unfold Rsqr; 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. @@ -1407,7 +1407,7 @@ Qed. (***********) Lemma Rlt_0_sqr : forall r, r <> 0 -> 0 < Rsqr r. Proof. - intros; case (Rdichotomy r 0); trivial; unfold Rsqr in |- *; intro. + intros; case (Rdichotomy r 0); trivial; unfold Rsqr; 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. @@ -1437,7 +1437,7 @@ Qed. Lemma Rlt_0_1 : 0 < 1. Proof. replace 1 with (Rsqr 1); auto with real. - unfold Rsqr in |- *; auto with real. + unfold Rsqr; auto with real. Qed. Hint Resolve Rlt_0_1: real. @@ -1453,7 +1453,7 @@ Qed. Lemma Rinv_0_lt_compat : forall r, 0 < r -> 0 < / r. Proof. - intros; apply Rnot_le_lt; red in |- *; intros. + intros; apply Rnot_le_lt; red; intros. absurd (1 <= 0); auto with real. replace 1 with (r * / r); auto with real. replace 0 with (r * 0); auto with real. @@ -1463,7 +1463,7 @@ Hint Resolve Rinv_0_lt_compat: real. (*********) Lemma Rinv_lt_0_compat : forall r, r < 0 -> / r < 0. Proof. - intros; apply Rnot_le_lt; red in |- *; intros. + intros; apply Rnot_le_lt; red; intros. absurd (1 <= 0); auto with real. replace 1 with (r * / r); auto with real. replace 0 with (r * 0); auto with real. @@ -1477,8 +1477,8 @@ Proof. 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. + symmetry ; auto with real. + symmetry ; auto with real. Qed. Lemma Rinv_1_lt_contravar : forall r1 r2, 1 <= r1 -> r1 < r2 -> / r2 < / r1. @@ -1495,7 +1495,7 @@ Proof. 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. + red; apply Rlt_trans with (r2 := x); auto with real. Qed. Hint Resolve Rinv_1_lt_contravar: real. @@ -1508,7 +1508,7 @@ Lemma Rle_lt_0_plus_1 : forall r, 0 <= r -> 0 < r + 1. Proof. intros. apply Rlt_le_trans with 1; auto with real. - pattern 1 at 1 in |- *; replace 1 with (0 + 1); auto with real. + pattern 1 at 1; replace 1 with (0 + 1); auto with real. Qed. Hint Resolve Rle_lt_0_plus_1: real. @@ -1516,15 +1516,15 @@ Hint Resolve Rle_lt_0_plus_1: real. Lemma Rlt_plus_1 : forall r, r < r + 1. Proof. intros. - pattern r at 1 in |- *; replace r with (r + 0); auto with real. + pattern r at 1; 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. Proof. - red in |- *; unfold Rminus in |- *; intros. - pattern r1 at 2 in |- *; replace r1 with (r1 + 0); auto with real. + red; unfold Rminus; intros. + pattern r1 at 2; replace r1 with (r1 + 0); auto with real. Qed. (*********************************************************) @@ -1540,14 +1540,14 @@ Qed. (**********) Lemma S_O_plus_INR : forall n:nat, INR (1 + n) = INR 1 + INR n. Proof. - intro; simpl in |- *; case n; intros; auto with real. + intro; simpl; case n; intros; auto with real. Qed. (**********) Lemma plus_INR : forall n m:nat, INR (n + m) = INR n + INR m. Proof. intros n m; induction n as [| n Hrecn]. - simpl in |- *; auto with real. + simpl; auto with real. replace (S n + m)%nat with (S (n + m)); auto with arith. repeat rewrite S_INR. rewrite Hrecn; ring. @@ -1557,9 +1557,9 @@ Hint Resolve plus_INR: real. (**********) Lemma minus_INR : forall n m:nat, (m <= n)%nat -> INR (n - m) = INR n - INR m. Proof. - intros n m le; pattern m, n in |- *; apply le_elim_rel; auto with real. + intros n m le; pattern m, n; apply le_elim_rel; auto with real. intros; rewrite <- minus_n_O; auto with real. - intros; repeat rewrite S_INR; simpl in |- *. + intros; repeat rewrite S_INR; simpl. rewrite H0; ring. Qed. Hint Resolve minus_INR: real. @@ -1568,8 +1568,8 @@ Hint Resolve minus_INR: real. Lemma mult_INR : forall n m:nat, INR (n * m) = INR n * INR m. Proof. intros n m; induction n as [| n Hrecn]. - simpl in |- *; auto with real. - intros; repeat rewrite S_INR; simpl in |- *. + simpl; auto with real. + intros; repeat rewrite S_INR; simpl. rewrite plus_INR; rewrite Hrecn; ring. Qed. Hint Resolve mult_INR: real. @@ -1597,11 +1597,11 @@ Qed. Hint Resolve lt_1_INR: real. (**********) -Lemma pos_INR_nat_of_P : forall p:positive, 0 < INR (nat_of_P p). +Lemma pos_INR_nat_of_P : forall p:positive, 0 < INR (Pos.to_nat p). Proof. intro; apply lt_0_INR. - simpl in |- *; auto with real. - apply nat_of_P_pos. + simpl; auto with real. + apply Pos2Nat.is_pos. Qed. Hint Resolve pos_INR_nat_of_P: real. @@ -1609,7 +1609,7 @@ Hint Resolve pos_INR_nat_of_P: real. Lemma pos_INR : forall n:nat, 0 <= INR n. Proof. intro n; case n. - simpl in |- *; auto with real. + simpl; auto with real. auto with arith real. Qed. Hint Resolve pos_INR: real. @@ -1617,10 +1617,10 @@ Hint Resolve pos_INR: real. Lemma INR_lt : forall n m:nat, INR n < INR m -> (n < m)%nat. Proof. double induction n m; intros. - simpl in |- *; exfalso; apply (Rlt_irrefl 0); auto. + simpl; exfalso; 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 ]. + [ intro H2; rewrite H2 in H0; idtac | simpl; trivial ]. generalize (Rle_lt_trans 0 (INR (S n0)) 0 H1 H0); intro; exfalso; apply (Rlt_irrefl 0); auto. do 2 rewrite S_INR in H1; cut (INR n1 < INR n0). @@ -1642,7 +1642,7 @@ Hint Resolve le_INR: real. (**********) Lemma INR_not_0 : forall n:nat, INR n <> 0 -> n <> 0%nat. Proof. - red in |- *; intros n H H1. + red; intros n H H1. apply H. rewrite H1; trivial. Qed. @@ -1654,7 +1654,7 @@ 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. + apply Rgt_not_eq; red; auto with real. Qed. Hint Resolve not_0_INR: real. @@ -1664,7 +1664,7 @@ Proof. case (le_lt_or_eq _ _ H1); intros H2. apply Rlt_dichotomy_converse; auto with real. exfalso; auto. - apply sym_not_eq; apply Rlt_dichotomy_converse; auto with real. + apply not_eq_sym; apply Rlt_dichotomy_converse; auto with real. Qed. Hint Resolve not_INR: real. @@ -1675,7 +1675,7 @@ Proof. cut (n <> m). intro H3; generalize (not_INR n m H3); intro H4; exfalso; auto. omega. - symmetry in |- *; cut (m <> n). + symmetry ; cut (m <> n). intro H3; generalize (not_INR m n H3); intro H4; exfalso; auto. omega. Qed. @@ -1701,16 +1701,16 @@ Hint Resolve not_1_INR: real. (**********) -Lemma IZN : forall n:Z, (0 <= n)%Z -> exists m : nat, n = Z_of_nat m. +Lemma IZN : forall n:Z, (0 <= n)%Z -> exists m : nat, n = Z.of_nat m. 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). +Lemma INR_IZR_INZ : forall n:nat, INR n = IZR (Z.of_nat n). Proof. simple induction n; auto with real. - intros; simpl in |- *; rewrite nat_of_P_of_succ_nat; + intros; simpl; rewrite SuccNat2Pos.id_succ; auto with real. Qed. @@ -1718,13 +1718,13 @@ Lemma plus_IZR_NEG_POS : forall p q:positive, IZR (Zpos p + Zneg q) = IZR (Zpos p) + IZR (Zneg q). Proof. intros p q; simpl. rewrite Z.pos_sub_spec. - case Pcompare_spec; intros H; simpl. + case Pos.compare_spec; intros H; simpl. subst. ring. - rewrite Pminus_minus by trivial. - rewrite minus_INR by (now apply lt_le_weak, Plt_lt). + rewrite Pos2Nat.inj_sub by trivial. + rewrite minus_INR by (now apply lt_le_weak, Pos2Nat.inj_lt). ring. - rewrite Pminus_minus by trivial. - rewrite minus_INR by (now apply lt_le_weak, Plt_lt). + rewrite Pos2Nat.inj_sub by trivial. + rewrite minus_INR by (now apply lt_le_weak, Pos2Nat.inj_lt). ring. Qed. @@ -1732,55 +1732,55 @@ Qed. Lemma plus_IZR : forall n m:Z, IZR (n + m) = IZR n + IZR m. Proof. intro z; destruct z; intro t; destruct t; intros; auto with real. - simpl; intros; rewrite Pplus_plus; auto with real. + simpl; intros; rewrite Pos2Nat.inj_add; auto with real. apply plus_IZR_NEG_POS. - rewrite Zplus_comm; rewrite Rplus_comm; apply plus_IZR_NEG_POS. - simpl; intros; rewrite Pplus_plus; rewrite plus_INR; + rewrite Z.add_comm; rewrite Rplus_comm; apply plus_IZR_NEG_POS. + simpl; intros; rewrite Pos2Nat.inj_add; rewrite plus_INR; auto with real. Qed. (**********) Lemma mult_IZR : forall n m:Z, IZR (n * m) = IZR n * IZR m. Proof. - intros z t; case z; case t; simpl in |- *; auto with real. - intros t1 z1; rewrite Pmult_mult; auto with real. - intros t1 z1; rewrite Pmult_mult; auto with real. + intros z t; case z; case t; simpl; auto with real. + intros t1 z1; rewrite Pos2Nat.inj_mul; auto with real. + intros t1 z1; rewrite Pos2Nat.inj_mul; 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 Pmult_mult; auto with real. + intros t1 z1; rewrite Pos2Nat.inj_mul; auto with real. rewrite Ropp_mult_distr_l_reverse; auto with real. - intros t1 z1; rewrite Pmult_mult; auto with real. + intros t1 z1; rewrite Pos2Nat.inj_mul; auto with real. rewrite Rmult_opp_opp; auto with real. Qed. -Lemma pow_IZR : forall z n, pow (IZR z) n = IZR (Zpower z (Z_of_nat n)). +Lemma pow_IZR : forall z n, pow (IZR z) n = IZR (Z.pow z (Z.of_nat n)). Proof. intros z [|n];simpl;trivial. rewrite Zpower_pos_nat. - rewrite nat_of_P_of_succ_nat. unfold Zpower_nat;simpl. + rewrite SuccNat2Pos.id_succ. unfold Zpower_nat;simpl. rewrite mult_IZR. induction n;simpl;trivial. rewrite mult_IZR;ring[IHn]. Qed. (**********) -Lemma succ_IZR : forall n:Z, IZR (Zsucc n) = IZR n + 1. +Lemma succ_IZR : forall n:Z, IZR (Z.succ n) = IZR n + 1. Proof. - intro; change 1 with (IZR 1); unfold Zsucc; apply plus_IZR. + intro; change 1 with (IZR 1); unfold Z.succ; apply plus_IZR. Qed. (**********) Lemma opp_IZR : forall n:Z, IZR (- n) = - IZR n. Proof. - intro z; case z; simpl in |- *; auto with real. + intro z; case z; simpl; auto with real. Qed. Definition Ropp_Ropp_IZR := opp_IZR. Lemma minus_IZR : forall n m:Z, IZR (n - m) = IZR n - IZR m. Proof. - intros; unfold Zminus, Rminus. + intros; unfold Z.sub, Rminus. rewrite <- opp_IZR. apply plus_IZR. Qed. @@ -1788,16 +1788,16 @@ Qed. (**********) Lemma Z_R_minus : forall n m:Z, IZR n - IZR m = IZR (n - m). Proof. - intros z1 z2; unfold Rminus in |- *; unfold Zminus in |- *. - rewrite <- (Ropp_Ropp_IZR z2); symmetry in |- *; apply plus_IZR. + intros z1 z2; unfold Rminus; unfold Z.sub. + rewrite <- (Ropp_Ropp_IZR z2); symmetry ; apply plus_IZR. Qed. (**********) Lemma lt_0_IZR : forall n:Z, 0 < IZR n -> (0 < n)%Z. Proof. - intro z; case z; simpl in |- *; intros. + intro z; case z; simpl; intros. absurd (0 < 0); auto with real. - unfold Zlt in |- *; simpl in |- *; trivial. + unfold Z.lt; simpl; trivial. case Rlt_not_le with (1 := H). replace 0 with (-0); auto with real. Qed. @@ -1805,7 +1805,7 @@ Qed. (**********) Lemma lt_IZR : forall n m:Z, IZR n < IZR m -> (n < m)%Z. Proof. - intros z1 z2 H; apply Zlt_0_minus_lt. + intros z1 z2 H; apply Z.lt_0_sub. apply lt_0_IZR. rewrite <- Z_R_minus. exact (Rgt_minus (IZR z2) (IZR z1) H). @@ -1814,10 +1814,10 @@ Qed. (**********) Lemma eq_IZR_R0 : forall n:Z, IZR n = 0 -> n = 0%Z. 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 pos_INR_nat_of_P. + intro z; destruct z; simpl; intros; auto with zarith. + case (Rlt_not_eq 0 (INR (Pos.to_nat p))); auto with real. + case (Rlt_not_eq (- INR (Pos.to_nat p)) 0); auto with real. + apply Ropp_lt_gt_0_contravar. unfold Rgt; apply pos_INR_nat_of_P. Qed. (**********) @@ -1831,23 +1831,23 @@ Qed. (**********) Lemma not_0_IZR : forall n:Z, n <> 0%Z -> IZR n <> 0. Proof. - intros z H; red in |- *; intros H0; case H. + intros z H; red; intros H0; case H. apply eq_IZR; auto. Qed. (*********) Lemma le_0_IZR : forall n:Z, 0 <= IZR n -> (0 <= n)%Z. Proof. - unfold Rle in |- *; intros z [H| H]. - red in |- *; intro; apply (Zlt_le_weak 0 z (lt_0_IZR z H)); assumption. + unfold Rle; intros z [H| H]. + red; intro; apply (Z.lt_le_incl 0 z (lt_0_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. Proof. - unfold Rle in |- *; intros z1 z2 [H| H]. - apply (Zlt_le_weak z1 z2); auto with real. + unfold Rle; intros z1 z2 [H| H]. + apply (Z.lt_le_incl z1 z2); auto with real. apply lt_IZR; trivial. rewrite (eq_IZR z1 z2); auto with zarith real. Qed. @@ -1855,20 +1855,20 @@ Qed. (**********) Lemma le_IZR_R1 : forall n:Z, IZR n <= 1 -> (n <= 1)%Z. Proof. - pattern 1 at 1 in |- *; replace 1 with (IZR 1); intros; auto. + pattern 1 at 1; 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. Proof. - intros m n H; apply Rnot_lt_ge; red in |- *; intro. + intros m n H; apply Rnot_lt_ge; red; intro. generalize (lt_IZR m n H0); intro; omega. Qed. Lemma IZR_le : forall n m:Z, (n <= m)%Z -> IZR n <= IZR m. Proof. - intros m n H; apply Rnot_gt_le; red in |- *; intro. + intros m n H; apply Rnot_gt_le; red; intro. unfold Rgt in H0; generalize (lt_IZR n m H0); intro; omega. Qed. @@ -1883,10 +1883,10 @@ Qed. Lemma one_IZR_lt1 : forall n:Z, -1 < IZR n < 1 -> n = 0%Z. 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. + apply Z.le_antisymm. + apply Z.lt_succ_r; apply lt_IZR; trivial. + replace 0%Z with (Z.succ (-1)); trivial. + apply Z.le_succ_l; apply lt_IZR; trivial. Qed. Lemma one_IZR_r_R1 : @@ -1897,10 +1897,10 @@ Proof. 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. + unfold Rminus; 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. + unfold Rminus; apply Rplus_le_lt_compat; auto with real. ring. Qed. @@ -1931,6 +1931,20 @@ Proof. apply (Rmult_le_compat_l x 0 y H H0). Qed. +Lemma Rle_Rinv : forall x y:R, 0 < x -> 0 < y -> x <= y -> / y <= / x. +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; intro; rewrite H2 in H0; elim (Rlt_irrefl _ H0). + red; intro; rewrite H2 in H; elim (Rlt_irrefl _ H). +Qed. + Lemma double : forall r1, 2 * r1 = r1 + r1. Proof. intro; ring. @@ -1938,10 +1952,10 @@ Qed. Lemma double_var : forall r1, r1 = r1 / 2 + r1 / 2. Proof. - intro; rewrite <- double; unfold Rdiv in |- *; rewrite <- Rmult_assoc; - symmetry in |- *; apply Rinv_r_simpl_m. + intro; rewrite <- double; unfold Rdiv; rewrite <- Rmult_assoc; + symmetry ; apply Rinv_r_simpl_m. replace 2 with (INR 2); - [ apply not_0_INR; discriminate | unfold INR in |- *; ring ]. + [ apply not_0_INR; discriminate | unfold INR; ring ]. Qed. (*********************************************************) @@ -1976,22 +1990,22 @@ Proof. rewrite (Rplus_comm y); intro H5; apply Rplus_le_reg_l with x; assumption. ring. replace 2 with (INR 2); [ apply not_0_INR; discriminate | reflexivity ]. - pattern y at 2 in |- *; replace y with (y / 2 + y / 2). - unfold Rminus, Rdiv in |- *. + pattern y at 2; replace y with (y / 2 + y / 2). + unfold Rminus, Rdiv. repeat rewrite Rmult_plus_distr_r. ring. cut (forall z:R, 2 * z = z + z). intro. rewrite <- (H4 (y / 2)). - unfold Rdiv in |- *. + unfold Rdiv. rewrite <- Rmult_assoc; apply Rinv_r_simpl_m. replace 2 with (INR 2). apply not_0_INR. discriminate. - unfold INR in |- *; reflexivity. + unfold INR; reflexivity. intro; ring. cut (0%nat <> 2%nat); - [ intro H0; generalize (lt_0_INR 2 (neq_O_lt 2 H0)); unfold INR in |- *; + [ intro H0; generalize (lt_0_INR 2 (neq_O_lt 2 H0)); unfold INR; intro; assumption | discriminate ]. Qed. diff --git a/theories/Reals/RList.v b/theories/Reals/RList.v index dbd2e52f..6d42434a 100644 --- a/theories/Reals/RList.v +++ b/theories/Reals/RList.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,7 +8,7 @@ Require Import Rbase. Require Import Rfunctions. -Open Local Scope R_scope. +Local Open Scope R_scope. Inductive Rlist : Type := | nil : Rlist @@ -52,19 +52,19 @@ Proof. simpl in H; elim H. induction l as [| r0 l Hrecl0]. simpl in H; elim H; intro. - simpl in |- *; right; assumption. + simpl; 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. + unfold Rmax; case (Rle_dec r (MaxRlist (cons r0 l))); intro. + apply Hrecl; simpl; 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 Hrecl; simpl; tauto | left; auto with real ]. + unfold Rmax; case (Rle_dec r (MaxRlist (cons r0 l))); intro. + apply Hrecl; simpl; tauto. apply Rle_trans with (MaxRlist (cons r0 l)); - [ apply Hrecl; simpl in |- *; tauto | left; auto with real ]. + [ apply Hrecl; simpl; tauto | left; auto with real ]. reflexivity. Qed. @@ -80,19 +80,19 @@ Proof. simpl in H; elim H. induction l as [| r0 l Hrecl0]. simpl in H; elim H; intro. - simpl in |- *; right; symmetry in |- *; assumption. + simpl; right; symmetry ; 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. + unfold Rmin; 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 Hrecl; simpl; tauto. + apply Hrecl; simpl; tauto. apply Rle_trans with (MinRlist (cons r0 l)). apply Rmin_r. - apply Hrecl; simpl in |- *; tauto. + apply Hrecl; simpl; tauto. reflexivity. Qed. @@ -101,7 +101,7 @@ Lemma AbsList_P1 : Proof. intros; induction l as [| r l Hrecl]. elim H. - simpl in |- *; simpl in H; elim H; intro. + simpl; simpl in H; elim H; intro. left; rewrite H0; reflexivity. right; apply Hrecl; assumption. Qed. @@ -112,11 +112,11 @@ 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. + simpl; apply H; simpl; 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. + unfold Rmin; case (Rle_dec r (MinRlist (cons r0 l))); intro. + apply H; simpl; tauto. + apply Hrecl; intros; apply H; simpl; simpl in H0; tauto. reflexivity. Qed. @@ -128,10 +128,10 @@ Proof. elim H. elim H; intro. exists r; split. - simpl in |- *; tauto. + simpl; tauto. assumption. assert (H1 := Hrecl H0); elim H1; intros; elim H2; clear H2; intros; - exists x0; simpl in |- *; simpl in H2; tauto. + exists x0; simpl; simpl in H2; tauto. Qed. Lemma MaxRlist_P2 : @@ -140,9 +140,9 @@ 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))); + simpl; left; reflexivity. + change (In (Rmax r (MaxRlist (cons r0 l))) (cons r (cons r0 l))); + unfold Rmax; case (Rle_dec r (MaxRlist (cons r0 l))); intro. right; apply Hrecl; exists r0; left; reflexivity. left; reflexivity. @@ -164,7 +164,7 @@ Lemma pos_Rl_P1 : Proof. intros; induction l as [| r l Hrecl]; [ elim (lt_n_O _ H) - | simpl in |- *; case (Rlength l); [ reflexivity | intro; reflexivity ] ]. + | simpl; case (Rlength l); [ reflexivity | intro; reflexivity ] ]. Qed. Lemma pos_Rl_P2 : @@ -177,14 +177,14 @@ Proof. split; intro. elim H; intro. exists 0%nat; split; - [ simpl in |- *; apply lt_O_Sn | simpl in |- *; apply H0 ]. + [ simpl; apply lt_O_Sn | simpl; 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 ]. + [ simpl; apply lt_n_S; assumption | simpl; 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. + symmetry ; 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 ]. @@ -201,18 +201,18 @@ Proof. 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. + simpl; 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. + intros; apply H; simpl; 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. + simpl; rewrite H5; reflexivity. intros; elim (zerop i); intro. - rewrite a; simpl in |- *; assumption. + rewrite a; simpl; 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; + rewrite H8; simpl; apply H6; simpl in H7; apply lt_S_n; rewrite <- H8; assumption. Qed. @@ -271,7 +271,7 @@ Lemma RList_P0 : Proof. intros; induction l as [| r l Hrecl]; [ left; reflexivity - | simpl in |- *; case (Rle_dec r a); intro; + | simpl; case (Rle_dec r a); intro; [ right; reflexivity | left; reflexivity ] ]. Qed. @@ -279,41 +279,41 @@ Lemma RList_P1 : 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; + simpl; unfold ordered_Rlist; intros; simpl in H0; elim (lt_n_O _ H0). - simpl in |- *; case (Rle_dec r a); intro. + simpl; case (Rle_dec r a); intro. assert (H1 : ordered_Rlist l). - unfold ordered_Rlist in |- *; unfold ordered_Rlist in H; intros; + unfold ordered_Rlist; 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))); + [ simpl; 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 |- *; + | symmetry ; apply S_pred with 0%nat; apply neq_O_lt; red; 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; + assert (H2 := Hrecl H1); unfold ordered_Rlist; intros; induction i as [| i Hreci]. - simpl in |- *; assert (H3 := RList_P0 l a); elim H3; intro. + simpl; 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; + [ simpl; assumption + | rewrite H4; apply (H 0%nat); simpl; apply lt_O_Sn ]. + simpl; 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; + | apply S_pred with 0%nat; apply neq_O_lt; red; 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) ]. + unfold ordered_Rlist; intros; induction i as [| i Hreci]; + [ simpl; auto with real + | change (pos_Rl (cons r l) i <= pos_Rl (cons r l) (S i)); apply H; + simpl in H0; simpl; apply (lt_S_n _ _ H0) ]. Qed. Lemma RList_P2 : 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 ]. + [ intros; simpl; apply H + | intros; simpl; apply H; apply RList_P1; assumption ]. Qed. Lemma RList_P3 : @@ -324,11 +324,11 @@ Proof. [ 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 ] + [ exists 0%nat; split; [ apply H0 | simpl; 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 ] ]. + [ apply H1 | simpl; 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; + simpl; elim H; intros; elim H0; clear H0; intros; induction x0 as [| x0 Hrecx0]; [ left; apply H0 | right; apply Hrecl; exists x0; split; @@ -338,10 +338,10 @@ Qed. Lemma RList_P4 : 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 |- *; + intros; unfold ordered_Rlist; intros; apply (H (S i)); simpl; 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 |- *; + | symmetry ; apply S_pred with 0%nat; apply neq_O_lt; red; intro; rewrite <- H1 in H0; elim (lt_n_O _ H0) ]. Qed. @@ -350,11 +350,11 @@ Lemma RList_P5 : Proof. intros; induction l as [| r l Hrecl]; [ elim H0 - | simpl in |- *; elim H0; intro; + | simpl; 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 (H 0%nat); simpl; induction l as [| r0 l Hrecl0]; + [ elim H1 | simpl; apply lt_O_Sn ] | apply Hrecl; [ eapply RList_P4; apply H | assumption ] ] ] ]. Qed. @@ -366,13 +366,13 @@ Lemma RList_P6 : Proof. simple induction l; split; intro. intros; right; reflexivity. - unfold ordered_Rlist in |- *; intros; simpl in H0; elim (lt_n_O _ H0). + unfold ordered_Rlist; 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; + | simpl; apply Rle_trans with (pos_Rl r0 0); + [ apply (H0 0%nat); simpl; simpl in H2; apply neq_O_lt; + red; 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 @@ -380,12 +380,12 @@ Proof. | 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; + | simpl; 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 ]. + unfold ordered_Rlist; intros; apply H0; + [ apply le_n_Sn | simpl; simpl in H1; apply lt_n_S; assumption ]. Qed. Lemma RList_P7 : @@ -397,11 +397,11 @@ Proof. 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; + apply S_pred with 0%nat; apply neq_O_lt; red; 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; + | apply lt_pred_n_n; apply neq_O_lt; red; intro; rewrite <- H7 in H5; elim (lt_n_O _ H5) ]. Qed. @@ -420,7 +420,7 @@ Proof. [ left; assumption | right; left; assumption | right; right; assumption ] ] - | simpl in |- *; case (Rle_dec r a); intro; + | simpl; case (Rle_dec r a); intro; [ simpl in H0; decompose [or] H0; [ right; elim (H a x); intros; apply H3; left | left @@ -435,14 +435,14 @@ Proof. simple induction l1. intros; split; intro; [ simpl in H; right; assumption - | simpl in |- *; elim H; intro; [ elim H0 | assumption ] ]. + | simpl; elim H; intro; [ elim H0 | assumption ] ]. intros; split. - simpl in |- *; intros; elim (H (insert l2 r) x); intros; assert (H3 := H1 H0); + simpl; 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; + intro; simpl; 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 @@ -455,8 +455,8 @@ Lemma RList_P10 : Proof. intros; induction l as [| r l Hrecl]; [ reflexivity - | simpl in |- *; case (Rle_dec r a); intro; - [ simpl in |- *; rewrite Hrecl; reflexivity | reflexivity ] ]. + | simpl; case (Rle_dec r a); intro; + [ simpl; rewrite Hrecl; reflexivity | reflexivity ] ]. Qed. Lemma RList_P11 : @@ -465,7 +465,7 @@ Lemma RList_P11 : Proof. simple induction l1; [ intro; reflexivity - | intros; simpl in |- *; rewrite (H (insert l2 r)); rewrite RList_P10; + | intros; simpl; rewrite (H (insert l2 r)); rewrite RList_P10; apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; rewrite S_INR; ring ]. Qed. @@ -477,7 +477,7 @@ 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 ] ]. + [ reflexivity | simpl; apply H; apply lt_S_n; apply H0 ] ]. Qed. Lemma RList_P13 : @@ -494,13 +494,13 @@ Proof. 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. + ; apply H0; simpl; apply lt_S_n; assumption. Qed. Lemma RList_P14 : forall (l:Rlist) (a:R), Rlength (mid_Rlist l a) = Rlength l. Proof. simple induction l; intros; - [ reflexivity | simpl in |- *; rewrite (H r); reflexivity ]. + [ reflexivity | simpl; rewrite (H r); reflexivity ]. Qed. Lemma RList_P15 : @@ -511,7 +511,7 @@ Lemma RList_P15 : Proof. intros; apply Rle_antisym. induction l1 as [| r l1 Hrecl1]; - [ simpl in |- *; simpl in H1; right; symmetry in |- *; assumption + [ simpl; simpl in H1; right; symmetry ; assumption | elim (RList_P9 (cons r l1) l2 (pos_Rl (cons r l1) 0)); intros; assert (H4 : @@ -520,7 +520,7 @@ Proof. | 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 + [ simpl; simpl in H1; right; assumption | assert (H2 : In (pos_Rl (cons_ORlist (cons r l1) l2) 0) (cons_ORlist (cons r l1) l2)); @@ -528,7 +528,7 @@ Proof. (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 ] + [ reflexivity | rewrite RList_P11; simpl; 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 @@ -545,7 +545,7 @@ Lemma RList_P16 : Proof. intros; apply Rle_antisym. induction l1 as [| r l1 Hrecl1]. - simpl in |- *; simpl in H1; right; symmetry in |- *; assumption. + simpl; simpl in H1; right; symmetry ; assumption. assert (H2 : In @@ -557,7 +557,7 @@ Proof. (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 ] + split; [ reflexivity | rewrite RList_P11; simpl; apply lt_n_Sn ] | elim (RList_P9 (cons r l1) l2 (pos_Rl (cons_ORlist (cons r l1) l2) @@ -565,7 +565,7 @@ Proof. 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. + simpl; simpl in H1; right; assumption. elim (RList_P9 (cons r l1) l2 (pos_Rl (cons r l1) (pred (Rlength (cons r l1))))); intros; @@ -573,10 +573,10 @@ Proof. (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 |- *; + [ left; change (In (pos_Rl (cons r l1) (Rlength l1)) (cons r l1)); 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 ] + [ reflexivity | simpl; apply lt_n_Sn ] | assert (H5 := H3 H4); apply RList_P7; [ apply RList_P2; assumption | elim @@ -587,7 +587,7 @@ Proof. (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 ] ] ]. + split; [ reflexivity | simpl; apply lt_n_Sn ] ] ]. Qed. Lemma RList_P17 : @@ -599,14 +599,14 @@ Proof. simple induction l1. intros; elim H0. intros; induction i as [| i Hreci]. - simpl in |- *; elim H1; intro; + simpl; 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. + simpl; 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) + [ apply (H0 0%nat); simpl; simpl in H3; apply neq_O_lt; + red; 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 @@ -618,7 +618,7 @@ Proof. | 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; + | apply S_pred with 0%nat; apply neq_O_lt; red; intro; rewrite <- H5 in H3; elim (lt_n_O _ H3) ] ]. Qed. @@ -626,7 +626,7 @@ Lemma RList_P18 : forall (l:Rlist) (f:R -> R), Rlength (app_Rlist l f) = Rlength l. Proof. simple induction l; intros; - [ reflexivity | simpl in |- *; rewrite H; reflexivity ]. + [ reflexivity | simpl; rewrite H; reflexivity ]. Qed. Lemma RList_P19 : @@ -666,7 +666,7 @@ Lemma RList_P23 : Rlength (cons_Rlist l1 l2) = (Rlength l1 + Rlength l2)%nat. Proof. simple induction l1; - [ intro; reflexivity | intros; simpl in |- *; rewrite H; reflexivity ]. + [ intro; reflexivity | intros; simpl; rewrite H; reflexivity ]. Qed. Lemma RList_P24 : @@ -685,9 +685,9 @@ Proof. [ 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; + | simpl; 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; + | simpl; apply INR_eq; do 3 rewrite S_INR; do 2 rewrite plus_INR; rewrite S_INR; ring ]. Qed. @@ -699,27 +699,27 @@ Lemma RList_P25 : ordered_Rlist (cons_Rlist l1 l2). Proof. simple induction l1. - intros; simpl in |- *; assumption. + intros; simpl; assumption. simple induction r0. - intros; simpl in |- *; simpl in H2; unfold ordered_Rlist in |- *; intros; + intros; simpl; simpl in H2; unfold ordered_Rlist; 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; + simpl; assumption. + change (pos_Rl l2 i <= pos_Rl l2 (S i)); 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; + | apply S_pred with 0%nat; apply neq_O_lt; red; 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; + unfold ordered_Rlist; intros; simpl in H4; induction i as [| i Hreci]. - simpl in |- *; apply (H1 0%nat); simpl in |- *; apply lt_O_Sn. + simpl; apply (H1 0%nat); simpl; 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. + pos_Rl (cons_Rlist (cons r1 r2) l2) (S i)); + apply (H i); simpl; apply lt_S_n; assumption. Qed. Lemma RList_P26 : @@ -738,13 +738,13 @@ Lemma RList_P27 : 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 ]. + [ reflexivity | simpl; rewrite (H l2 l3); reflexivity ]. Qed. Lemma RList_P28 : forall l:Rlist, cons_Rlist l nil = l. Proof. simple induction l; - [ reflexivity | intros; simpl in |- *; rewrite H; reflexivity ]. + [ reflexivity | intros; simpl; rewrite H; reflexivity ]. Qed. Lemma RList_P29 : @@ -759,23 +759,23 @@ Proof. 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. + rewrite <- minus_n_n; simpl; 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. + simpl; assumption. + rewrite RList_P23; rewrite plus_comm; simpl; apply lt_n_Sn. replace (S m - Rlength l1)%nat with (S (S m - S (Rlength l1))). - rewrite H3; simpl in |- *; + rewrite H3; simpl; 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; + rewrite RList_P23; rewrite plus_comm; simpl; rewrite <- H3; apply le_n_S; assumption. - repeat rewrite RList_P23; simpl in |- *; rewrite RList_P23 in H1; + repeat rewrite RList_P23; simpl; 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. + simpl; rewrite plus_comm; apply H1. rewrite RList_P23; rewrite plus_comm; reflexivity. - change (S (m - Rlength l1) = (S m - Rlength l1)%nat) in |- *; + change (S (m - Rlength l1) = (S m - Rlength l1)%nat); apply minus_Sn_m; assumption. replace (cons r r0) with (cons_Rlist (cons r nil) r0); - [ symmetry in |- *; apply RList_P27 | reflexivity ]. + [ symmetry ; apply RList_P27 | reflexivity ]. Qed. diff --git a/theories/Reals/ROrderedType.v b/theories/Reals/ROrderedType.v index 0a8d89c7..726f1204 100644 --- a/theories/Reals/ROrderedType.v +++ b/theories/Reals/ROrderedType.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/R_Ifp.v b/theories/Reals/R_Ifp.v index 9e04a7da..8364e986 100644 --- a/theories/Reals/R_Ifp.v +++ b/theories/Reals/R_Ifp.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -13,7 +13,7 @@ Require Import Rbase. Require Import Omega. -Open Local Scope R_scope. +Local Open Scope R_scope. (*********************************************************) (** * Fractional part *) @@ -45,7 +45,7 @@ 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; + intro; generalize H1; pattern 1 at 1; rewrite H; intro; clear H H1; rewrite <- (plus_IZR z 1) in H2; apply (tech_up r (z + 1)); auto with zarith real. Qed. @@ -53,12 +53,12 @@ Qed. (**********) Lemma fp_R0 : frac_part 0 = 0. Proof. - unfold frac_part in |- *; unfold Int_part in |- *; elim (archimed 0); intros; - unfold Rminus in |- *; elim (Rplus_ne (- IZR (up 0 - 1))); + unfold frac_part; unfold Int_part; elim (archimed 0); intros; + unfold Rminus; 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))); + rewrite (Rminus_diag_eq (IZR 1) (IZR 1) (eq_refl (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); @@ -81,21 +81,21 @@ Qed. (**********) Lemma base_fp : forall r:R, frac_part r >= 0 /\ frac_part r < 1. Proof. - intro; unfold frac_part in |- *; unfold Int_part in |- *; split. + intro; unfold frac_part; unfold Int_part; split. (*sup a O*) cut (r - IZR (up r) >= -1). - rewrite <- Z_R_minus; simpl in |- *; intro; unfold Rminus in |- *; + rewrite <- Z_R_minus; simpl; intro; unfold Rminus; rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; - fold (r - IZR (up r)) in |- *; fold (r - IZR (up r) - -1) in |- *; + fold (r - IZR (up r)); fold (r - IZR (up r) - -1); 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 <- Z_R_minus; simpl; intro; unfold Rminus; 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 |- *; + fold (r - IZR (up r)); rewrite Ropp_involutive; + elim (Rplus_ne 1); intros a b; pattern 1 at 2; 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; @@ -110,8 +110,8 @@ Qed. Lemma base_Int_part : 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 |- *. + intro; unfold Int_part; elim (archimed r); intros. + split; rewrite <- (Z_R_minus (up r) 1); simpl. 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; @@ -130,31 +130,31 @@ Proof. Qed. (**********) -Lemma Int_part_INR : forall n:nat, Int_part (INR n) = Z_of_nat n. +Lemma Int_part_INR : forall n:nat, Int_part (INR n) = Z.of_nat n. 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)). + intros n; unfold Int_part. + cut (up (INR n) = (Z.of_nat n + Z.of_nat 1)%Z). + intros H'; rewrite H'; simpl; ring. + symmetry; 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. + rewrite Z.add_comm; rewrite <- Znat.Nat2Z.inj_add; simpl; auto. + rewrite plus_IZR; simpl; 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. Proof. - unfold frac_part in |- *; intros; split with (Int_part r); + unfold frac_part; 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. Proof. - red in |- *; intros; rewrite <- H0 in H; generalize fp_R0; intro; + red; intros; rewrite <- H0 in H; generalize fp_R0; intro; auto with zarith real. Qed. @@ -243,7 +243,7 @@ Proof. 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 |- *; + intros; clear H H0; unfold Int_part at 1; omega. Qed. @@ -336,7 +336,7 @@ Proof. 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 |- *; + intros; clear H0 H1; unfold Int_part at 1; omega. Qed. @@ -346,9 +346,9 @@ Lemma Rminus_fp1 : 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); + intros; unfold frac_part; generalize (Rminus_Int_part1 r1 r2 H); intro; rewrite H0; rewrite <- (Z_R_minus (Int_part r1) (Int_part r2)); - unfold Rminus in |- *; + unfold Rminus; 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))); @@ -366,17 +366,17 @@ Lemma Rminus_fp2 : 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); + intros; unfold frac_part; 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 |- *; + unfold Rminus; 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 (Ropp_involutive (IZR (Int_part r2))); simpl; 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))); @@ -451,7 +451,7 @@ Proof. 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. + intro; clear H H0; unfold Int_part at 1; omega. Qed. (**********) @@ -514,7 +514,7 @@ Proof. 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 |- *; + intro; clear H0 H1; unfold Int_part at 1; omega. Qed. @@ -524,17 +524,17 @@ Lemma plus_frac_part1 : 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; + intros; unfold frac_part; 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 (plus_IZR (Int_part r1) (Int_part r2)); simpl; + unfold Rminus at 3 4; 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 |- *; + unfold Rminus; 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); @@ -547,14 +547,14 @@ Lemma plus_frac_part2 : 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; + intros; unfold frac_part; 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 |- *; + unfold Rminus at 2 3; 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. + unfold Rminus; trivial with zarith real. Qed. diff --git a/theories/Reals/R_sqr.v b/theories/Reals/R_sqr.v index f23b9f17..d6e18d9d 100644 --- a/theories/Reals/R_sqr.v +++ b/theories/Reals/R_sqr.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,13 +8,13 @@ Require Import Rbase. Require Import Rbasic_fun. -Open Local Scope R_scope. +Local Open Scope R_scope. (****************************************************) (** Rsqr : some results *) (****************************************************) -Ltac ring_Rsqr := unfold Rsqr in |- *; ring. +Ltac ring_Rsqr := unfold Rsqr; ring. Lemma Rsqr_neg : forall x:R, Rsqr x = Rsqr (- x). Proof. @@ -48,25 +48,25 @@ Qed. Lemma Rsqr_gt_0_0 : forall x:R, 0 < Rsqr x -> x <> 0. Proof. - intros; red in |- *; intro; rewrite H0 in H; rewrite Rsqr_0 in H; + intros; red; 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. Proof. intros; case (Rtotal_order 0 x); intro; - [ unfold Rsqr in |- *; apply Rmult_lt_0_compat; assumption + [ unfold Rsqr; apply Rmult_lt_0_compat; assumption | elim H0; intro; - [ elim H; symmetry in |- *; exact H1 + [ elim H; symmetry ; exact H1 | rewrite Rsqr_neg; generalize (Ropp_lt_gt_contravar x 0 H1); - rewrite Ropp_0; intro; unfold Rsqr in |- *; + rewrite Ropp_0; intro; unfold Rsqr; apply Rmult_lt_0_compat; assumption ] ]. Qed. Lemma Rsqr_div : forall x y:R, y <> 0 -> Rsqr (x / y) = Rsqr x / Rsqr y. Proof. - intros; unfold Rsqr in |- *. - unfold Rdiv in |- *. + intros; unfold Rsqr. + unfold Rdiv. rewrite Rinv_mult_distr. repeat rewrite Rmult_assoc. apply Rmult_eq_compat_l. @@ -80,7 +80,7 @@ Qed. Lemma Rsqr_eq_0 : forall x:R, Rsqr x = 0 -> x = 0. Proof. - unfold Rsqr in |- *; intros; generalize (Rmult_integral x x H); intro; + unfold Rsqr; intros; generalize (Rmult_integral x x H); intro; elim H0; intro; assumption. Qed. @@ -122,7 +122,7 @@ Qed. Lemma Rsqr_incr_1 : forall x y:R, x <= y -> 0 <= x -> 0 <= y -> Rsqr x <= Rsqr y. Proof. - intros; unfold Rsqr in |- *; apply Rmult_le_compat; assumption. + intros; unfold Rsqr; apply Rmult_le_compat; assumption. Qed. Lemma Rsqr_incrst_0 : @@ -140,7 +140,7 @@ Qed. Lemma Rsqr_incrst_1 : 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. + intros; unfold Rsqr; apply Rmult_le_0_lt_compat; assumption. Qed. Lemma Rsqr_neg_pos_le_0 : @@ -183,7 +183,7 @@ Qed. Lemma Rsqr_abs : forall x:R, Rsqr x = Rsqr (Rabs x). Proof. - intro; unfold Rabs in |- *; case (Rcase_abs x); intro; + intro; unfold Rabs; case (Rcase_abs x); intro; [ apply Rsqr_neg | reflexivity ]. Qed. @@ -220,7 +220,7 @@ Qed. Lemma Rsqr_eq_abs_0 : forall x y:R, Rsqr x = Rsqr y -> Rabs x = Rabs y. Proof. - intros; unfold Rabs in |- *; case (Rcase_abs x); case (Rcase_abs y); intros. + intros; unfold Rabs; 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; @@ -288,7 +288,7 @@ Qed. Lemma Rsqr_inv : forall x:R, x <> 0 -> Rsqr (/ x) = / Rsqr x. Proof. - intros; unfold Rsqr in |- *. + intros; unfold Rsqr. rewrite Rinv_mult_distr; try reflexivity || assumption. Qed. @@ -302,7 +302,7 @@ Proof. repeat rewrite Rmult_plus_distr_l. repeat rewrite Rplus_assoc. apply Rplus_eq_compat_l. - unfold Rdiv, Rminus in |- *. + unfold Rdiv, Rminus. replace (2 * 1 + 2 * 1) with 4; [ idtac | ring ]. rewrite (Rmult_plus_distr_r (4 * a * c) (- Rsqr b) (/ (4 * a))). rewrite Rsqr_mult. @@ -332,7 +332,7 @@ Proof. rewrite (Rmult_comm x). apply Rplus_eq_compat_l. rewrite (Rmult_comm (/ a)). - unfold Rsqr in |- *; repeat rewrite Rmult_assoc. + unfold Rsqr; repeat rewrite Rmult_assoc. rewrite <- Rinv_l_sym. rewrite Rmult_1_r. ring. @@ -357,7 +357,7 @@ Proof. 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; + right; apply Rminus_diag_uniq; unfold Rminus; rewrite Ropp_involutive; assumption. ring. Qed. diff --git a/theories/Reals/R_sqrt.v b/theories/Reals/R_sqrt.v index 2c5ede23..2d9419bd 100644 --- a/theories/Reals/R_sqrt.v +++ b/theories/Reals/R_sqrt.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -9,7 +9,7 @@ Require Import Rbase. Require Import Rfunctions. Require Import Rsqrt_def. -Open Local Scope R_scope. +Local Open Scope R_scope. (** * Continuous extension of Rsqrt on R *) Definition sqrt (x:R) : R := @@ -36,7 +36,7 @@ Qed. Lemma sqrt_sqrt : forall x:R, 0 <= x -> sqrt x * sqrt x = x. Proof. intros. - unfold sqrt in |- *. + unfold sqrt. case (Rcase_abs x); intro. elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ r H)). rewrite Rsqrt_Rsqrt; reflexivity. @@ -44,7 +44,7 @@ Qed. Lemma sqrt_0 : sqrt 0 = 0. Proof. - apply Rsqr_eq_0; unfold Rsqr in |- *; apply sqrt_sqrt; right; reflexivity. + apply Rsqr_eq_0; unfold Rsqr; apply sqrt_sqrt; right; reflexivity. Qed. Lemma sqrt_1 : sqrt 1 = 1. @@ -52,7 +52,7 @@ Proof. apply (Rsqr_inj (sqrt 1) 1); [ apply sqrt_positivity; left | left - | unfold Rsqr in |- *; rewrite sqrt_sqrt; [ ring | left ] ]; + | unfold Rsqr; rewrite sqrt_sqrt; [ ring | left ] ]; apply Rlt_0_1. Qed. @@ -73,7 +73,7 @@ Proof. intros; apply Rsqr_inj; [ apply (sqrt_positivity x H) | assumption - | unfold Rsqr in |- *; rewrite H1; apply (sqrt_sqrt x H) ]. + | unfold Rsqr; rewrite H1; apply (sqrt_sqrt x H) ]. Qed. Lemma sqrt_def : forall x:R, 0 <= x -> sqrt x * sqrt x = x. @@ -86,12 +86,12 @@ 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)). + unfold Rsqr; apply (sqrt_sqrt (Rsqr x) (Rle_0_sqr x)). Qed. Lemma sqrt_Rsqr : forall x:R, 0 <= x -> sqrt (Rsqr x) = x. Proof. - intros; unfold Rsqr in |- *; apply sqrt_square; assumption. + intros; unfold Rsqr; apply sqrt_square; assumption. Qed. Lemma sqrt_Rsqr_abs : forall x:R, sqrt (Rsqr x) = Rabs x. @@ -101,7 +101,7 @@ Qed. Lemma Rsqr_sqrt : forall x:R, 0 <= x -> Rsqr (sqrt x) = x. Proof. - intros x H1; unfold Rsqr in |- *; apply (sqrt_sqrt x H1). + intros x H1; unfold Rsqr; apply (sqrt_sqrt x H1). Qed. Lemma sqrt_mult_alt : @@ -300,7 +300,7 @@ 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 |- *; + intro H4; elim H4; intros H5 H6; rewrite <- H5; pattern x at 1; 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. @@ -310,7 +310,7 @@ Lemma sqrt_cauchy : 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 |- *; + [ rewrite Rsqr_mult; repeat rewrite Rsqr_sqrt; unfold Rsqr; [ 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 @@ -319,11 +319,11 @@ Proof. 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; + [ pattern (2 * a * b * c * d) at 1; 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)); - [ apply Rle_0_sqr | unfold Rsqr in |- *; ring ] + [ apply Rle_0_sqr | unfold Rsqr; ring ] | ring ] | ring ] | ring ] @@ -355,16 +355,16 @@ Lemma Rsqr_sol_eq_0_1 : 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 |- *; + unfold sol_x1 in H1; unfold Delta in H1; rewrite H1; unfold Rdiv; repeat rewrite Rsqr_mult; rewrite Rsqr_plus; rewrite <- Rsqr_neg; rewrite Rsqr_sqrt. rewrite Rsqr_inv. - unfold Rsqr in |- *; repeat rewrite Rinv_mult_distr. + unfold Rsqr; 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). + pattern 2 at 2; rewrite (Rmult_comm 2). repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. rewrite Rmult_1_r. rewrite @@ -376,7 +376,7 @@ Proof. (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. + unfold Rminus; 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. @@ -407,17 +407,17 @@ Proof. 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 |- *; + unfold sol_x2 in H1; unfold Delta in H1; rewrite H1; unfold Rdiv; repeat rewrite Rsqr_mult; rewrite Rsqr_minus; rewrite <- Rsqr_neg; rewrite Rsqr_sqrt. rewrite Rsqr_inv. - unfold Rsqr in |- *; repeat rewrite Rinv_mult_distr; + unfold Rsqr; 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 Rmult_1_r; unfold Rminus; rewrite Rmult_plus_distr_r. rewrite Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc; - pattern 2 at 2 in |- *; rewrite (Rmult_comm 2). + pattern 2 at 2; rewrite (Rmult_comm 2). repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym. rewrite Rmult_1_r; rewrite @@ -480,23 +480,23 @@ Proof. 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 |- *; + left; unfold sol_x1; 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. + intro; rewrite H6; unfold Rdiv; ring. ring. - right; unfold sol_x2 in |- *; + right; unfold sol_x2; 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. + intro; rewrite H6; unfold Rdiv; ring. ring. rewrite Rsqr_div. rewrite Rsqr_sqrt. - unfold Rdiv in |- *. + unfold Rdiv. repeat rewrite Rmult_assoc. rewrite (Rmult_comm (/ a)). rewrite Rmult_assoc. @@ -510,9 +510,9 @@ Proof. assumption. apply prod_neq_R0; [ discrR | apply (cond_nonzero a) ]. rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym. - symmetry in |- *; apply Rmult_1_l. + symmetry ; apply Rmult_1_l. apply (cond_nonzero a). - unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse. + unfold Rdiv; rewrite <- Ropp_mult_distr_l_reverse. rewrite Ropp_minus_distr. reflexivity. reflexivity. diff --git a/theories/Reals/Ranalysis.v b/theories/Reals/Ranalysis.v index 01715cf3..ad86a197 100644 --- a/theories/Reals/Ranalysis.v +++ b/theories/Reals/Ranalysis.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -26,775 +26,4 @@ Require Export RList. Require Export Sqrt_reg. Require Export Ranalysis4. Require Export Rpower. -Open Local Scope R_scope. - -Axiom AppVar : R. - -(**********) -Ltac intro_hyp_glob trm := - match constr:trm with - | (?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 - end - | (?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 - end - | (?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 - end - | (?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 - | |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2 - | |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2 - | _ => idtac - end - | (- ?X1)%F => - match goal with - | |- (derivable _) => intro_hyp_glob X1 - | |- (continuity _) => intro_hyp_glob X1 - | _ => idtac - end - | (/ ?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 => - 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 - end. - -(**********) -Ltac intro_hyp_pt trm pt := - match constr:trm with - | (?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 _ _ _ = _) => - intro_hyp_pt X1 pt; intro_hyp_pt X2 pt - | _ => idtac - end - | (?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 _ _ _ = _) => - intro_hyp_pt X1 pt; intro_hyp_pt X2 pt - | _ => idtac - end - | (?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 _ _ _ = _) => - intro_hyp_pt X1 pt; intro_hyp_pt X2 pt - | _ => idtac - end - | (?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 - | |- (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 _ _) => - let pt_f1 := eval cbv beta in (X2 pt) in - (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 - end - | (- ?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 - end - | (/ ?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 - | |- (derivable_pt _ _) => cut (0 < pt); [ intro | try assumption ] - | |- (continuity_pt _ _) => - cut (0 <= pt); [ intro | try assumption ] - | |- (derive_pt _ _ _ = _) => - cut (0 < pt); [ intro | try assumption ] - | _ => idtac - end - | Rabs => - match goal with - | |- (derivable_pt _ _) => - cut (pt <> 0); [ intro | try assumption ] - | _ => idtac - end - | ?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 - end. - -(**********) -Ltac is_diff_pt := - match goal with - | |- (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 _) _) => - unfold pow_fct in |- *; apply derivable_pt_pow - | |- (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) => - 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 |- * - (* regles de differentiabilite *) - (* PLUS *) - | |- (derivable_pt (?X1 + ?X2) ?X3) => - apply (derivable_pt_plus X1 X2 X3); is_diff_pt - (* MOINS *) - | |- (derivable_pt (?X1 - ?X2) ?X3) => - apply (derivable_pt_minus X1 X2 X3); is_diff_pt - (* OPPOSE *) - | |- (derivable_pt (- ?X1) ?X2) => - apply (derivable_pt_opp X1 X2); - is_diff_pt - (* MULTIPLICATION PAR UN SCALAIRE *) - | |- (derivable_pt (mult_real_fct ?X1 ?X2) ?X3) => - apply (derivable_pt_scal X2 X1 X3); is_diff_pt - (* MULTIPLICATION *) - | |- (derivable_pt (?X1 * ?X2) ?X3) => - apply (derivable_pt_mult X1 X2 X3); is_diff_pt - (* DIVISION *) - | |- (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) => - - (* INVERSION *) - 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) => - - (* COMPOSITION *) - 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) => - cut (derivable X1); [ intro HypDDPT; apply HypDDPT | assumption ] - | |- (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 |- * - end. - -(**********) -Ltac is_diff_glob := - match goal with - | |- (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 _)) => - unfold pow_fct in |- *; - apply derivable_pow - (* regles de differentiabilite *) - (* PLUS *) - | |- (derivable (?X1 + ?X2)) => - apply (derivable_plus X1 X2); is_diff_glob - (* MOINS *) - | |- (derivable (?X1 - ?X2)) => - apply (derivable_minus X1 X2); is_diff_glob - (* OPPOSE *) - | |- (derivable (- ?X1)) => - apply (derivable_opp X1); - is_diff_glob - (* MULTIPLICATION PAR UN SCALAIRE *) - | |- (derivable (mult_real_fct ?X1 ?X2)) => - apply (derivable_scal X2 X1); is_diff_glob - (* MULTIPLICATION *) - | |- (derivable (?X1 * ?X2)) => - apply (derivable_mult X1 X2); is_diff_glob - (* DIVISION *) - | |- (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)) => - - (* INVERSION *) - 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 _)) => - - (* COMPOSITION *) - unfold derivable in |- *; intro; try is_diff_pt - | |- (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 _) => - 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 |- * - end. - -(**********) -Ltac is_cont_pt := - match goal with - | |- (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_id X1) - | |- (continuity_pt (fct_cte _) _) => - apply derivable_continuous_pt; apply derivable_pt_const - | |- (continuity_pt sin _) => - apply derivable_continuous_pt; apply derivable_pt_sin - | |- (continuity_pt cos _) => - apply derivable_continuous_pt; apply derivable_pt_cos - | |- (continuity_pt sinh _) => - apply derivable_continuous_pt; apply derivable_pt_sinh - | |- (continuity_pt cosh _) => - apply derivable_continuous_pt; apply derivable_pt_cosh - | |- (continuity_pt exp _) => - apply derivable_continuous_pt; apply derivable_pt_exp - | |- (continuity_pt (pow_fct _) _) => - unfold pow_fct in |- *; apply derivable_continuous_pt; - 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) => - apply (Rcontinuity_abs X1) - (* regles de differentiabilite *) - (* PLUS *) - | |- (continuity_pt (?X1 + ?X2) ?X3) => - apply (continuity_pt_plus X1 X2 X3); is_cont_pt - (* MOINS *) - | |- (continuity_pt (?X1 - ?X2) ?X3) => - apply (continuity_pt_minus X1 X2 X3); is_cont_pt - (* OPPOSE *) - | |- (continuity_pt (- ?X1) ?X2) => - apply (continuity_pt_opp X1 X2); - is_cont_pt - (* MULTIPLICATION PAR UN SCALAIRE *) - | |- (continuity_pt (mult_real_fct ?X1 ?X2) ?X3) => - apply (continuity_pt_scal X2 X1 X3); is_cont_pt - (* MULTIPLICATION *) - | |- (continuity_pt (?X1 * ?X2) ?X3) => - apply (continuity_pt_mult X1 X2 X3); is_cont_pt - (* DIVISION *) - | |- (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) => - - (* 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) => - - (* COMPOSITION *) - 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) => - cut (continuity X1); [ intro HypDDPT; apply HypDDPT | assumption ] - | _:(derivable_pt ?X1 ?X2) |- (continuity_pt ?X1 ?X2) => - apply derivable_continuous_pt; assumption - | _:(derivable ?X1) |- (continuity_pt ?X1 ?X2) => - cut (continuity X1); - [ 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 |- * - end. - -(**********) -Ltac is_cont_glob := - match goal with - | |- (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_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 _)) => - unfold pow_fct in |- *; apply derivable_continuous; apply derivable_pow - | |- (continuity sinh) => - apply derivable_continuous; apply derivable_sinh - | |- (continuity cosh) => - apply derivable_continuous; apply derivable_cosh - | |- (continuity Rabs) => - apply Rcontinuity_abs - (* regles de continuite *) - (* PLUS *) - | |- (continuity (?X1 + ?X2)) => - apply (continuity_plus X1 X2); - try is_cont_glob || assumption - (* MOINS *) - | |- (continuity (?X1 - ?X2)) => - apply (continuity_minus X1 X2); - try is_cont_glob || assumption - (* OPPOSE *) - | |- (continuity (- ?X1)) => - apply (continuity_opp X1); try is_cont_glob || assumption - (* INVERSE *) - | |- (continuity (/ ?X1)) => - apply (continuity_inv X1); - try is_cont_glob || assumption - (* MULTIPLICATION PAR UN SCALAIRE *) - | |- (continuity (mult_real_fct ?X1 ?X2)) => - apply (continuity_scal X2 X1); - try is_cont_glob || assumption - (* MULTIPLICATION *) - | |- (continuity (?X1 * ?X2)) => - apply (continuity_mult X1 X2); - try is_cont_glob || assumption - (* DIVISION *) - | |- (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 _)) => - - (* COMPOSITION *) - 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 _) => - intro HypTruE; clear HypTruE; is_cont_glob - | _:(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 |- * - end. - -(**********) -Ltac rew_term trm := - match constr:trm with - | (?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 - | _ => constr:(p1 + p2)%F - 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 - | _ => constr:(p1 - p2)%F - 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) => - 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) => - 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 - | _ => constr:(p1 * p2)%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) => - 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) => - 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) => - 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) - end. - -(**********) -Ltac deriv_proof trm pt := - match constr:trm with - | (?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 => - 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 => - 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 => - match goal with - | 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 - end - | (/ ?X1)%F => - match goal with - | id:(?X1 pt <> 0) |- _ => - let p1 := deriv_proof X1 pt in - constr:(derivable_pt_inv X1 pt p1 id) - | _ => constr:False - end - | (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 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 => - match goal with - | id:(0 < pt) |- _ => constr:(derivable_pt_sqrt pt id) - | _ => constr:False - end - | (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 - end. - -(**********) -Ltac simplify_derive trm pt := - match constr:trm with - | (?X1 + ?X2)%F => - try rewrite derive_pt_plus; simplify_derive X1 pt; - simplify_derive X2 pt - | (?X1 - ?X2)%F => - try rewrite derive_pt_minus; simplify_derive X1 pt; - simplify_derive X2 pt - | (?X1 * ?X2)%F => - try rewrite derive_pt_mult; simplify_derive X1 pt; - simplify_derive X2 pt - | (?X1 / ?X2)%F => - try rewrite derive_pt_div; simplify_derive X1 pt; simplify_derive X2 pt - | (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_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 => - 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 - end. - -(**********) -Ltac reg := - match goal with - | |- (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 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 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 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 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 |- *; ring || ring_simplify - | try apply pr_nu ]) || is_diff_pt) - end. +Require Export Ranalysis_reg.
\ No newline at end of file diff --git a/theories/Reals/Ranalysis1.v b/theories/Reals/Ranalysis1.v index 3075bee8..2f54ee94 100644 --- a/theories/Reals/Ranalysis1.v +++ b/theories/Reals/Ranalysis1.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -10,7 +10,7 @@ Require Import Rbase. Require Import Rfunctions. Require Export Rlimit. Require Export Rderiv. -Open Local Scope R_scope. +Local Open Scope R_scope. Implicit Type f : R -> R. (****************************************************) @@ -43,7 +43,7 @@ Notation "- x" := (opp_fct x) : Rfun_scope. Infix "*" := mult_fct : Rfun_scope. Infix "-" := minus_fct : Rfun_scope. Infix "/" := div_fct : Rfun_scope. -Notation Local "f1 'o' f2" := (comp f1 f2) +Local Notation "f1 'o' f2" := (comp f1 f2) (at level 20, right associativity) : Rfun_scope. Notation "/ x" := (inv_fct x) : Rfun_scope. @@ -82,14 +82,14 @@ Lemma continuity_pt_plus : 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; + unfold continuity_pt, plus_fct; unfold continue_in; intros; apply limit_plus; assumption. Qed. Lemma continuity_pt_opp : forall f (x0:R), continuity_pt f x0 -> continuity_pt (- f) x0. Proof. - unfold continuity_pt, opp_fct in |- *; unfold continue_in in |- *; intros; + unfold continuity_pt, opp_fct; unfold continue_in; intros; apply limit_Ropp; assumption. Qed. @@ -97,7 +97,7 @@ Lemma continuity_pt_minus : 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; + unfold continuity_pt, minus_fct; unfold continue_in; intros; apply limit_minus; assumption. Qed. @@ -105,17 +105,17 @@ Lemma continuity_pt_mult : 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; + unfold continuity_pt, mult_fct; unfold continue_in; intros; apply limit_mul; assumption. Qed. Lemma continuity_pt_const : forall f (x0:R), constant f -> continuity_pt f x0. Proof. - unfold constant, continuity_pt in |- *; unfold continue_in in |- *; - unfold limit1_in in |- *; unfold limit_in in |- *; + unfold constant, continuity_pt; unfold continue_in; + unfold limit1_in; unfold limit_in; intros; exists 1; split; [ apply Rlt_0_1 - | intros; generalize (H x x0); intro; rewrite H2; simpl in |- *; + | intros; generalize (H x x0); intro; rewrite H2; simpl; rewrite R_dist_eq; assumption ]. Qed. @@ -123,9 +123,9 @@ Lemma continuity_pt_scal : 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 |- *; + unfold continuity_pt, mult_real_fct; unfold continue_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. + unfold limit1_in; unfold limit_in; intros; exists 1; split. apply Rlt_0_1. intros; rewrite R_dist_eq; assumption. assumption. @@ -136,9 +136,9 @@ Lemma continuity_pt_inv : Proof. intros. replace (/ f)%F with (fun x:R => / f x). - unfold continuity_pt in |- *; unfold continue_in in |- *; intros; + unfold continuity_pt; unfold continue_in; intros; apply limit_inv; assumption. - unfold inv_fct in |- *; reflexivity. + unfold inv_fct; reflexivity. Qed. Lemma div_eq_inv : forall f1 f2, (f1 / f2)%F = (f1 * / f2)%F. @@ -159,8 +159,8 @@ Lemma continuity_pt_comp : 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 |- *. + unfold continuity_pt; unfold continue_in; intros; + unfold comp. cut (limit1_in (fun x0:R => f2 (f1 x0)) (Dgf (D_x no_cond x) (D_x no_cond (f1 x)) f1) ( @@ -170,23 +170,23 @@ Proof. 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. + unfold limit1_in; unfold limit_in; unfold dist; + simpl; unfold R_dist; 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; + rewrite H6; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. elim H4; intros; apply H8. split. - unfold Dgf, D_x, no_cond in |- *. + unfold Dgf, D_x, no_cond. split. split. trivial. - elim H5; unfold D_x, no_cond in |- *; intros. + elim H5; unfold D_x, no_cond; intros. elim H9; intros; assumption. split. trivial. @@ -198,44 +198,44 @@ Qed. Lemma continuity_plus : forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 + f2). Proof. - unfold continuity in |- *; intros; + unfold continuity; intros; apply (continuity_pt_plus f1 f2 x (H x) (H0 x)). Qed. Lemma continuity_opp : forall f, continuity f -> continuity (- f). Proof. - unfold continuity in |- *; intros; apply (continuity_pt_opp f x (H x)). + unfold continuity; intros; apply (continuity_pt_opp f x (H x)). Qed. Lemma continuity_minus : forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 - f2). Proof. - unfold continuity in |- *; intros; + unfold continuity; 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). Proof. - unfold continuity in |- *; intros; + unfold continuity; intros; apply (continuity_pt_mult f1 f2 x (H x) (H0 x)). Qed. Lemma continuity_const : forall f, constant f -> continuity f. Proof. - unfold continuity in |- *; intros; apply (continuity_pt_const f x H). + unfold continuity; intros; apply (continuity_pt_const f x H). Qed. Lemma continuity_scal : 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)). + unfold continuity; 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). Proof. - unfold continuity in |- *; intros; apply (continuity_pt_inv f x (H x) (H0 x)). + unfold continuity; intros; apply (continuity_pt_inv f x (H x) (H0 x)). Qed. Lemma continuity_div : @@ -243,14 +243,14 @@ Lemma continuity_div : continuity f1 -> continuity f2 -> (forall x:R, f2 x <> 0) -> continuity (f1 / f2). Proof. - unfold continuity in |- *; intros; + unfold continuity; 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). Proof. - unfold continuity in |- *; intros. + unfold continuity; intros. apply (continuity_pt_comp f1 f2 x (H x) (H0 (f1 x))). Qed. @@ -307,23 +307,23 @@ Proof. 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). + unfold adhDa; intros; exists (alp / 2). split. - unfold Rdiv in |- *; apply prod_neq_R0. - red in |- *; intro; rewrite H2 in H1; elim (Rlt_irrefl _ H1). + unfold Rdiv; apply prod_neq_R0. + red; 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. + unfold R_dist; unfold Rminus; rewrite Ropp_0; + rewrite Rplus_0_r; unfold Rdiv; 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); + pattern alp at 1; 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 |- *; + symmetry ; apply Rabs_right; left; assumption. + symmetry ; apply Rabs_right; left; change (0 < / 2); apply Rinv_0_lt_compat; prove_sup0. Qed. @@ -332,14 +332,14 @@ Lemma uniqueness_step2 : 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. + unfold derivable_pt_lim; intros; unfold limit1_in; + unfold limit_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. + simpl; unfold R_dist; intros. elim H3; intros. apply H2; [ assumption @@ -352,15 +352,15 @@ Lemma uniqueness_step3 : 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. + unfold limit1_in, derivable_pt_lim; unfold limit_in; + unfold dist; simpl; intros. elim (H eps H0). intros; elim H1; intros. exists (mkposreal x0 H2). - simpl in |- *; intros; unfold R_dist in H3; apply (H3 h). + simpl; intros; unfold R_dist in H3; apply (H3 h). split; [ assumption - | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; assumption ]. + | unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; assumption ]. Qed. Lemma uniqueness_limite : @@ -383,8 +383,8 @@ Proof. assumption. intro; assert (H1 := proj2_sig 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. + unfold derive_pt; unfold derivable_pt_abs. + symmetry ; assumption. Qed. (**********) @@ -414,25 +414,25 @@ Lemma derive_pt_D_in : 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. + unfold D_in; unfold limit1_in; unfold limit_in; + simpl; unfold R_dist; intros. apply derive_pt_eq_0. - unfold derivable_pt_lim in |- *. + unfold derivable_pt_lim. 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 + [ unfold D_x; split; + [ unfold no_cond; 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 |- *; + unfold D_in; unfold limit1_in; unfold limit_in; + unfold dist; simpl; unfold R_dist; intros. elim (H0 eps H1); intros alpha H2; exists (pos alpha); split. apply (cond_pos alpha). @@ -448,24 +448,24 @@ Lemma derivable_pt_lim_D_in : 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 |- *. + unfold D_in; unfold limit1_in; unfold limit_in; + simpl; unfold R_dist; intros. + unfold derivable_pt_lim. 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 + [ unfold D_x; split; + [ unfold no_cond; 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 |- *; + unfold D_in; unfold limit1_in; unfold limit_in; + unfold dist; simpl; unfold R_dist; intros. elim (H eps H0); intros alpha H2; exists (pos alpha); split. apply (cond_pos alpha). @@ -486,7 +486,7 @@ Lemma derivable_derive : forall f (x:R) (pr:derivable_pt f x), exists l : R, derive_pt f x pr = l. Proof. intros; exists (proj1_sig pr). - unfold derive_pt in |- *; reflexivity. + unfold derive_pt; reflexivity. Qed. Theorem derivable_continuous_pt : @@ -501,14 +501,14 @@ Proof. generalize (derive_pt_D_in f (fct_cte l) x); intro. elim (H2 X); intros. generalize (H4 H1); intro. - unfold continuity_pt in |- *. + unfold continuity_pt. apply (cont_deriv f (fct_cte l) no_cond x H5). - unfold fct_cte in |- *; reflexivity. + unfold fct_cte; reflexivity. Qed. Theorem derivable_continuous : forall f, derivable f -> continuity f. Proof. - unfold derivable, continuity in |- *; intros f X x. + unfold derivable, continuity; intros f X x. apply (derivable_continuous_pt f x (X x)). Qed. @@ -524,7 +524,7 @@ Lemma derivable_pt_lim_plus : apply uniqueness_step3. assert (H1 := uniqueness_step2 _ _ _ H). assert (H2 := uniqueness_step2 _ _ _ H0). - unfold plus_fct in |- *. + unfold plus_fct. cut (forall h:R, (f1 (x + h) + f2 (x + h) - (f1 x + f2 x)) / h = @@ -533,15 +533,15 @@ Lemma derivable_pt_lim_plus : 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. + unfold limit1_in; unfold limit_in; unfold dist; + simpl; unfold R_dist; intros. elim (H4 eps H5); intros. exists x0. elim H6; intros. split. assumption. intros; rewrite H3; apply H8; assumption. - intro; unfold Rdiv in |- *; ring. + intro; unfold Rdiv; ring. Qed. Lemma derivable_pt_lim_opp : @@ -550,20 +550,20 @@ Proof. intros. apply uniqueness_step3. assert (H1 := uniqueness_step2 _ _ _ H). - unfold opp_fct in |- *. + unfold opp_fct. 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. + unfold limit1_in; unfold limit_in; unfold dist; + simpl; unfold R_dist; intros. elim (H2 eps H3); intros. exists x0. elim H4; intros. split. assumption. intros; rewrite H0; apply H6; assumption. - intro; unfold Rdiv in |- *; ring. + intro; unfold Rdiv; ring. Qed. Lemma derivable_pt_lim_minus : @@ -575,7 +575,7 @@ Proof. apply uniqueness_step3. assert (H1 := uniqueness_step2 _ _ _ H). assert (H2 := uniqueness_step2 _ _ _ H0). - unfold minus_fct in |- *. + unfold minus_fct. cut (forall h:R, (f1 (x + h) - f1 x) / h - (f2 (x + h) - f2 x) / h = @@ -584,15 +584,15 @@ Proof. 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. + unfold limit1_in; unfold limit_in; unfold dist; + simpl; unfold R_dist; intros. elim (H4 eps H5); intros. exists x0. elim H6; intros. split. assumption. intros; rewrite <- H3; apply H8; assumption. - intro; unfold Rdiv in |- *; ring. + intro; unfold Rdiv; ring. Qed. Lemma derivable_pt_lim_mult : @@ -615,15 +615,15 @@ Proof. elim H1; intros. clear H1 H3. apply H2. - unfold mult_fct in |- *. + unfold mult_fct. 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. 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; + intros; unfold fct_cte, derivable_pt_lim. + intros; exists (mkposreal 1 Rlt_0_1); intros; unfold Rminus; + rewrite Rplus_opp_r; unfold Rdiv; rewrite Rmult_0_l; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. Qed. @@ -636,34 +636,34 @@ Proof. 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. + unfold mult_real_fct, mult_fct, fct_cte; reflexivity. Qed. Lemma derivable_pt_lim_id : forall x:R, derivable_pt_lim id x 1. Proof. - intro; unfold derivable_pt_lim in |- *. + intro; unfold derivable_pt_lim. intros eps Heps; exists (mkposreal eps Heps); intros h H1 H2; - unfold id in |- *; replace ((x + h - x) / h - 1) with 0. + unfold id; 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); + unfold Rminus; rewrite Rplus_assoc; rewrite (Rplus_comm x); rewrite Rplus_assoc. - rewrite Rplus_opp_l; rewrite Rplus_0_r; unfold Rdiv in |- *; + rewrite Rplus_opp_l; rewrite Rplus_0_r; unfold Rdiv; rewrite <- Rinv_r_sym. - symmetry in |- *; apply Rplus_opp_r. + symmetry ; apply Rplus_opp_r. assumption. Qed. Lemma derivable_pt_lim_Rsqr : forall x:R, derivable_pt_lim Rsqr x (2 * x). Proof. - intro; unfold derivable_pt_lim in |- *. - unfold Rsqr in |- *; intros eps Heps; exists (mkposreal eps Heps); + intro; unfold derivable_pt_lim. + unfold Rsqr; 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. + unfold Rdiv; rewrite Rmult_plus_distr_r. repeat rewrite Rmult_assoc. repeat rewrite <- Rinv_r_sym; [ idtac | assumption ]. ring. @@ -684,7 +684,7 @@ Proof. 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 |- *; + unfold comp; cut (D_in (fun x0:R => f2 (f1 x0)) (fun y:R => l2 * l1) (Dgf no_cond no_cond f1) x -> @@ -693,14 +693,14 @@ Proof. 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. + unfold Dgf, D_in, no_cond; unfold limit1_in; + unfold limit_in; unfold dist; simpl; + unfold R_dist; 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. + unfold D_x; split. split; trivial. elim H6; intros; unfold D_x in H10; elim H10; intros; assumption. elim H6; intros; assumption. @@ -710,7 +710,7 @@ Lemma derivable_pt_plus : 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. + unfold derivable_pt; intros f1 f2 x X X0. elim X; intros. elim X0; intros. exists (x0 + x1). @@ -720,7 +720,7 @@ Qed. Lemma derivable_pt_opp : forall f (x:R), derivable_pt f x -> derivable_pt (- f) x. Proof. - unfold derivable_pt in |- *; intros f x X. + unfold derivable_pt; intros f x X. elim X; intros. exists (- x0). apply derivable_pt_lim_opp; assumption. @@ -730,7 +730,7 @@ Lemma derivable_pt_minus : 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. + unfold derivable_pt; intros f1 f2 x X X0. elim X; intros. elim X0; intros. exists (x0 - x1). @@ -741,7 +741,7 @@ Lemma derivable_pt_mult : 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. + unfold derivable_pt; intros f1 f2 x X X0. elim X; intros. elim X0; intros. exists (x0 * f2 x + f1 x * x1). @@ -750,7 +750,7 @@ Qed. Lemma derivable_pt_const : forall a x:R, derivable_pt (fct_cte a) x. Proof. - intros; unfold derivable_pt in |- *. + intros; unfold derivable_pt. exists 0. apply derivable_pt_lim_const. Qed. @@ -758,7 +758,7 @@ Qed. Lemma derivable_pt_scal : 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. + unfold derivable_pt; intros f1 a x X. elim X; intros. exists (a * x0). apply derivable_pt_lim_scal; assumption. @@ -766,14 +766,14 @@ Qed. Lemma derivable_pt_id : forall x:R, derivable_pt id x. Proof. - unfold derivable_pt in |- *; intro. + unfold derivable_pt; intro. exists 1. apply derivable_pt_lim_id. Qed. Lemma derivable_pt_Rsqr : forall x:R, derivable_pt Rsqr x. Proof. - unfold derivable_pt in |- *; intro; exists (2 * x). + unfold derivable_pt; intro; exists (2 * x). apply derivable_pt_lim_Rsqr. Qed. @@ -781,7 +781,7 @@ Lemma derivable_pt_comp : 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. + unfold derivable_pt; intros f1 f2 x X X0. elim X; intros. elim X0; intros. exists (x1 * x0). @@ -791,57 +791,57 @@ Qed. Lemma derivable_plus : forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 + f2). Proof. - unfold derivable in |- *; intros f1 f2 X X0 x. + unfold derivable; intros f1 f2 X X0 x. apply (derivable_pt_plus _ _ x (X _) (X0 _)). Qed. Lemma derivable_opp : forall f, derivable f -> derivable (- f). Proof. - unfold derivable in |- *; intros f X x. + unfold derivable; intros f X x. apply (derivable_pt_opp _ x (X _)). Qed. Lemma derivable_minus : forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 - f2). Proof. - unfold derivable in |- *; intros f1 f2 X X0 x. + unfold derivable; 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). Proof. - unfold derivable in |- *; intros f1 f2 X X0 x. + unfold derivable; intros f1 f2 X X0 x. apply (derivable_pt_mult _ _ x (X _) (X0 _)). Qed. Lemma derivable_const : forall a:R, derivable (fct_cte a). Proof. - unfold derivable in |- *; intros. + unfold derivable; intros. apply derivable_pt_const. Qed. Lemma derivable_scal : forall f (a:R), derivable f -> derivable (mult_real_fct a f). Proof. - unfold derivable in |- *; intros f a X x. + unfold derivable; intros f a X x. apply (derivable_pt_scal _ a x (X _)). Qed. Lemma derivable_id : derivable id. Proof. - unfold derivable in |- *; intro; apply derivable_pt_id. + unfold derivable; intro; apply derivable_pt_id. Qed. Lemma derivable_Rsqr : derivable Rsqr. Proof. - unfold derivable in |- *; intro; apply derivable_pt_Rsqr. + unfold derivable; intro; apply derivable_pt_Rsqr. Qed. Lemma derivable_comp : forall f1 f2, derivable f1 -> derivable f2 -> derivable (f2 o f1). Proof. - unfold derivable in |- *; intros f1 f2 X X0 x. + unfold derivable; intros f1 f2 X X0 x. apply (derivable_pt_comp _ _ x (X _) (X0 _)). Qed. @@ -996,13 +996,13 @@ Proof. elim (lt_irrefl _ H). cut (n = 0%nat \/ (0 < n)%nat). intro; elim H0; intro. - rewrite H1; simpl in |- *. + rewrite H1; simpl. 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. + unfold fct_cte, id; ring. reflexivity. replace (fun y:R => y ^ S n) with (fun y:R => y * y ^ n). replace (pred (S n)) with n; [ idtac | reflexivity ]. @@ -1011,13 +1011,13 @@ Proof. 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 |- *. + unfold f; apply Hrecn; assumption. + unfold f. + pattern n at 1 5; replace n with (S (pred n)). + unfold id; rewrite S_INR; simpl. ring. - symmetry in |- *; apply S_pred with 0%nat; assumption. - unfold mult_fct, id in |- *; reflexivity. + symmetry ; apply S_pred with 0%nat; assumption. + unfold mult_fct, id; reflexivity. reflexivity. inversion H. left; reflexivity. @@ -1033,7 +1033,7 @@ Lemma derivable_pt_lim_pow : Proof. intros. induction n as [| n Hrecn]. - simpl in |- *. + simpl. rewrite Rmult_0_l. replace (fun _:R => 1) with (fct_cte 1); [ apply derivable_pt_lim_const | reflexivity ]. @@ -1044,14 +1044,14 @@ Qed. Lemma derivable_pt_pow : forall (n:nat) (x:R), derivable_pt (fun y:R => y ^ n) x. Proof. - intros; unfold derivable_pt in |- *. + intros; unfold derivable_pt. exists (INR n * x ^ pred n). apply derivable_pt_lim_pow. Qed. Lemma derivable_pow : forall n:nat, derivable (fun y:R => y ^ n). Proof. - intro; unfold derivable in |- *; intro; apply derivable_pt_pow. + intro; unfold derivable; intro; apply derivable_pt_pow. Qed. Lemma derive_pt_pow : @@ -1073,7 +1073,7 @@ Proof. elim pr2; intros. unfold derivable_pt_abs in p. unfold derivable_pt_abs in p0. - simpl in |- *. + simpl. apply (uniqueness_limite f x x0 x1 p p0). Qed. @@ -1094,7 +1094,7 @@ Proof. assert (H5 := derive_pt_eq_1 f c l pr H4). cut (0 < l / 2); [ intro - | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + | unfold Rdiv; 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). @@ -1119,7 +1119,7 @@ Proof. (Rabs ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / Rmin (delta / 2) ((b + - c) / 2) + - l) < l / 2). - unfold Rabs in |- *; + unfold Rabs; case (Rcase_abs ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / @@ -1157,7 +1157,7 @@ Proof. (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. + pattern l at 2; rewrite double_var. ring. ring. intro. @@ -1183,7 +1183,7 @@ Proof. l + - ((f (c + Rmin (delta / 2) ((b + - c) / 2)) - f c) / - Rmin (delta / 2) ((b + - c) / 2))) in |- *; apply Rplus_lt_le_0_compat; + Rmin (delta / 2) ((b + - c) / 2))); apply Rplus_lt_le_0_compat; [ assumption | rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; assumption ]. unfold Rminus; ring. @@ -1195,13 +1195,13 @@ Proof. ((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; + unfold Rdiv; 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 |- *. + unfold Rdiv. 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)). @@ -1209,9 +1209,9 @@ Proof. rewrite <- Rinv_r_sym. repeat rewrite Rmult_1_l. ring. - red in |- *; intro. + red; intro. unfold Rdiv in H12; rewrite H16 in H12; elim (Rlt_irrefl 0 H12). - red in |- *; intro. + red; intro. unfold Rdiv in H12; rewrite H16 in H12; elim (Rlt_irrefl 0 H12). assert (H14 := Rmin_r (delta / 2) ((b - c) / 2)). assert @@ -1225,7 +1225,7 @@ Proof. replace (2 * b) with (b + b). apply Rplus_lt_compat_r; assumption. ring. - unfold Rdiv in |- *; rewrite Rmult_plus_distr_l. + unfold Rdiv; rewrite Rmult_plus_distr_l. repeat rewrite (Rmult_comm 2). rewrite Rmult_assoc; rewrite <- Rinv_l_sym. rewrite Rmult_1_r. @@ -1233,51 +1233,51 @@ Proof. discrR. apply Rlt_trans with c. assumption. - pattern c at 1 in |- *; rewrite <- (Rplus_0_r c); apply Rplus_lt_compat_l; + pattern c at 1; 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; + unfold Rdiv; 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))). + unfold Rabs; 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; + (mkposreal ((b - c) / 2) H8)); simpl; 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; + unfold Rdiv; 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. + unfold Rdiv; 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); + pattern delta at 2; rewrite <- (Rplus_0_r delta); apply Rplus_lt_compat_l. rewrite Rplus_0_r; apply (cond_pos delta). - symmetry in |- *; apply double. + symmetry ; 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; + (mkposreal ((b - c) / 2) H8)); simpl; + intro; red; intro; rewrite H11 in H10; elim (Rlt_irrefl 0 H10). + unfold Rdiv; apply Rmult_lt_0_compat; [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. - unfold Rdiv in |- *; apply Rmult_lt_0_compat. + unfold Rdiv; 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. + symmetry ; 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)). @@ -1307,7 +1307,7 @@ Proof. ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / Rmax (- (delta / 2)) ((a + - c) / 2) + - l) < - (l / 2)). - unfold Rabs in |- *; + unfold Rabs; case (Rcase_abs ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / @@ -1339,12 +1339,12 @@ Proof. 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. + pattern l at 3; rewrite double_var. ring. assumption. apply Rplus_le_lt_0_compat; assumption. rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption. - unfold Rdiv in |- *; + unfold Rdiv; replace ((f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)) - f c) * / Rmax (- (delta * / 2)) ((a - c) * / 2)) with @@ -1361,7 +1361,7 @@ Proof. ring. left; apply Rinv_0_lt_compat; rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption. - unfold Rdiv in |- *. + unfold Rdiv. rewrite <- Ropp_inv_permute. rewrite Rmult_opp_opp. reflexivity. @@ -1380,7 +1380,7 @@ Proof. apply Rplus_lt_compat_l; assumption. field; discrR. assumption. - unfold Rabs in |- *; case (Rcase_abs (Rmax (- (delta / 2)) ((a - c) / 2))). + unfold Rabs; 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)) @@ -1390,10 +1390,10 @@ Proof. assumption. apply Rmult_lt_reg_l with 2. prove_sup0. - unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + unfold Rdiv; 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); + pattern delta at 2; rewrite <- (Rplus_0_r delta); apply Rplus_lt_compat_l; rewrite Rplus_0_r; apply (cond_pos delta). discrR. cut (- (delta / 2) < 0). @@ -1401,7 +1401,7 @@ Proof. intros; generalize (Rmax_stable_in_negreal (mknegreal (- (delta / 2)) H13) - (mknegreal ((a - c) / 2) H12)); simpl in |- *; + (mknegreal ((a - c) / 2) H12)); simpl; intro; generalize (Rge_le (Rmax (- (delta / 2)) ((a - c) / 2)) 0 r); intro; elim @@ -1410,41 +1410,41 @@ Proof. 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 |- *. + unfold Rdiv. rewrite <- Ropp_mult_distr_l_reverse. rewrite (Ropp_minus_distr a c). reflexivity. - rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; unfold Rdiv in |- *; + rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; unfold Rdiv; 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). + red; 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 |- *; + rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; unfold Rdiv; 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 |- *. + unfold Rdiv. rewrite <- Ropp_mult_distr_l_reverse. rewrite (Ropp_minus_distr a c). reflexivity. - unfold Rdiv in |- *; apply Rmult_lt_0_compat; + unfold Rdiv; 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. + unfold Rdiv; 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. + unfold Rdiv; apply Ropp_mult_distr_l_reverse. Qed. Theorem deriv_minimum : @@ -1460,7 +1460,7 @@ Proof. 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. + intros; unfold opp_fct; apply Ropp_ge_le_contravar; apply Rle_ge. apply (H1 x H2 H3). Qed. @@ -1493,7 +1493,7 @@ Proof. 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 |- *; + intro; unfold Rabs; case (Rcase_abs ((f (x + delta / 2) - f x) / (delta / 2) - l)). intro; elim @@ -1502,7 +1502,7 @@ Proof. intros; generalize (Rplus_lt_compat_r l ((f (x + delta / 2) - f x) / (delta / 2) - l) - (- (l / 2)) H13); unfold Rminus in |- *; + (- (l / 2)) H13); unfold Rminus; replace (- (l / 2) + l) with (l / 2). rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; intro; generalize @@ -1512,50 +1512,50 @@ Proof. 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. + pattern l at 3; rewrite double_var. ring. - unfold Rminus in |- *; apply Rplus_le_le_0_compat. - unfold Rdiv in |- *; apply Rmult_le_pos. + unfold Rminus; apply Rplus_le_le_0_compat. + unfold Rdiv; 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; + pattern x at 1; 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. + unfold Rdiv; 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; + pattern x at 1; 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; + unfold Rdiv; apply prod_neq_R0. + generalize (cond_pos delta); intro; red; 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; + unfold Rdiv; 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. + unfold Rdiv; 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. + pattern (pos delta) at 1; 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 |- *; + symmetry ; apply Rabs_right. + left; change (0 < delta / 2); unfold Rdiv; 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; + unfold Rdiv; 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. + unfold Rminus; 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 ed80ac43..3c15a305 100644 --- a/theories/Reals/Ranalysis2.v +++ b/theories/Reals/Ranalysis2.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -9,7 +9,7 @@ Require Import Rbase. Require Import Rfunctions. Require Import Ranalysis1. -Open Local Scope R_scope. +Local Open Scope R_scope. (**********) Lemma formule : @@ -24,7 +24,7 @@ Lemma formule : 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 |- *. + intros; unfold Rdiv, Rminus, Rsqr. 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)); @@ -81,10 +81,10 @@ Proof. 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; + unfold Rdiv; apply Rmult_lt_0_compat; [ prove_sup0 | apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption ]. exact H8. - right; unfold Rdiv in |- *. + right; unfold Rdiv. repeat rewrite Rabs_mult. rewrite Rabs_Rinv; discrR. replace (Rabs 8) with 8. @@ -96,8 +96,8 @@ Proof. 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. + symmetry ; apply Rabs_right; left; assumption. + symmetry ; apply Rabs_right; left; prove_sup. Qed. Lemma maj_term2 : @@ -129,11 +129,11 @@ Proof. (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; + unfold Rdiv; unfold Rsqr; repeat apply prod_neq_R0; try assumption || discrR. - red in |- *; intro H10; rewrite H10 in H; elim (Rlt_irrefl _ H). + red; 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 |- *. + unfold Rdiv. repeat rewrite Rinv_mult_distr; try assumption. repeat rewrite Rabs_mult. replace (Rabs 2) with 2. @@ -147,9 +147,9 @@ Proof. repeat rewrite Rabs_Rinv; try assumption. rewrite <- (Rmult_comm 2). unfold Rdiv in H8; exact H8. - symmetry in |- *; apply Rabs_right; left; prove_sup0. + symmetry ; apply Rabs_right; left; prove_sup0. right. - unfold Rsqr, Rdiv in |- *. + unfold Rsqr, Rdiv. do 1 rewrite Rinv_mult_distr; try assumption || discrR. do 1 rewrite Rinv_mult_distr; try assumption || discrR. repeat rewrite Rabs_mult. @@ -166,9 +166,9 @@ Proof. (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. + symmetry ; apply Rabs_right; left; prove_sup0. + symmetry ; apply Rabs_right; left; prove_sup. + symmetry ; apply Rabs_right; left; assumption. Qed. Lemma maj_term3 : @@ -204,11 +204,11 @@ Proof. (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; + unfold Rdiv; unfold Rsqr; repeat apply prod_neq_R0; try assumption. - red in |- *; intro H10; rewrite H10 in H; elim (Rlt_irrefl _ H). + red; intro H10; rewrite H10 in H; elim (Rlt_irrefl _ H). apply Rinv_neq_0_compat; apply prod_neq_R0; discrR || assumption. - unfold Rdiv in |- *. + unfold Rdiv. repeat rewrite Rinv_mult_distr; try assumption. repeat rewrite Rabs_mult. replace (Rabs 2) with 2. @@ -222,9 +222,9 @@ Proof. repeat rewrite Rabs_Rinv; assumption || idtac. rewrite <- (Rmult_comm 2). unfold Rdiv in H9; exact H9. - symmetry in |- *; apply Rabs_right; left; prove_sup0. + symmetry ; apply Rabs_right; left; prove_sup0. right. - unfold Rsqr, Rdiv in |- *. + unfold Rsqr, Rdiv. rewrite Rinv_mult_distr; try assumption || discrR. rewrite Rinv_mult_distr; try assumption || discrR. repeat rewrite Rabs_mult. @@ -241,9 +241,9 @@ Proof. (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. + symmetry ; apply Rabs_right; left; prove_sup0. + symmetry ; apply Rabs_right; left; prove_sup. + symmetry ; apply Rabs_right; left; assumption. Qed. Lemma maj_term4 : @@ -281,17 +281,17 @@ Proof. 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; + unfold Rdiv; unfold Rsqr; repeat apply prod_neq_R0; assumption || idtac. - red in |- *; intro H11; rewrite H11 in H; elim (Rlt_irrefl _ H). + red; 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 |- *. + unfold Rdiv. repeat rewrite Rinv_mult_distr; - try assumption || (unfold Rsqr in |- *; apply prod_neq_R0; assumption). + try assumption || (unfold Rsqr; apply prod_neq_R0; assumption). repeat rewrite Rabs_mult. replace (Rabs 2) with 2. replace @@ -305,13 +305,13 @@ Proof. 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 Rabs_pos_lt; apply Rinv_neq_0_compat; unfold Rsqr; 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 |- *. + symmetry ; apply Rabs_right; left; prove_sup0. + right; unfold Rsqr, Rdiv. rewrite Rinv_mult_distr; try assumption || discrR. rewrite Rinv_mult_distr; try assumption || discrR. rewrite Rinv_mult_distr; try assumption || discrR. @@ -333,9 +333,9 @@ Proof. (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. + symmetry ; apply Rabs_right; left; prove_sup0. + symmetry ; apply Rabs_right; left; prove_sup. + symmetry ; apply Rabs_right; left; assumption. apply prod_neq_R0; assumption || discrR. apply prod_neq_R0; assumption. Qed. @@ -343,11 +343,11 @@ Qed. Lemma D_x_no_cond : forall x a:R, a <> 0 -> D_x no_cond x (x + a). Proof. intros. - unfold D_x, no_cond in |- *. + unfold D_x, no_cond. split. trivial. apply Rminus_not_eq. - unfold Rminus in |- *. + unfold Rminus. rewrite Ropp_plus_distr. rewrite <- Rplus_assoc. rewrite Rplus_opp_r. @@ -394,7 +394,7 @@ Qed. Lemma quadruple_var : forall x:R, x = x / 4 + x / 4 + x / 4 + x / 4. Proof. intro; rewrite <- quadruple. - unfold Rdiv in |- *; rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m; discrR. + unfold Rdiv; rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m; discrR. reflexivity. Qed. @@ -413,10 +413,10 @@ Proof. 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 |- *; + unfold dist; simpl; unfold R_dist; replace (x0 + h - x0) with h. intros; assert (H7 := H6 H4). - red in |- *; intro. + red; 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. @@ -429,10 +429,10 @@ Proof. 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; + unfold IZR; unfold INR, Pos.to_nat; simpl; intro; elim (Rlt_irrefl 1 (Rlt_trans _ _ _ H13 H12)). apply IZR_lt; omega. - unfold Rabs in |- *; case (Rcase_abs (/ 2)); intro. + unfold Rabs; 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; @@ -442,18 +442,18 @@ Proof. 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; + intro; rewrite <- H7; unfold dist, R_met; unfold R_dist; + unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply Rabs_pos_lt. - unfold Rdiv in |- *; apply prod_neq_R0; + unfold Rdiv; apply prod_neq_R0; [ assumption | apply Rinv_neq_0_compat; discrR ]. intro; apply H5. split. - unfold D_x, no_cond in |- *. + unfold D_x, no_cond. split; trivial || assumption. assumption. - change (0 < Rabs (f x0 / 2)) in |- *. - apply Rabs_pos_lt; unfold Rdiv in |- *; apply prod_neq_R0. + change (0 < Rabs (f x0 / 2)). + apply Rabs_pos_lt; unfold Rdiv; 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 afd4a4ee..5eaf5a57 100644 --- a/theories/Reals/Ranalysis3.v +++ b/theories/Reals/Ranalysis3.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -10,7 +10,7 @@ Require Import Rbase. Require Import Rfunctions. Require Import Ranalysis1. Require Import Ranalysis2. -Open Local Scope R_scope. +Local Open Scope R_scope. (** Division *) Theorem derivable_pt_lim_div : @@ -22,17 +22,17 @@ Theorem derivable_pt_lim_div : Proof. intros f1 f2 x l1 l2 H H0 H1. cut (derivable_pt f2 x); - [ intro X | unfold derivable_pt in |- *; exists l2; exact H0 ]. + [ intro X | unfold derivable_pt; exists 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 |- *. + unfold div_fct. 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 |- *; + | unfold Rdiv; change (0 < Rabs (f2 x) * / 2); apply Rmult_lt_0_compat; [ apply Rabs_pos_lt; assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. clear H3; intros alp_f2 H3. @@ -46,12 +46,12 @@ Proof. (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. + unfold derivable_pt_lim; intros. elim (H (Rabs (eps * f2 x / 8))); [ idtac - | unfold Rdiv in |- *; change (0 < Rabs (eps * f2 x * / 8)) in |- *; + | unfold Rdiv; change (0 < Rabs (eps * f2 x * / 8)); apply Rabs_pos_lt; repeat apply prod_neq_R0; - [ red in |- *; intro H7; rewrite H7 in H6; elim (Rlt_irrefl _ H6) + [ red; intro H7; rewrite H7 in H6; elim (Rlt_irrefl _ H6) | assumption | apply Rinv_neq_0_compat; discrR ] ]. intros alp_f1d H7. @@ -68,7 +68,7 @@ Proof. | elim H3; intros; assumption | apply (cond_pos alp_f1d) ] ]. exists (mkposreal (Rmin eps_f2 (Rmin alp_f2 alp_f1d)) H10). - simpl in |- *; intros. + simpl; 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 _ _)). @@ -80,7 +80,7 @@ Proof. 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 |- *. + unfold Rminus. rewrite <- (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) . @@ -98,15 +98,15 @@ Proof. intros. apply Rlt_4; assumption. rewrite H8. - unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. + unfold Rdiv; 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. + unfold Rdiv; 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. + unfold Rdiv; 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. @@ -114,7 +114,7 @@ Proof. try assumption || apply H2. apply H14. apply Rmin_2; assumption. - right; symmetry in |- *; apply quadruple_var. + right; symmetry ; apply quadruple_var. (***********************************) (* Second case *) (* (f1 x)=0 l1<>0 *) @@ -137,7 +137,7 @@ Proof. 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 |- *. + simpl. intros. assert (H15 := Rlt_le_trans _ _ _ H14 (Rmin_r _ _)). assert (H16 := Rlt_le_trans _ _ _ H14 (Rmin_l _ _)). @@ -152,7 +152,7 @@ Proof. 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 |- *. + unfold Rminus. rewrite <- (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) . @@ -170,11 +170,11 @@ Proof. intros. apply Rlt_4; assumption. rewrite H8. - unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. + unfold Rdiv; 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. + unfold Rdiv; 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. @@ -185,7 +185,7 @@ Proof. 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. + right; symmetry ; apply quadruple_var. apply H2; assumption. repeat apply Rmin_pos. apply (cond_pos eps_f2). @@ -196,21 +196,21 @@ Proof. elim H10; intros. case (Req_dec a 0); intro. rewrite H14; rewrite Rplus_0_r. - unfold Rminus in |- *; rewrite Rplus_opp_r. + unfold Rminus; rewrite Rplus_opp_r. rewrite Rabs_R0. apply Rabs_pos_lt. - unfold Rdiv, Rsqr in |- *; repeat rewrite Rmult_assoc. + unfold Rdiv, Rsqr; repeat rewrite Rmult_assoc. repeat apply prod_neq_R0; try assumption. - red in |- *; intro; rewrite H15 in H6; elim (Rlt_irrefl _ H6). + red; 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; + change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))). + apply Rabs_pos_lt; unfold Rdiv, Rsqr; repeat rewrite Rmult_assoc; repeat apply prod_neq_R0. - red in |- *; intro; rewrite H11 in H6; elim (Rlt_irrefl _ H6). + red; intro; rewrite H11 in H6; elim (Rlt_irrefl _ H6). assumption. assumption. apply Rinv_neq_0_compat; repeat apply prod_neq_R0; @@ -223,17 +223,17 @@ Proof. 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; + | apply Rabs_pos_lt; unfold Rdiv, Rsqr; repeat rewrite Rmult_assoc; repeat apply prod_neq_R0; [ assumption | assumption - | red in |- *; intro; rewrite H11 in H6; elim (Rlt_irrefl _ H6) + | red; 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 |- *. + simpl. intros. assert (H15 := Rlt_le_trans _ _ _ H14 (Rmin_l _ _)). assert (H16 := Rlt_le_trans _ _ _ H14 (Rmin_r _ _)). @@ -248,7 +248,7 @@ Proof. 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 |- *. + unfold Rminus. rewrite <- (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) . @@ -266,7 +266,7 @@ Proof. intros. apply Rlt_4; assumption. rewrite H10. - unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. + unfold Rdiv; 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. @@ -274,14 +274,14 @@ Proof. apply H2; assumption. apply Rmin_2; assumption. rewrite H9. - unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. + unfold Rdiv; 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. + right; symmetry ; apply quadruple_var. apply H2; assumption. repeat apply Rmin_pos. apply (cond_pos eps_f2). @@ -294,7 +294,7 @@ Proof. (***********************************) elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x)))); [ idtac - | apply Rabs_pos_lt; unfold Rsqr, Rdiv in |- *; + | apply Rabs_pos_lt; unfold Rsqr, Rdiv; repeat rewrite Rinv_mult_distr; repeat apply prod_neq_R0; try assumption || discrR ]. intros alp_f2d H11. @@ -313,7 +313,7 @@ Proof. exists (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2c))) H14). - simpl in |- *; intros. + simpl; 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 _ _)). @@ -335,7 +335,7 @@ Proof. 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 |- *. + unfold Rminus. rewrite <- (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) . @@ -361,24 +361,24 @@ Proof. apply H2; assumption. apply Rmin_2; assumption. rewrite H9. - unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. + unfold Rdiv; 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. + right; symmetry ; 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. + unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0. apply Rabs_pos_lt. - unfold Rdiv, Rsqr in |- *. + unfold Rdiv, Rsqr. 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). + red; 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. @@ -401,19 +401,19 @@ Proof. 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 |- *. + change (0 < Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))). apply Rabs_pos_lt. - unfold Rsqr, Rdiv in |- *. + unfold Rsqr, Rdiv. 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). + red; 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). + red; 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. @@ -440,7 +440,7 @@ Proof. exists (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2t2))) H13). - simpl in |- *. + simpl. intros. cut (forall a:R, @@ -462,7 +462,7 @@ Proof. 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 |- *. + unfold Rminus. rewrite <- (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) . @@ -480,7 +480,7 @@ Proof. intros. apply Rlt_4; assumption. rewrite H10. - unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. + unfold Rdiv; 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. @@ -495,20 +495,20 @@ Proof. 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. + right; symmetry ; 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 H17; rewrite Rplus_0_r; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0. apply Rabs_pos_lt. - unfold Rdiv in |- *; rewrite Rinv_mult_distr; try discrR || assumption. - unfold Rsqr in |- *. + unfold Rdiv; rewrite Rinv_mult_distr; try discrR || assumption. + unfold Rsqr. 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)). + (red; intro H18; rewrite H18 in H6; elim (Rlt_irrefl _ H6)). elim H11; intros. apply H19. split. @@ -521,20 +521,20 @@ Proof. apply (cond_pos alp_f2d). elim H11; intros; assumption. apply Rabs_pos_lt. - unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; try discrR || assumption. + unfold Rdiv, Rsqr; 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 |- *. + (red; intro H12; rewrite H12 in H6; elim (Rlt_irrefl _ H6)). + change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))). apply Rabs_pos_lt. - unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; try discrR || assumption. + unfold Rdiv, Rsqr; 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)). + (red; intro H12; rewrite H12 in H6; elim (Rlt_irrefl _ H6)). (***********************************) (* Sixth case *) (* (f1 x)<>0 l1<>0 l2<>0 *) @@ -562,7 +562,7 @@ Proof. (mkposreal (Rmin (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) (Rmin alp_f2c alp_f2t2)) H15). - simpl in |- *. + simpl. intros. assert (H18 := Rlt_le_trans _ _ _ H17 (Rmin_l _ _)). assert (H19 := Rlt_le_trans _ _ _ H17 (Rmin_r _ _)). @@ -591,7 +591,7 @@ Proof. 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 |- *. + unfold Rminus. rewrite <- (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))) . @@ -624,18 +624,18 @@ Proof. 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. + right; symmetry ; 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 H18; rewrite Rplus_0_r; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply Rabs_pos_lt. - unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr. + unfold Rdiv, Rsqr; 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)). + (red; intro H28; rewrite H28 in H6; elim (Rlt_irrefl _ H6)). apply prod_neq_R0; [ discrR | assumption ]. apply prod_neq_R0; [ discrR | assumption ]. assumption. @@ -646,20 +646,20 @@ Proof. 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 H18; rewrite Rplus_0_r; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply Rabs_pos_lt. - unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr. + unfold Rdiv, Rsqr; 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)). + (red; 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. + unfold D_x, no_cond; split. trivial. apply Rminus_not_eq_right. replace (x + a - x) with a; [ assumption | ring ]. @@ -671,34 +671,34 @@ Proof. 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. + change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))); apply Rabs_pos_lt. + unfold Rdiv, Rsqr; 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 |- *; + (red; intro H14; rewrite H14 in H6; elim (Rlt_irrefl _ H6)). + change (0 < Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))); apply Rabs_pos_lt. - unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr. + unfold Rdiv, Rsqr; 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)). + (red; 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; + unfold Rdiv, Rsqr; 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)). + (red; intro H11; rewrite H11 in H6; elim (Rlt_irrefl _ H6)). intros. - unfold Rdiv in |- *. + unfold Rdiv. 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). @@ -739,13 +739,13 @@ Proof. 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; + rewrite <- H5; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; + unfold Rdiv; 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. + unfold D_x, no_cond; split. trivial. assumption. assumption. @@ -756,7 +756,7 @@ Lemma derivable_pt_div : derivable_pt f1 x -> derivable_pt f2 x -> f2 x <> 0 -> derivable_pt (f1 / f2) x. Proof. - unfold derivable_pt in |- *. + unfold derivable_pt. intros f1 f2 x X X0 H. elim X; intros. elim X0; intros. @@ -769,7 +769,7 @@ Lemma derivable_div : derivable f1 -> derivable f2 -> (forall x:R, f2 x <> 0) -> derivable (f1 / f2). Proof. - unfold derivable in |- *; intros f1 f2 X X0 H x. + unfold derivable; intros f1 f2 X X0 H x. apply (derivable_pt_div _ _ _ (X x) (X0 x) (H x)). Qed. diff --git a/theories/Reals/Ranalysis4.v b/theories/Reals/Ranalysis4.v index cc658fee..00c07592 100644 --- a/theories/Reals/Ranalysis4.v +++ b/theories/Reals/Ranalysis4.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -9,11 +9,11 @@ Require Import Rbase. Require Import Rfunctions. Require Import SeqSeries. -Require Import Rtrigo. +Require Import Rtrigo1. Require Import Ranalysis1. Require Import Ranalysis3. Require Import Exp_prop. -Open Local Scope R_scope. +Local Open Scope R_scope. (**********) Lemma derivable_pt_inv : @@ -26,12 +26,12 @@ Proof. apply derivable_pt_const. assumption. assumption. - unfold div_fct, inv_fct, fct_cte in |- *; intro X0; elim X0; intros; - unfold derivable_pt in |- *; exists x0; - unfold derivable_pt_abs in |- *; unfold derivable_pt_lim in |- *; + unfold div_fct, inv_fct, fct_cte; intro X0; elim X0; intros; + unfold derivable_pt; exists x0; + unfold derivable_pt_abs; unfold derivable_pt_lim; 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)); + unfold Rdiv in H1; unfold Rdiv; rewrite <- (Rmult_1_l (/ f x)); rewrite <- (Rmult_1_l (/ f (x + h))). apply H1; assumption. Qed. @@ -41,10 +41,10 @@ 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. Proof. - unfold derivable_pt, derive_pt in |- *; intros. + unfold derivable_pt, derive_pt; intros. elim pr1; intros. elim pr2; intros. - simpl in |- *. + simpl. rewrite H in p. apply uniqueness_limite with g x; assumption. Qed. @@ -54,17 +54,17 @@ 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. Proof. - unfold derivable_pt, derive_pt in |- *; intros. + unfold derivable_pt, derive_pt; intros. elim pr1; intros. elim pr2; intros. - simpl in |- *. + simpl. 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 limit1_in; unfold limit_in; unfold dist; + simpl; unfold R_dist; 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. @@ -80,7 +80,7 @@ Lemma derivable_inv : forall f:R -> R, (forall x:R, f x <> 0) -> derivable f -> derivable (/ f). Proof. intros f H X. - unfold derivable in |- *; intro x. + unfold derivable; intro x. apply derivable_pt_inv. apply (H x). apply (X x). @@ -95,25 +95,25 @@ Proof. 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 derive_pt_div; rewrite derive_pt_const; unfold fct_cte; + rewrite Rmult_0_l; rewrite Rmult_1_r; unfold Rminus; rewrite Rplus_0_l; reflexivity. apply pr_nu_var2. - intro; unfold div_fct, fct_cte, inv_fct in |- *. - unfold Rdiv in |- *; ring. + intro; unfold div_fct, fct_cte, inv_fct. + unfold Rdiv; ring. Qed. (** Rabsolu *) Lemma Rabs_derive_1 : forall x:R, 0 < x -> derivable_pt_lim Rabs x 1. Proof. intros. - unfold derivable_pt_lim in |- *; intros. + unfold derivable_pt_lim; 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. + unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_r. + rewrite Rplus_0_r; unfold Rdiv; rewrite <- Rinv_r_sym. rewrite Rplus_opp_r; rewrite Rabs_R0; apply H0. apply H1. apply Rle_ge. @@ -131,16 +131,16 @@ Qed. Lemma Rabs_derive_2 : forall x:R, x < 0 -> derivable_pt_lim Rabs x (-1). Proof. intros. - unfold derivable_pt_lim in |- *; intros. + unfold derivable_pt_lim; 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; + unfold Rminus; rewrite Ropp_involutive; rewrite Rplus_assoc; rewrite Rplus_opp_l. - rewrite Rplus_0_r; unfold Rdiv in |- *. + rewrite Rplus_0_r; unfold Rdiv. rewrite Ropp_mult_distr_l_reverse. rewrite <- Rinv_r_sym. rewrite Ropp_involutive; rewrite Rplus_opp_l; rewrite Rabs_R0; apply H0. @@ -163,24 +163,24 @@ Proof. intros. case (total_order_T x 0); intro. elim s; intro. - unfold derivable_pt in |- *; exists (-1). + unfold derivable_pt; exists (-1). apply (Rabs_derive_2 x a). elim H; exact b. - unfold derivable_pt in |- *; exists 1. + unfold derivable_pt; exists 1. apply (Rabs_derive_1 x r). Qed. (** Rabsolu is continuous for all x *) Lemma Rcontinuity_abs : continuity Rabs. Proof. - unfold continuity in |- *; intro. + unfold continuity; 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; + unfold continuity_pt; unfold continue_in; + unfold limit1_in; unfold limit_in; + simpl; unfold R_dist; intros; exists eps; split. apply H0. - intros; rewrite H; rewrite Rabs_R0; unfold Rminus in |- *; rewrite Ropp_0; + intros; rewrite H; rewrite Rabs_R0; unfold Rminus; 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. @@ -192,11 +192,11 @@ 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). Proof. - intros; unfold continuity in |- *; intro. + intros; unfold continuity; intro. induction N as [| N HrecN]. - simpl in |- *. + simpl. apply continuity_pt_const. - unfold constant in |- *; intros; reflexivity. + unfold constant; 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. @@ -222,7 +222,7 @@ Proof. cut (N = 0%nat \/ (0 < N)%nat). intro; elim H0; intro. rewrite H1. - simpl in |- *. + simpl. 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)). @@ -232,7 +232,7 @@ Proof. apply derivable_pt_lim_mult. apply derivable_pt_lim_id. apply derivable_pt_lim_const. - unfold fct_cte, id in |- *; ring. + unfold fct_cte, id; 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) + @@ -248,7 +248,7 @@ Proof. (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)). + pattern N at 3; replace N with (pred (S N)). apply derivable_pt_lim_pow. reflexivity. reflexivity. @@ -259,10 +259,10 @@ Proof. rewrite <- H2. replace (pred (S N)) with N; [ idtac | reflexivity ]. ring. - simpl in |- *. + simpl. apply S_pred with 0%nat; assumption. - unfold plus_fct in |- *. - simpl in |- *; reflexivity. + unfold plus_fct. + simpl; reflexivity. inversion H. left; reflexivity. right; apply lt_le_trans with 1%nat; [ apply lt_O_Sn | assumption ]. @@ -278,7 +278,7 @@ Lemma derivable_pt_lim_finite_sum : Proof. intros. induction N as [| N HrecN]. - simpl in |- *. + simpl. rewrite Rmult_1_r. replace (fun _:R => An 0%nat) with (fct_cte (An 0%nat)); [ apply derivable_pt_lim_const | reflexivity ]. @@ -290,7 +290,7 @@ Lemma derivable_pt_finite_sum : derivable_pt (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N) x. Proof. intros. - unfold derivable_pt in |- *. + unfold derivable_pt. assert (H := derivable_pt_lim_finite_sum An x N). induction N as [| N HrecN]. exists 0; apply H. @@ -303,14 +303,14 @@ 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). Proof. - intros; unfold derivable in |- *; intro; apply derivable_pt_finite_sum. + intros; unfold derivable; intro; apply derivable_pt_finite_sum. Qed. (** Regularity of hyperbolic functions *) Lemma derivable_pt_lim_cosh : forall x:R, derivable_pt_lim cosh x (sinh x). Proof. intro. - unfold cosh, sinh in |- *; unfold Rdiv in |- *. + unfold cosh, sinh; unfold Rdiv. 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 @@ -324,13 +324,13 @@ Proof. 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. + unfold plus_fct, mult_real_fct, comp, opp_fct, id, fct_cte; ring. Qed. Lemma derivable_pt_lim_sinh : forall x:R, derivable_pt_lim sinh x (cosh x). Proof. intro. - unfold cosh, sinh in |- *; unfold Rdiv in |- *. + unfold cosh, sinh; unfold Rdiv. 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 @@ -344,13 +344,13 @@ Proof. 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. + unfold plus_fct, mult_real_fct, comp, opp_fct, id, fct_cte; ring. Qed. Lemma derivable_pt_exp : forall x:R, derivable_pt exp x. Proof. intro. - unfold derivable_pt in |- *. + unfold derivable_pt. exists (exp x). apply derivable_pt_lim_exp. Qed. @@ -358,7 +358,7 @@ Qed. Lemma derivable_pt_cosh : forall x:R, derivable_pt cosh x. Proof. intro. - unfold derivable_pt in |- *. + unfold derivable_pt. exists (sinh x). apply derivable_pt_lim_cosh. Qed. @@ -366,24 +366,24 @@ Qed. Lemma derivable_pt_sinh : forall x:R, derivable_pt sinh x. Proof. intro. - unfold derivable_pt in |- *. + unfold derivable_pt. exists (cosh x). apply derivable_pt_lim_sinh. Qed. Lemma derivable_exp : derivable exp. Proof. - unfold derivable in |- *; apply derivable_pt_exp. + unfold derivable; apply derivable_pt_exp. Qed. Lemma derivable_cosh : derivable cosh. Proof. - unfold derivable in |- *; apply derivable_pt_cosh. + unfold derivable; apply derivable_pt_cosh. Qed. Lemma derivable_sinh : derivable sinh. Proof. - unfold derivable in |- *; apply derivable_pt_sinh. + unfold derivable; apply derivable_pt_sinh. Qed. Lemma derive_pt_exp : diff --git a/theories/Reals/Ranalysis5.v b/theories/Reals/Ranalysis5.v new file mode 100644 index 00000000..c8a2e1a8 --- /dev/null +++ b/theories/Reals/Ranalysis5.v @@ -0,0 +1,1348 @@ +Require Import Rbase. +Require Import Ranalysis_reg. +Require Import Rfunctions. +Require Import Rseries. +Require Import Fourier. +Require Import RiemannInt. +Require Import SeqProp. +Require Import Max. +Local Open Scope R_scope. + +(** * Preliminaries lemmas *) + +Lemma f_incr_implies_g_incr_interv : forall f g:R->R, forall lb ub, + lb < ub -> + (forall x y, lb <= x -> x < y -> y <= ub -> f x < f y) -> + (forall x, f lb <= x -> x <= f ub -> (comp f g) x = id x) -> + (forall x , f lb <= x -> x <= f ub -> lb <= g x <= ub) -> + (forall x y, f lb <= x -> x < y -> y <= f ub -> g x < g y). +Proof. +intros f g lb ub lb_lt_ub f_incr f_eq_g g_ok x y lb_le_x x_lt_y y_le_ub. + assert (x_encad : f lb <= x <= f ub). + split ; [assumption | apply Rle_trans with (r2:=y) ; [apply Rlt_le|] ; assumption]. + assert (y_encad : f lb <= y <= f ub). + split ; [apply Rle_trans with (r2:=x) ; [|apply Rlt_le] ; assumption | assumption]. + assert (Temp1 : lb <= lb) by intuition ; assert (Temp2 : ub <= ub) by intuition. + assert (gx_encad := g_ok _ (proj1 x_encad) (proj2 x_encad)). + assert (gy_encad := g_ok _ (proj1 y_encad) (proj2 y_encad)). + clear Temp1 Temp2. + case (Rlt_dec (g x) (g y)). + intuition. + intros Hfalse. + assert (Temp := Rnot_lt_le _ _ Hfalse). + assert (Hcontradiction : y <= x). + replace y with (id y) by intuition ; replace x with (id x) by intuition ; + rewrite <- f_eq_g. rewrite <- f_eq_g. + assert (f_incr2 : forall x y, lb <= x -> x <= y -> y < ub -> f x <= f y). + intros m n lb_le_m m_le_n n_lt_ub. + case (m_le_n). + intros ; apply Rlt_le ; apply f_incr ; [| | apply Rlt_le] ; assumption. + intros Hyp ; rewrite Hyp ; apply Req_le ; reflexivity. + apply f_incr2. + intuition. intuition. + Focus 3. intuition. + Focus 2. intuition. + Focus 2. intuition. Focus 2. intuition. + assert (Temp2 : g x <> ub). + intro Hf. + assert (Htemp : (comp f g) x = f ub). + unfold comp ; rewrite Hf ; reflexivity. + rewrite f_eq_g in Htemp ; unfold id in Htemp. + assert (Htemp2 : x < f ub). + apply Rlt_le_trans with (r2:=y) ; intuition. + clear -Htemp Htemp2. fourier. + intuition. intuition. + clear -Temp2 gx_encad. + case (proj2 gx_encad). + intuition. + intro Hfalse ; apply False_ind ; apply Temp2 ; assumption. + apply False_ind. clear - Hcontradiction x_lt_y. fourier. +Qed. + +Lemma derivable_pt_id_interv : forall (lb ub x:R), + lb <= x <= ub -> + derivable_pt id x. +Proof. +intros. + reg. +Qed. + +Lemma pr_nu_var2_interv : forall (f g : R -> R) (lb ub x : R) (pr1 : derivable_pt f x) + (pr2 : derivable_pt g x), + lb < ub -> + lb < x < ub -> + (forall h : R, lb < h < ub -> f h = g h) -> derive_pt f x pr1 = derive_pt g x pr2. +Proof. +intros f g lb ub x Prf Prg lb_lt_ub x_encad local_eq. +assert (forall x l, lb < x < ub -> (derivable_pt_abs f x l <-> derivable_pt_abs g x l)). + intros a l a_encad. + unfold derivable_pt_abs, derivable_pt_lim. + split. + intros Hyp eps eps_pos. + elim (Hyp eps eps_pos) ; intros delta Hyp2. + assert (Pos_cond : Rmin delta (Rmin (ub - a) (a - lb)) > 0). + clear-a lb ub a_encad delta. + apply Rmin_pos ; [exact (delta.(cond_pos)) | apply Rmin_pos ] ; apply Rlt_Rminus ; intuition. + exists (mkposreal (Rmin delta (Rmin (ub - a) (a - lb))) Pos_cond). + intros h h_neq h_encad. + replace (g (a + h) - g a) with (f (a + h) - f a). + apply Hyp2 ; intuition. + apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))). + assumption. apply Rmin_l. + assert (local_eq2 : forall h : R, lb < h < ub -> - f h = - g h). + intros ; apply Ropp_eq_compat ; intuition. + rewrite local_eq ; unfold Rminus. rewrite local_eq2. reflexivity. + assumption. + assert (Sublemma2 : forall x y, Rabs x < Rabs y -> y > 0 -> x < y). + intros m n Hyp_abs y_pos. apply Rlt_le_trans with (r2:=Rabs n). + apply Rle_lt_trans with (r2:=Rabs m) ; [ | assumption] ; apply RRle_abs. + apply Req_le ; apply Rabs_right ; apply Rgt_ge ; assumption. + split. + assert (Sublemma : forall x y z, -z < y - x -> x < y + z). + intros ; fourier. + apply Sublemma. + apply Sublemma2. rewrite Rabs_Ropp. + apply Rlt_le_trans with (r2:=a-lb) ; [| apply RRle_abs] ; + apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_r] ; + apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption. + apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_r] ; + apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption. + assert (Sublemma : forall x y z, y < z - x -> x + y < z). + intros ; fourier. + apply Sublemma. + apply Sublemma2. + apply Rlt_le_trans with (r2:=ub-a) ; [| apply RRle_abs] ; + apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_l] ; + apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption. + apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_l] ; + apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption. + intros Hyp eps eps_pos. + elim (Hyp eps eps_pos) ; intros delta Hyp2. + assert (Pos_cond : Rmin delta (Rmin (ub - a) (a - lb)) > 0). + clear-a lb ub a_encad delta. + apply Rmin_pos ; [exact (delta.(cond_pos)) | apply Rmin_pos ] ; apply Rlt_Rminus ; intuition. + exists (mkposreal (Rmin delta (Rmin (ub - a) (a - lb))) Pos_cond). + intros h h_neq h_encad. + replace (f (a + h) - f a) with (g (a + h) - g a). + apply Hyp2 ; intuition. + apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))). + assumption. apply Rmin_l. + assert (local_eq2 : forall h : R, lb < h < ub -> - f h = - g h). + intros ; apply Ropp_eq_compat ; intuition. + rewrite local_eq ; unfold Rminus. rewrite local_eq2. reflexivity. + assumption. + assert (Sublemma2 : forall x y, Rabs x < Rabs y -> y > 0 -> x < y). + intros m n Hyp_abs y_pos. apply Rlt_le_trans with (r2:=Rabs n). + apply Rle_lt_trans with (r2:=Rabs m) ; [ | assumption] ; apply RRle_abs. + apply Req_le ; apply Rabs_right ; apply Rgt_ge ; assumption. + split. + assert (Sublemma : forall x y z, -z < y - x -> x < y + z). + intros ; fourier. + apply Sublemma. + apply Sublemma2. rewrite Rabs_Ropp. + apply Rlt_le_trans with (r2:=a-lb) ; [| apply RRle_abs] ; + apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_r] ; + apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption. + apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_r] ; + apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption. + assert (Sublemma : forall x y z, y < z - x -> x + y < z). + intros ; fourier. + apply Sublemma. + apply Sublemma2. + apply Rlt_le_trans with (r2:=ub-a) ; [| apply RRle_abs] ; + apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_l] ; + apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption. + apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_l] ; + apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption. + unfold derivable_pt in Prf. + unfold derivable_pt in Prg. + elim Prf; intros. + elim Prg; intros. + assert (Temp := p); rewrite H in Temp. + unfold derivable_pt_abs in p. + unfold derivable_pt_abs in p0. + simpl in |- *. + apply (uniqueness_limite g x x0 x1 Temp p0). + assumption. +Qed. + + +(* begin hide *) +Lemma leftinv_is_rightinv : forall (f g:R->R), + (forall x y, x < y -> f x < f y) -> + (forall x, (comp f g) x = id x) -> + (forall x, (comp g f) x = id x). +Proof. +intros f g f_incr Hyp x. + assert (forall x, f (g (f x)) = f x). + intros ; apply Hyp. + assert(f_inj : forall x y, f x = f y -> x = y). + intros a b fa_eq_fb. + case(total_order_T a b). + intro s ; case s ; clear s. + intro Hf. + assert (Hfalse := f_incr a b Hf). + apply False_ind. apply (Rlt_not_eq (f a) (f b)) ; assumption. + intuition. + intro Hf. assert (Hfalse := f_incr b a Hf). + apply False_ind. apply (Rlt_not_eq (f b) (f a)) ; [|symmetry] ; assumption. + apply f_inj. unfold comp. + unfold comp in Hyp. + rewrite Hyp. + unfold id. + reflexivity. +Qed. +(* end hide *) + +Lemma leftinv_is_rightinv_interv : forall (f g:R->R) (lb ub:R), + (forall x y, lb <= x -> x < y -> y <= ub -> f x < f y) -> + (forall y, f lb <= y -> y <= f ub -> (comp f g) y = id y) -> + (forall x, f lb <= x -> x <= f ub -> lb <= g x <= ub) -> + forall x, + lb <= x <= ub -> + (comp g f) x = id x. +Proof. +intros f g lb ub f_incr_interv Hyp g_wf x x_encad. + assert(f_inj : forall x y, lb <= x <= ub -> lb <= y <= ub -> f x = f y -> x = y). + intros a b a_encad b_encad fa_eq_fb. + case(total_order_T a b). + intro s ; case s ; clear s. + intro Hf. + assert (Hfalse := f_incr_interv a b (proj1 a_encad) Hf (proj2 b_encad)). + apply False_ind. apply (Rlt_not_eq (f a) (f b)) ; assumption. + intuition. + intro Hf. assert (Hfalse := f_incr_interv b a (proj1 b_encad) Hf (proj2 a_encad)). + apply False_ind. apply (Rlt_not_eq (f b) (f a)) ; [|symmetry] ; assumption. + assert (f_incr_interv2 : forall x y, lb <= x -> x <= y -> y <= ub -> f x <= f y). + intros m n cond1 cond2 cond3. + case cond2. + intro cond. apply Rlt_le ; apply f_incr_interv ; assumption. + intro cond ; right ; rewrite cond ; reflexivity. + assert (Hyp2:forall x, lb <= x <= ub -> f (g (f x)) = f x). + intros ; apply Hyp. apply f_incr_interv2 ; intuition. + apply f_incr_interv2 ; intuition. + unfold comp ; unfold comp in Hyp. + apply f_inj. + apply g_wf ; apply f_incr_interv2 ; intuition. + unfold id ; assumption. + apply Hyp2 ; unfold id ; assumption. +Qed. + + +(** Intermediate Value Theorem on an Interval (Proof mainly taken from Reals.Rsqrt_def) and its corollary *) + +Lemma IVT_interv_prelim0 : forall (x y:R) (P:R->bool) (N:nat), + x < y -> + x <= Dichotomy_ub x y P N <= y /\ x <= Dichotomy_lb x y P N <= y. +Proof. +assert (Sublemma : forall x y lb ub, lb <= x <= ub /\ lb <= y <= ub -> lb <= (x+y) / 2 <= ub). + intros x y lb ub Hyp. + split. + replace lb with ((lb + lb) * /2) by field. + unfold Rdiv ; apply Rmult_le_compat_r ; intuition. + replace ub with ((ub + ub) * /2) by field. + unfold Rdiv ; apply Rmult_le_compat_r ; intuition. +intros x y P N x_lt_y. +induction N. + simpl ; intuition. + simpl. + case (P ((Dichotomy_lb x y P N + Dichotomy_ub x y P N) / 2)). + split. apply Sublemma ; intuition. + intuition. + split. intuition. + apply Sublemma ; intuition. +Qed. + +Lemma IVT_interv_prelim1 : forall (x y x0:R) (D : R -> bool), + x < y -> + Un_cv (dicho_up x y D) x0 -> + x <= x0 <= y. +Proof. +intros x y x0 D x_lt_y bnd. + assert (Main : forall n, x <= dicho_up x y D n <= y). + intro n. unfold dicho_up. + apply (proj1 (IVT_interv_prelim0 x y D n x_lt_y)). + split. + apply Rle_cv_lim with (Vn:=dicho_up x y D) (Un:=fun n => x). + intro n ; exact (proj1 (Main n)). + unfold Un_cv ; intros ; exists 0%nat ; intros ; unfold R_dist ; replace (x -x) with 0 by field ; rewrite Rabs_R0 ; assumption. + assumption. + apply Rle_cv_lim with (Un:=dicho_up x y D) (Vn:=fun n => y). + intro n ; exact (proj2 (Main n)). + assumption. + unfold Un_cv ; intros ; exists 0%nat ; intros ; unfold R_dist ; replace (y -y) with 0 by field ; rewrite Rabs_R0 ; assumption. +Qed. + +Lemma IVT_interv : forall (f : R -> R) (x y : R), + (forall a, x <= a <= y -> continuity_pt f a) -> + x < y -> + f x < 0 -> + 0 < f y -> + {z : R | x <= z <= y /\ f z = 0}. +Proof. +intros. (* f x y f_cont_interv x_lt_y fx_neg fy_pos.*) + 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. + exists 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 feqt;discriminate feqt. + 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 feqt; discriminate feqt. + intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H7)). + split. + intro; auto with real. + intro; reflexivity. + cut (Un_cv Wn x0). + intros. + assert (Temp : x <= x0 <= y). + apply IVT_interv_prelim1 with (D:=(fun z : R => cond_positivity (f z))) ; assumption. + assert (H7 := continuity_seq f Wn x0 (H x0 Temp) 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 (Temp : x <= x0 <= y). + apply IVT_interv_prelim1 with (D:=(fun z : R => cond_positivity (f z))) ; assumption. + assert (H7 := continuity_seq f Vn x0 (H x0 Temp) 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. + +(* begin hide *) +Ltac case_le H := + let t := type of H in + let h' := fresh in + match t with ?x <= ?y => case (total_order_T x y); + [intros h'; case h'; clear h' | + intros h'; clear -H h'; elimtype False; fourier ] end. +(* end hide *) + + +Lemma f_interv_is_interv : forall (f:R->R) (lb ub y:R), + lb < ub -> + f lb <= y <= f ub -> + (forall x, lb <= x <= ub -> continuity_pt f x) -> + {x | lb <= x <= ub /\ f x = y}. +Proof. +intros f lb ub y lb_lt_ub y_encad f_cont_interv. + case y_encad ; intro y_encad1. + case_le y_encad1 ; intros y_encad2 y_encad3 ; case_le y_encad3. + intro y_encad4. + clear y_encad y_encad1 y_encad3. + assert (Cont : forall a : R, lb <= a <= ub -> continuity_pt (fun x => f x - y) a). + intros a a_encad. unfold continuity_pt, continue_in, limit1_in, limit_in ; simpl ; unfold R_dist. + intros eps eps_pos. elim (f_cont_interv a a_encad eps eps_pos). + intros alpha alpha_pos. destruct alpha_pos as (alpha_pos,Temp). + exists alpha. split. + assumption. intros x x_cond. + replace (f x - y - (f a - y)) with (f x - f a) by field. + exact (Temp x x_cond). + assert (H1 : (fun x : R => f x - y) lb < 0). + apply Rlt_minus. assumption. + assert (H2 : 0 < (fun x : R => f x - y) ub). + apply Rgt_minus ; assumption. + destruct (IVT_interv (fun x => f x - y) lb ub Cont lb_lt_ub H1 H2) as (x,Hx). + exists x. + destruct Hx as (Hyp,Result). + intuition. + intro H ; exists ub ; intuition. + intro H ; exists lb ; intuition. + intro H ; exists ub ; intuition. +Qed. + +(** ** The derivative of a reciprocal function *) + + +(** * Continuity of the reciprocal function *) + +Lemma continuity_pt_recip_prelim : forall (f g:R->R) (lb ub : R) (Pr1:lb < ub), + (forall x y, lb <= x -> x < y -> y <= ub -> f x < f y) -> + (forall x, lb <= x <= ub -> (comp g f) x = id x) -> + (forall a, lb <= a <= ub -> continuity_pt f a) -> + forall b, + f lb < b < f ub -> + continuity_pt g b. +Proof. +assert (Sublemma : forall x y z, Rmax x y < z <-> x < z /\ y < z). + intros x y z. split. + unfold Rmax. case (Rle_dec x y) ; intros Hyp Hyp2. + split. apply Rle_lt_trans with (r2:=y) ; assumption. assumption. + split. assumption. apply Rlt_trans with (r2:=x). + assert (Temp : forall x y, ~ x <= y -> x > y). + intros m n Hypmn. intuition. + apply Temp ; clear Temp ; assumption. + assumption. + intros Hyp. + unfold Rmax. case (Rle_dec x y). + intro ; exact (proj2 Hyp). + intro ; exact (proj1 Hyp). +assert (Sublemma2 : forall x y z, Rmin x y > z <-> x > z /\ y > z). + intros x y z. split. + unfold Rmin. case (Rle_dec x y) ; intros Hyp Hyp2. + split. assumption. + apply Rlt_le_trans with (r2:=x) ; intuition. + split. + apply Rlt_trans with (r2:=y). intuition. + assert (Temp : forall x y, ~ x <= y -> x > y). + intros m n Hypmn. intuition. + apply Temp ; clear Temp ; assumption. + assumption. + intros Hyp. + unfold Rmin. case (Rle_dec x y). + intro ; exact (proj1 Hyp). + intro ; exact (proj2 Hyp). +assert (Sublemma3 : forall x y, x <= y /\ x <> y -> x < y). + intros m n Hyp. unfold Rle in Hyp. + destruct Hyp as (Hyp1,Hyp2). + case Hyp1. + intuition. + intro Hfalse ; apply False_ind ; apply Hyp2 ; exact Hfalse. +intros f g lb ub lb_lt_ub f_incr_interv f_eq_g f_cont_interv b b_encad. + assert (f_incr_interv2 : forall x y, lb <= x -> x <= y -> y <= ub -> f x <= f y). + intros m n cond1 cond2 cond3. + case cond2. + intro cond. apply Rlt_le ; apply f_incr_interv ; assumption. + intro cond ; right ; rewrite cond ; reflexivity. + unfold continuity_pt, continue_in, limit1_in, limit_in ; intros eps eps_pos. + unfold dist ; simpl ; unfold R_dist. + assert (b_encad_e : f lb <= b <= f ub) by intuition. + elim (f_interv_is_interv f lb ub b lb_lt_ub b_encad_e f_cont_interv) ; intros x Temp. + destruct Temp as (x_encad,f_x_b). + assert (lb_lt_x : lb < x). + assert (Temp : x <> lb). + intro Hfalse. + assert (Temp' : b = f lb). + rewrite <- f_x_b ; rewrite Hfalse ; reflexivity. + assert (Temp'' : b <> f lb). + apply Rgt_not_eq ; exact (proj1 b_encad). + apply Temp'' ; exact Temp'. + apply Sublemma3. + split. exact (proj1 x_encad). + assert (Temp2 : forall x y:R, x <> y <-> y <> x). + intros m n. split ; intuition. + rewrite Temp2 ; assumption. + assert (x_lt_ub : x < ub). + assert (Temp : x <> ub). + intro Hfalse. + assert (Temp' : b = f ub). + rewrite <- f_x_b ; rewrite Hfalse ; reflexivity. + assert (Temp'' : b <> f ub). + apply Rlt_not_eq ; exact (proj2 b_encad). + apply Temp'' ; exact Temp'. + apply Sublemma3. + split ; [exact (proj2 x_encad) | assumption]. + pose (x1 := Rmax (x - eps) lb). + pose (x2 := Rmin (x + eps) ub). + assert (Hx1 : x1 = Rmax (x - eps) lb) by intuition. + assert (Hx2 : x2 = Rmin (x + eps) ub) by intuition. + assert (x1_encad : lb <= x1 <= ub). + split. apply RmaxLess2. + apply Rlt_le. rewrite Hx1. rewrite Sublemma. + split. apply Rlt_trans with (r2:=x) ; fourier. + assumption. + assert (x2_encad : lb <= x2 <= ub). + split. apply Rlt_le ; rewrite Hx2 ; apply Rgt_lt ; rewrite Sublemma2. + split. apply Rgt_trans with (r2:=x) ; fourier. + assumption. + apply Rmin_r. + assert (x_lt_x2 : x < x2). + rewrite Hx2. + apply Rgt_lt. rewrite Sublemma2. + split ; fourier. + assert (x1_lt_x : x1 < x). + rewrite Hx1. + rewrite Sublemma. + split ; fourier. + exists (Rmin (f x - f x1) (f x2 - f x)). + split. apply Rmin_pos ; apply Rgt_minus. apply f_incr_interv ; [apply RmaxLess2 | | ] ; fourier. + apply f_incr_interv ; intuition. + intros y Temp. + destruct Temp as (_,y_cond). + rewrite <- f_x_b in y_cond. + assert (Temp : forall x y d1 d2, d1 > 0 -> d2 > 0 -> Rabs (y - x) < Rmin d1 d2 -> x - d1 <= y <= x + d2). + intros. + split. assert (H10 : forall x y z, x - y <= z -> x - z <= y). intuition. fourier. + apply H10. apply Rle_trans with (r2:=Rabs (y0 - x0)). + replace (Rabs (y0 - x0)) with (Rabs (x0 - y0)). apply RRle_abs. + rewrite <- Rabs_Ropp. unfold Rminus ; rewrite Ropp_plus_distr. rewrite Ropp_involutive. + intuition. + apply Rle_trans with (r2:= Rmin d1 d2). apply Rlt_le ; assumption. + apply Rmin_l. + assert (H10 : forall x y z, x - y <= z -> x <= y + z). intuition. fourier. + apply H10. apply Rle_trans with (r2:=Rabs (y0 - x0)). apply RRle_abs. + apply Rle_trans with (r2:= Rmin d1 d2). apply Rlt_le ; assumption. + apply Rmin_r. + assert (Temp' := Temp (f x) y (f x - f x1) (f x2 - f x)). + replace (f x - (f x - f x1)) with (f x1) in Temp' by field. + replace (f x + (f x2 - f x)) with (f x2) in Temp' by field. + assert (T : f x - f x1 > 0). + apply Rgt_minus. apply f_incr_interv ; intuition. + assert (T' : f x2 - f x > 0). + apply Rgt_minus. apply f_incr_interv ; intuition. + assert (Main := Temp' T T' y_cond). + clear Temp Temp' T T'. + assert (x1_lt_x2 : x1 < x2). + apply Rlt_trans with (r2:=x) ; assumption. + assert (f_cont_myinterv : forall a : R, x1 <= a <= x2 -> continuity_pt f a). + intros ; apply f_cont_interv ; split. + apply Rle_trans with (r2 := x1) ; intuition. + apply Rle_trans with (r2 := x2) ; intuition. + elim (f_interv_is_interv f x1 x2 y x1_lt_x2 Main f_cont_myinterv) ; intros x' Temp. + destruct Temp as (x'_encad,f_x'_y). + rewrite <- f_x_b ; rewrite <- f_x'_y. + unfold comp in f_eq_g. rewrite f_eq_g. rewrite f_eq_g. + unfold id. + assert (x'_encad2 : x - eps <= x' <= x + eps). + split. + apply Rle_trans with (r2:=x1) ; [ apply RmaxLess1|] ; intuition. + apply Rle_trans with (r2:=x2) ; [ | apply Rmin_l] ; intuition. + assert (x1_lt_x' : x1 < x'). + apply Sublemma3. + assert (x1_neq_x' : x1 <> x'). + intro Hfalse. rewrite Hfalse, f_x'_y in y_cond. + assert (Hf : Rabs (y - f x) < f x - y). + apply Rlt_le_trans with (r2:=Rmin (f x - y) (f x2 - f x)). fourier. + apply Rmin_l. + assert(Hfin : f x - y < f x - y). + apply Rle_lt_trans with (r2:=Rabs (y - f x)). + replace (Rabs (y - f x)) with (Rabs (f x - y)). apply RRle_abs. + rewrite <- Rabs_Ropp. replace (- (f x - y)) with (y - f x) by field ; reflexivity. fourier. + apply (Rlt_irrefl (f x - y)) ; assumption. + split ; intuition. + assert (x'_lb : x - eps < x'). + apply Sublemma3. + split. intuition. apply Rlt_not_eq. + apply Rle_lt_trans with (r2:=x1) ; [ apply RmaxLess1|] ; intuition. + assert (x'_lt_x2 : x' < x2). + apply Sublemma3. + assert (x1_neq_x' : x' <> x2). + intro Hfalse. rewrite <- Hfalse, f_x'_y in y_cond. + assert (Hf : Rabs (y - f x) < y - f x). + apply Rlt_le_trans with (r2:=Rmin (f x - f x1) (y - f x)). fourier. + apply Rmin_r. + assert(Hfin : y - f x < y - f x). + apply Rle_lt_trans with (r2:=Rabs (y - f x)). apply RRle_abs. fourier. + apply (Rlt_irrefl (y - f x)) ; assumption. + split ; intuition. + assert (x'_ub : x' < x + eps). + apply Sublemma3. + split. intuition. apply Rlt_not_eq. + apply Rlt_le_trans with (r2:=x2) ; [ |rewrite Hx2 ; apply Rmin_l] ; intuition. + apply Rabs_def1 ; fourier. + assumption. + split. apply Rle_trans with (r2:=x1) ; intuition. + apply Rle_trans with (r2:=x2) ; intuition. +Qed. + +Lemma continuity_pt_recip_interv : forall (f g:R->R) (lb ub : R) (Pr1:lb < ub), + (forall x y, lb <= x -> x < y -> y <= ub -> f x < f y) -> + (forall x, f lb <= x -> x <= f ub -> (comp f g) x = id x) -> + (forall x, f lb <= x -> x <= f ub -> lb <= g x <= ub) -> + (forall a, lb <= a <= ub -> continuity_pt f a) -> + forall b, + f lb < b < f ub -> + continuity_pt g b. +Proof. +intros f g lb ub lb_lt_ub f_incr_interv f_eq_g g_wf. +assert (g_eq_f_prelim := leftinv_is_rightinv_interv f g lb ub f_incr_interv f_eq_g). +assert (g_eq_f : forall x, lb <= x <= ub -> (comp g f) x = id x). +intro x ; apply g_eq_f_prelim ; assumption. +apply (continuity_pt_recip_prelim f g lb ub lb_lt_ub f_incr_interv g_eq_f). +Qed. + +(** * Derivability of the reciprocal function *) + +Lemma derivable_pt_lim_recip_interv : forall (f g:R->R) (lb ub x:R) + (Prf:forall a : R, g lb <= a <= g ub -> derivable_pt f a) (Prg : continuity_pt g x), + lb < ub -> + lb < x < ub -> + forall (Prg_incr:g lb <= g x <= g ub), + (forall x, lb <= x <= ub -> (comp f g) x = id x) -> + derive_pt f (g x) (Prf (g x) Prg_incr) <> 0 -> + derivable_pt_lim g x (1 / derive_pt f (g x) (Prf (g x) Prg_incr)). +Proof. +intros f g lb ub x Prf g_cont_pur lb_lt_ub x_encad Prg_incr f_eq_g df_neq. + assert (x_encad2 : lb <= x <= ub). + split ; apply Rlt_le ; intuition. + elim (Prf (g x)); simpl; intros l Hl. + unfold derivable_pt_lim. + intros eps eps_pos. + pose (y := g x). + assert (Hlinv := limit_inv). + assert (Hf_deriv : forall eps:R, + 0 < eps -> + exists delta : posreal, + (forall h:R, + h <> 0 -> Rabs h < delta -> Rabs ((f (g x + h) - f (g x)) / h - l) < eps)). + intros eps0 eps0_pos. + red in Hl ; red in Hl. elim (Hl eps0 eps0_pos). + intros deltatemp Htemp. + exists deltatemp ; exact Htemp. + elim (Hf_deriv eps eps_pos). + intros deltatemp Htemp. + red in Hlinv ; red in Hlinv ; simpl dist in Hlinv ; unfold R_dist in Hlinv. + assert (Hlinv' := Hlinv (fun h => (f (y+h) - f y)/h) (fun h => h <>0) l 0). + unfold limit1_in, limit_in, dist in Hlinv' ; simpl in Hlinv'. unfold R_dist in Hlinv'. + assert (Premisse : (forall eps : R, + eps > 0 -> + exists alp : R, + alp > 0 /\ + (forall x : R, + (fun h => h <>0) x /\ Rabs (x - 0) < alp -> + Rabs ((f (y + x) - f y) / x - l) < eps))). + intros eps0 eps0_pos. + elim (Hf_deriv eps0 eps0_pos). + intros deltatemp' Htemp'. + exists deltatemp'. + split. + exact deltatemp'.(cond_pos). + intros htemp cond. + apply (Htemp' htemp). + exact (proj1 cond). + replace (htemp) with (htemp - 0). + exact (proj2 cond). + intuition. + assert (Premisse2 : l <> 0). + intro l_null. + rewrite l_null in Hl. + apply df_neq. + rewrite derive_pt_eq. + exact Hl. + elim (Hlinv' Premisse Premisse2 eps eps_pos). + intros alpha cond. + assert (alpha_pos := proj1 cond) ; assert (inv_cont := proj2 cond) ; clear cond. + unfold derivable, derivable_pt, derivable_pt_abs, derivable_pt_lim in Prf. + elim (Hl eps eps_pos). + intros delta f_deriv. + assert (g_cont := g_cont_pur). + unfold continuity_pt, continue_in, limit1_in, limit_in in g_cont. + pose (mydelta := Rmin delta alpha). + assert (mydelta_pos : mydelta > 0). + unfold mydelta, Rmin. + case (Rle_dec delta alpha). + intro ; exact (delta.(cond_pos)). + intro ; exact alpha_pos. + elim (g_cont mydelta mydelta_pos). + intros delta' new_g_cont. + assert(delta'_pos := proj1 (new_g_cont)). + clear g_cont ; assert (g_cont := proj2 (new_g_cont)) ; clear new_g_cont. + pose (mydelta'' := Rmin delta' (Rmin (x - lb) (ub - x))). + assert(mydelta''_pos : mydelta'' > 0). + unfold mydelta''. + apply Rmin_pos ; [intuition | apply Rmin_pos] ; apply Rgt_minus ; intuition. + pose (delta'' := mkposreal mydelta'' mydelta''_pos: posreal). + exists delta''. + intros h h_neq h_le_delta'. + assert (lb <= x +h <= ub). + assert (Sublemma2 : forall x y, Rabs x < Rabs y -> y > 0 -> x < y). + intros m n Hyp_abs y_pos. apply Rlt_le_trans with (r2:=Rabs n). + apply Rle_lt_trans with (r2:=Rabs m) ; [ | assumption] ; apply RRle_abs. + apply Req_le ; apply Rabs_right ; apply Rgt_ge ; assumption. + assert (lb <= x + h <= ub). + split. + assert (Sublemma : forall x y z, -z <= y - x -> x <= y + z). + intros ; fourier. + apply Sublemma. + apply Rlt_le ; apply Sublemma2. rewrite Rabs_Ropp. + apply Rlt_le_trans with (r2:=x-lb) ; [| apply RRle_abs] ; + apply Rlt_le_trans with (r2:=Rmin (x - lb) (ub - x)) ; [| apply Rmin_l] ; + apply Rlt_le_trans with (r2:=Rmin delta' (Rmin (x - lb) (ub - x))). + apply Rlt_le_trans with (r2:=delta''). assumption. intuition. apply Rmin_r. + apply Rgt_minus. intuition. + assert (Sublemma : forall x y z, y <= z - x -> x + y <= z). + intros ; fourier. + apply Sublemma. + apply Rlt_le ; apply Sublemma2. + apply Rlt_le_trans with (r2:=ub-x) ; [| apply RRle_abs] ; + apply Rlt_le_trans with (r2:=Rmin (x - lb) (ub - x)) ; [| apply Rmin_r] ; + apply Rlt_le_trans with (r2:=Rmin delta' (Rmin (x - lb) (ub - x))) ; [| apply Rmin_r] ; assumption. + apply Rlt_le_trans with (r2:=delta''). assumption. + apply Rle_trans with (r2:=Rmin delta' (Rmin (x - lb) (ub - x))). intuition. + apply Rle_trans with (r2:=Rmin (x - lb) (ub - x)). apply Rmin_r. apply Rmin_r. + replace ((g (x + h) - g x) / h) with (1/ (h / (g (x + h) - g x))). + assert (Hrewr : h = (comp f g ) (x+h) - (comp f g) x). + rewrite f_eq_g. rewrite f_eq_g ; unfold id. rewrite Rplus_comm ; + unfold Rminus ; rewrite Rplus_assoc ; rewrite Rplus_opp_r. intuition. intuition. + assumption. + split ; [|intuition]. + assert (Sublemma : forall x y z, - z <= y - x -> x <= y + z). + intros ; fourier. + apply Sublemma ; apply Rlt_le ; apply Sublemma2. rewrite Rabs_Ropp. + apply Rlt_le_trans with (r2:=x-lb) ; [| apply RRle_abs] ; + apply Rlt_le_trans with (r2:=Rmin (x - lb) (ub - x)) ; [| apply Rmin_l] ; + apply Rlt_le_trans with (r2:=Rmin delta' (Rmin (x - lb) (ub - x))) ; [| apply Rmin_r] ; assumption. + apply Rgt_minus. intuition. + field. + split. assumption. + intro Hfalse. assert (Hf : g (x+h) = g x) by intuition. + assert ((comp f g) (x+h) = (comp f g) x). + unfold comp ; rewrite Hf ; intuition. + assert (Main : x+h = x). + replace (x +h) with (id (x+h)) by intuition. + assert (Temp : x = id x) by intuition ; rewrite Temp at 2 ; clear Temp. + rewrite <- f_eq_g. rewrite <- f_eq_g. assumption. + intuition. assumption. + assert (h = 0). + apply Rplus_0_r_uniq with (r:=x) ; assumption. + apply h_neq ; assumption. + replace ((g (x + h) - g x) / h) with (1/ (h / (g (x + h) - g x))). + assert (Hrewr : h = (comp f g ) (x+h) - (comp f g) x). + rewrite f_eq_g. rewrite f_eq_g. unfold id ; rewrite Rplus_comm ; + unfold Rminus ; rewrite Rplus_assoc ; rewrite Rplus_opp_r ; intuition. + assumption. assumption. + rewrite Hrewr at 1. + unfold comp. + replace (g(x+h)) with (g x + (g (x+h) - g(x))) by field. + pose (h':=g (x+h) - g x). + replace (g (x+h) - g x) with h' by intuition. + replace (g x + h' - g x) with h' by field. + assert (h'_neq : h' <> 0). + unfold h'. + intro Hfalse. + unfold Rminus in Hfalse ; apply Rminus_diag_uniq in Hfalse. + assert (Hfalse' : (comp f g) (x+h) = (comp f g) x). + intros ; unfold comp ; rewrite Hfalse ; trivial. + rewrite f_eq_g in Hfalse' ; rewrite f_eq_g in Hfalse'. + unfold id in Hfalse'. + apply Rplus_0_r_uniq in Hfalse'. + apply h_neq ; exact Hfalse'. assumption. assumption. assumption. + unfold Rdiv at 1 3; rewrite Rmult_1_l ; rewrite Rmult_1_l. + apply inv_cont. + split. + exact h'_neq. + rewrite Rminus_0_r. + unfold continuity_pt, continue_in, limit1_in, limit_in in g_cont_pur. + elim (g_cont_pur mydelta mydelta_pos). + intros delta3 cond3. + unfold dist in cond3 ; simpl in cond3 ; unfold R_dist in cond3. + unfold h'. + assert (mydelta_le_alpha : mydelta <= alpha). + unfold mydelta, Rmin ; case (Rle_dec delta alpha). + trivial. + intro ; intuition. + apply Rlt_le_trans with (r2:=mydelta). + unfold dist in g_cont ; simpl in g_cont ; unfold R_dist in g_cont ; apply g_cont. + split. + unfold D_x ; simpl. + split. + unfold no_cond ; trivial. + intro Hfalse ; apply h_neq. + apply (Rplus_0_r_uniq x). + symmetry ; assumption. + replace (x + h - x) with h by field. + apply Rlt_le_trans with (r2:=delta''). + assumption ; unfold delta''. intuition. + apply Rle_trans with (r2:=mydelta''). apply Req_le. unfold delta''. intuition. + apply Rmin_l. assumption. + field ; split. + assumption. + intro Hfalse ; apply h_neq. + apply (Rplus_0_r_uniq x). + assert (Hfin : (comp f g) (x+h) = (comp f g) x). + apply Rminus_diag_uniq in Hfalse. + unfold comp. + rewrite Hfalse ; reflexivity. + rewrite f_eq_g in Hfin. rewrite f_eq_g in Hfin. unfold id in Hfin. exact Hfin. + assumption. assumption. +Qed. + +Lemma derivable_pt_recip_interv_prelim0 : forall (f g : R -> R) (lb ub x : R) + (Prf : forall a : R, g lb <= a <= g ub -> derivable_pt f a), + continuity_pt g x -> + lb < ub -> + lb < x < ub -> + forall Prg_incr : g lb <= g x <= g ub, + (forall x0 : R, lb <= x0 <= ub -> comp f g x0 = id x0) -> + derive_pt f (g x) (Prf (g x) Prg_incr) <> 0 -> + derivable_pt g x. +Proof. +intros f g lb ub x Prf g_cont_pt lb_lt_ub x_encad Prg_incr f_eq_g Df_neq. +unfold derivable_pt, derivable_pt_abs. +exists (1 / derive_pt f (g x) (Prf (g x) Prg_incr)). +apply derivable_pt_lim_recip_interv ; assumption. +Qed. + +Lemma derivable_pt_recip_interv_prelim1 :forall (f g:R->R) (lb ub x : R), + lb < ub -> + f lb < x < f ub -> + (forall x : R, f lb <= x -> x <= f ub -> comp f g x = id x) -> + (forall x : R, f lb <= x -> x <= f ub -> lb <= g x <= ub) -> + (forall x y : R, lb <= x -> x < y -> y <= ub -> f x < f y) -> + (forall a : R, lb <= a <= ub -> derivable_pt f a) -> + derivable_pt f (g x). +Proof. +intros f g lb ub x lb_lt_ub x_encad f_eq_g g_ok f_incr f_derivable. + apply f_derivable. + assert (Left_inv := leftinv_is_rightinv_interv f g lb ub f_incr f_eq_g g_ok). + replace lb with ((comp g f) lb). + replace ub with ((comp g f) ub). + unfold comp. + assert (Temp:= f_incr_implies_g_incr_interv f g lb ub lb_lt_ub f_incr f_eq_g g_ok). + split ; apply Rlt_le ; apply Temp ; intuition. + apply Left_inv ; intuition. + apply Left_inv ; intuition. +Qed. + +Lemma derivable_pt_recip_interv : forall (f g:R->R) (lb ub x : R) + (lb_lt_ub:lb < ub) (x_encad:f lb < x < f ub) + (f_eq_g:forall x : R, f lb <= x -> x <= f ub -> comp f g x = id x) + (g_wf:forall x : R, f lb <= x -> x <= f ub -> lb <= g x <= ub) + (f_incr:forall x y : R, lb <= x -> x < y -> y <= ub -> f x < f y) + (f_derivable:forall a : R, lb <= a <= ub -> derivable_pt f a), + derive_pt f (g x) + (derivable_pt_recip_interv_prelim1 f g lb ub x lb_lt_ub + x_encad f_eq_g g_wf f_incr f_derivable) + <> 0 -> + derivable_pt g x. +Proof. +intros f g lb ub x lb_lt_ub x_encad f_eq_g g_wf f_incr f_derivable Df_neq. + assert(g_incr : g (f lb) < g x < g (f ub)). + assert (Temp:= f_incr_implies_g_incr_interv f g lb ub lb_lt_ub f_incr f_eq_g g_wf). + split ; apply Temp ; intuition. + exact (proj1 x_encad). apply Rlt_le ; exact (proj2 x_encad). + apply Rlt_le ; exact (proj1 x_encad). exact (proj2 x_encad). + assert(g_incr2 : g (f lb) <= g x <= g (f ub)). + split ; apply Rlt_le ; intuition. + assert (g_eq_f := leftinv_is_rightinv_interv f g lb ub f_incr f_eq_g g_wf). + unfold comp, id in g_eq_f. + assert (f_derivable2 : forall a : R, g (f lb) <= a <= g (f ub) -> derivable_pt f a). + intros a a_encad ; apply f_derivable. + rewrite g_eq_f in a_encad ; rewrite g_eq_f in a_encad ; intuition. + apply derivable_pt_recip_interv_prelim0 with (f:=f) (lb:=f lb) (ub:=f ub) + (Prf:=f_derivable2) (Prg_incr:=g_incr2). + apply continuity_pt_recip_interv with (f:=f) (lb:=lb) (ub:=ub) ; intuition. + apply derivable_continuous_pt ; apply f_derivable ; intuition. + exact (proj1 x_encad). exact (proj2 x_encad). apply f_incr ; intuition. + assumption. + intros x0 x0_encad ; apply f_eq_g ; intuition. + rewrite pr_nu_var2_interv with (g:=f) (lb:=lb) (ub:=ub) (pr2:=derivable_pt_recip_interv_prelim1 f g lb ub x lb_lt_ub x_encad + f_eq_g g_wf f_incr f_derivable) ; [| |rewrite g_eq_f in g_incr ; rewrite g_eq_f in g_incr| ] ; intuition. +Qed. + +(****************************************************) +(** * Value of the derivative of the reciprocal function *) +(****************************************************) + +Lemma derive_pt_recip_interv_prelim0 : forall (f g:R->R) (lb ub x:R) + (Prf:derivable_pt f (g x)) (Prg:derivable_pt g x), + lb < ub -> + lb < x < ub -> + (forall x, lb < x < ub -> (comp f g) x = id x) -> + derive_pt f (g x) Prf <> 0 -> + derive_pt g x Prg = 1 / (derive_pt f (g x) Prf). +Proof. +intros f g lb ub x Prf Prg lb_lt_ub x_encad local_recip Df_neq. + replace (derive_pt g x Prg) with + ((derive_pt g x Prg) * (derive_pt f (g x) Prf) * / (derive_pt f (g x) Prf)). + unfold Rdiv. + rewrite (Rmult_comm _ (/ derive_pt f (g x) Prf)). + rewrite (Rmult_comm _ (/ derive_pt f (g x) Prf)). + apply Rmult_eq_compat_l. + rewrite Rmult_comm. + rewrite <- derive_pt_comp. + assert (x_encad2 : lb <= x <= ub) by intuition. + rewrite pr_nu_var2_interv with (g:=id) (pr2:= derivable_pt_id_interv lb ub x x_encad2) (lb:=lb) (ub:=ub) ; [reg| | |] ; assumption. + rewrite Rmult_assoc, Rinv_r. + intuition. + assumption. +Qed. + +Lemma derive_pt_recip_interv_prelim1_0 : forall (f g:R->R) (lb ub x:R), + lb < ub -> + f lb < x < f ub -> + (forall x y : R, lb <= x -> x < y -> y <= ub -> f x < f y) -> + (forall x : R, f lb <= x -> x <= f ub -> lb <= g x <= ub) -> + (forall x, f lb <= x -> x <= f ub -> (comp f g) x = id x) -> + lb < g x < ub. +Proof. +intros f g lb ub x lb_lt_ub x_encad f_incr g_wf f_eq_g. + assert (Temp:= f_incr_implies_g_incr_interv f g lb ub lb_lt_ub f_incr f_eq_g g_wf). + assert (Left_inv := leftinv_is_rightinv_interv f g lb ub f_incr f_eq_g g_wf). + unfold comp, id in Left_inv. + split ; [rewrite <- Left_inv with (x:=lb) | rewrite <- Left_inv ]. + apply Temp ; intuition. + intuition. + apply Temp ; intuition. + intuition. +Qed. + +Lemma derive_pt_recip_interv_prelim1_1 : forall (f g:R->R) (lb ub x:R), + lb < ub -> + f lb < x < f ub -> + (forall x y : R, lb <= x -> x < y -> y <= ub -> f x < f y) -> + (forall x : R, f lb <= x -> x <= f ub -> lb <= g x <= ub) -> + (forall x, f lb <= x -> x <= f ub -> (comp f g) x = id x) -> + lb <= g x <= ub. +Proof. +intros f g lb ub x lb_lt_ub x_encad f_incr g_wf f_eq_g. + assert (Temp := derive_pt_recip_interv_prelim1_0 f g lb ub x lb_lt_ub x_encad f_incr g_wf f_eq_g). + split ; apply Rlt_le ; intuition. +Qed. + +Lemma derive_pt_recip_interv : forall (f g:R->R) (lb ub x:R) + (lb_lt_ub:lb < ub) (x_encad:f lb < x < f ub) + (f_incr:forall x y : R, lb <= x -> x < y -> y <= ub -> f x < f y) + (g_wf:forall x : R, f lb <= x -> x <= f ub -> lb <= g x <= ub) + (Prf:forall a : R, lb <= a <= ub -> derivable_pt f a) + (f_eq_g:forall x, f lb <= x -> x <= f ub -> (comp f g) x = id x) + (Df_neq:derive_pt f (g x) (derivable_pt_recip_interv_prelim1 f g lb ub x + lb_lt_ub x_encad f_eq_g g_wf f_incr Prf) <> 0), + derive_pt g x (derivable_pt_recip_interv f g lb ub x lb_lt_ub x_encad f_eq_g + g_wf f_incr Prf Df_neq) + = + 1 / (derive_pt f (g x) (Prf (g x) (derive_pt_recip_interv_prelim1_1 f g lb ub x + lb_lt_ub x_encad f_incr g_wf f_eq_g))). +Proof. +intros. + assert(g_incr := (derive_pt_recip_interv_prelim1_1 f g lb ub x lb_lt_ub + x_encad f_incr g_wf f_eq_g)). + apply derive_pt_recip_interv_prelim0 with (lb:=f lb) (ub:=f ub) ; + [intuition |assumption | intuition |]. + intro Hfalse ; apply Df_neq. rewrite pr_nu_var2_interv with (g:=f) (lb:=lb) (ub:=ub) + (pr2:= (Prf (g x) (derive_pt_recip_interv_prelim1_1 f g lb ub x lb_lt_ub x_encad + f_incr g_wf f_eq_g))) ; + [intuition | intuition | | intuition]. + exact (derive_pt_recip_interv_prelim1_0 f g lb ub x lb_lt_ub x_encad f_incr g_wf f_eq_g). +Qed. + +(****************************************************) +(** * Existence of the derivative of a function which is the limit of a sequence of functions *) +(****************************************************) + +(* begin hide *) +Lemma ub_lt_2_pos : forall x ub lb, lb < x -> x < ub -> 0 < (ub-lb)/2. +Proof. +intros x ub lb lb_lt_x x_lt_ub. + assert (T : 0 < ub - lb). + fourier. + unfold Rdiv ; apply Rlt_mult_inv_pos ; intuition. +Qed. + +Definition mkposreal_lb_ub (x lb ub:R) (lb_lt_x:lb<x) (x_lt_ub:x<ub) : posreal. + apply (mkposreal ((ub-lb)/2) (ub_lt_2_pos x ub lb lb_lt_x x_lt_ub)). +Defined. +(* end hide *) + +Definition boule_of_interval x y (h : x < y) : + {c :R & {r : posreal | c - r = x /\ c + r = y}}. +exists ((x + y)/2). +assert (radius : 0 < (y - x)/2). + unfold Rdiv; apply Rmult_lt_0_compat; fourier. + exists (mkposreal _ radius). + simpl; split; unfold Rdiv; field. +Qed. + +Definition boule_in_interval x y z (h : x < z < y) : + {c : R & {r | Boule c r z /\ x < c - r /\ c + r < y}}. +Proof. +assert (cmp : x * /2 + z * /2 < z * /2 + y * /2). +destruct h as [h1 h2]; fourier. +destruct (boule_of_interval _ _ cmp) as [c [r [P1 P2]]]. +exists c, r; split. + destruct h; unfold Boule; simpl; apply Rabs_def1; fourier. +destruct h; split; fourier. +Qed. + +Lemma Ball_in_inter : forall c1 c2 r1 r2 x, + Boule c1 r1 x -> Boule c2 r2 x -> + {r3 : posreal | forall y, Boule x r3 y -> Boule c1 r1 y /\ Boule c2 r2 y}. +intros c1 c2 [r1 r1p] [r2 r2p] x; unfold Boule; simpl; intros in1 in2. +assert (Rmax (c1 - r1)(c2 - r2) < x). + apply Rmax_lub_lt;[revert in1 | revert in2]; intros h; + apply Rabs_def2 in h; destruct h; fourier. +assert (x < Rmin (c1 + r1) (c2 + r2)). + apply Rmin_glb_lt;[revert in1 | revert in2]; intros h; + apply Rabs_def2 in h; destruct h; fourier. +assert (t: 0 < Rmin (x - Rmax (c1 - r1) (c2 - r2)) + (Rmin (c1 + r1) (c2 + r2) - x)). + apply Rmin_glb_lt; fourier. +exists (mkposreal _ t). +apply Rabs_def2 in in1; destruct in1. +apply Rabs_def2 in in2; destruct in2. +assert (c1 - r1 <= Rmax (c1 - r1) (c2 - r2)) by apply Rmax_l. +assert (c2 - r2 <= Rmax (c1 - r1) (c2 - r2)) by apply Rmax_r. +assert (Rmin (c1 + r1) (c2 + r2) <= c1 + r1) by apply Rmin_l. +assert (Rmin (c1 + r1) (c2 + r2) <= c2 + r2) by apply Rmin_r. +assert (Rmin (x - Rmax (c1 - r1) (c2 - r2)) + (Rmin (c1 + r1) (c2 + r2) - x) <= x - Rmax (c1 - r1) (c2 - r2)) + by apply Rmin_l. +assert (Rmin (x - Rmax (c1 - r1) (c2 - r2)) + (Rmin (c1 + r1) (c2 + r2) - x) <= Rmin (c1 + r1) (c2 + r2) - x) + by apply Rmin_r. +simpl. +intros y h; apply Rabs_def2 in h; destruct h;split; apply Rabs_def1; fourier. +Qed. + +Lemma Boule_center : forall x r, Boule x r x. +Proof. +intros x [r rpos]; unfold Boule, Rminus; simpl; rewrite Rplus_opp_r. +rewrite Rabs_pos_eq;[assumption | apply Rle_refl]. +Qed. + +Lemma derivable_pt_lim_CVU : forall (fn fn':nat -> R -> R) (f g:R->R) + (x:R) c r, Boule c r x -> + (forall y n, Boule c r y -> derivable_pt_lim (fn n) y (fn' n y)) -> + (forall y, Boule c r y -> Un_cv (fun n => fn n y) (f y)) -> + (CVU fn' g c r) -> + (forall y, Boule c r y -> continuity_pt g y) -> + derivable_pt_lim f x (g x). +Proof. +intros fn fn' f g x c' r xinb Dfn_eq_fn' fn_CV_f fn'_CVU_g g_cont eps eps_pos. +assert (eps_8_pos : 0 < eps / 8) by fourier. +elim (g_cont x xinb _ eps_8_pos) ; clear g_cont ; +intros delta1 (delta1_pos, g_cont). +destruct (Ball_in_inter _ _ _ _ _ xinb + (Boule_center x (mkposreal _ delta1_pos))) + as [delta Pdelta]. +exists delta; intros h hpos hinbdelta. +assert (eps'_pos : 0 < (Rabs h) * eps / 4). + unfold Rdiv ; rewrite Rmult_assoc ; apply Rmult_lt_0_compat. + apply Rabs_pos_lt ; assumption. +fourier. +destruct (fn_CV_f x xinb ((Rabs h) * eps / 4) eps'_pos) as [N2 fnx_CV_fx]. +assert (xhinbxdelta : Boule x delta (x + h)). + clear -hinbdelta; apply Rabs_def2 in hinbdelta; unfold Boule; simpl. + destruct hinbdelta; apply Rabs_def1; fourier. +assert (t : Boule c' r (x + h)). + apply Pdelta in xhinbxdelta; tauto. +destruct (fn_CV_f (x+h) t ((Rabs h) * eps / 4) eps'_pos) as [N1 fnxh_CV_fxh]. +clear fn_CV_f t. +destruct (fn'_CVU_g (eps/8) eps_8_pos) as [N3 fn'c_CVU_gc]. +pose (N := ((N1 + N2) + N3)%nat). +assert (Main : Rabs ((f (x+h) - fn N (x+h)) - (f x - fn N x) + (fn N (x+h) - fn N x - h * (g x))) < (Rabs h)*eps). + apply Rle_lt_trans with (Rabs (f (x + h) - fn N (x + h) - (f x - fn N x)) + Rabs ((fn N (x + h) - fn N x - h * g x))). + solve[apply Rabs_triang]. + apply Rle_lt_trans with (Rabs (f (x + h) - fn N (x + h)) + Rabs (- (f x - fn N x)) + Rabs (fn N (x + h) - fn N x - h * g x)). + solve[apply Rplus_le_compat_r ; apply Rabs_triang]. + rewrite Rabs_Ropp. + case (Rlt_le_dec h 0) ; intro sgn_h. + assert (pr1 : forall c : R, x + h < c < x -> derivable_pt (fn N) c). + intros c c_encad ; unfold derivable_pt. + exists (fn' N c) ; apply Dfn_eq_fn'. + assert (t : Boule x delta c). + apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta; destruct c_encad. + apply Rabs_def2 in xinb; apply Rabs_def1; fourier. + apply Pdelta in t; tauto. + assert (pr2 : forall c : R, x + h < c < x -> derivable_pt id c). + solve[intros; apply derivable_id]. + assert (xh_x : x+h < x) by fourier. + assert (pr3 : forall c : R, x + h <= c <= x -> continuity_pt (fn N) c). + intros c c_encad ; apply derivable_continuous_pt. + exists (fn' N c) ; apply Dfn_eq_fn' ; intuition. + assert (t : Boule x delta c). + apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta. + apply Rabs_def2 in xinb; apply Rabs_def1; fourier. + apply Pdelta in t; tauto. + assert (pr4 : forall c : R, x + h <= c <= x -> continuity_pt id c). + solve[intros; apply derivable_continuous ; apply derivable_id]. + destruct (MVT (fn N) id (x+h) x pr1 pr2 xh_x pr3 pr4) as [c [P Hc]]. + assert (Hc' : h * derive_pt (fn N) c (pr1 c P) = (fn N (x+h) - fn N x)). + apply Rmult_eq_reg_l with (-1). + replace (-1 * (h * derive_pt (fn N) c (pr1 c P))) with (-h * derive_pt (fn N) c (pr1 c P)) by field. + replace (-1 * (fn N (x + h) - fn N x)) with (- (fn N (x + h) - fn N x)) by field. + replace (-h) with (id x - id (x + h)) by (unfold id; field). + rewrite <- Rmult_1_r ; replace 1 with (derive_pt id c (pr2 c P)) by reg. + replace (- (fn N (x + h) - fn N x)) with (fn N x - fn N (x + h)) by field. + assumption. + solve[apply Rlt_not_eq ; intuition]. + rewrite <- Hc'; clear Hc Hc'. + replace (derive_pt (fn N) c (pr1 c P)) with (fn' N c). + replace (h * fn' N c - h * g x) with (h * (fn' N c - g x)) by field. + rewrite Rabs_mult. + apply Rlt_trans with (Rabs h * eps / 4 + Rabs (f x - fn N x) + Rabs h * Rabs (fn' N c - g x)). + apply Rplus_lt_compat_r ; apply Rplus_lt_compat_r ; unfold R_dist in fnxh_CV_fxh ; + rewrite Rabs_minus_sym ; apply fnxh_CV_fxh. + unfold N; omega. + apply Rlt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 + Rabs h * Rabs (fn' N c - g x)). + apply Rplus_lt_compat_r ; apply Rplus_lt_compat_l. + unfold R_dist in fnx_CV_fx ; rewrite Rabs_minus_sym ; apply fnx_CV_fx. + unfold N ; omega. + replace (fn' N c - g x) with ((fn' N c - g c) + (g c - g x)) by field. + apply Rle_lt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 + + Rabs h * Rabs (fn' N c - g c) + Rabs h * Rabs (g c - g x)). + rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite Rplus_assoc ; + apply Rplus_le_compat_l ; apply Rplus_le_compat_l ; + rewrite <- Rmult_plus_distr_l ; apply Rmult_le_compat_l. + solve[apply Rabs_pos]. + solve[apply Rabs_triang]. + apply Rlt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 + + Rabs h * (eps / 8) + Rabs h * Rabs (g c - g x)). + apply Rplus_lt_compat_r; apply Rplus_lt_compat_l; apply Rmult_lt_compat_l. + apply Rabs_pos_lt ; assumption. + rewrite Rabs_minus_sym ; apply fn'c_CVU_gc. + unfold N ; omega. + assert (t : Boule x delta c). + destruct P. + apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta. + apply Rabs_def2 in xinb; apply Rabs_def1; fourier. + apply Pdelta in t; tauto. + apply Rlt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 + Rabs h * (eps / 8) + + Rabs h * (eps / 8)). + rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite Rplus_assoc ; + apply Rplus_lt_compat_l ; apply Rplus_lt_compat_l ; rewrite <- Rmult_plus_distr_l ; + rewrite <- Rmult_plus_distr_l ; apply Rmult_lt_compat_l. + apply Rabs_pos_lt ; assumption. + apply Rplus_lt_compat_l ; simpl in g_cont ; apply g_cont ; split ; [unfold D_x ; split |]. + solve[unfold no_cond ; intuition]. + apply Rgt_not_eq ; exact (proj2 P). + apply Rlt_trans with (Rabs h). + apply Rabs_def1. + apply Rlt_trans with 0. + destruct P; fourier. + apply Rabs_pos_lt ; assumption. + rewrite <- Rabs_Ropp, Rabs_pos_eq, Ropp_involutive;[ | fourier]. + destruct P; fourier. + clear -Pdelta xhinbxdelta. + apply Pdelta in xhinbxdelta; destruct xhinbxdelta as [_ P']. + apply Rabs_def2 in P'; simpl in P'; destruct P'; + apply Rabs_def1; fourier. + rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite <- Rmult_plus_distr_l. + replace (Rabs h * eps / 4 + (Rabs h * eps / 4 + Rabs h * (eps / 8 + eps / 8))) with + (Rabs h * (eps / 4 + eps / 4 + eps / 8 + eps / 8)) by field. + apply Rmult_lt_compat_l. + apply Rabs_pos_lt ; assumption. + fourier. + assert (H := pr1 c P) ; elim H ; clear H ; intros l Hl. + assert (Temp : l = fn' N c). + assert (bc'rc : Boule c' r c). + assert (t : Boule x delta c). + clear - xhinbxdelta P. + destruct P; apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta. + apply Rabs_def1; fourier. + apply Pdelta in t; tauto. + assert (Hl' := Dfn_eq_fn' c N bc'rc). + unfold derivable_pt_abs in Hl; clear -Hl Hl'. + apply uniqueness_limite with (f:= fn N) (x:=c) ; assumption. + rewrite <- Temp. + assert (Hl' : derivable_pt (fn N) c). + exists l ; apply Hl. + rewrite pr_nu_var with (g:= fn N) (pr2:=Hl'). + elim Hl' ; clear Hl' ; intros l' Hl'. + assert (Main : l = l'). + apply uniqueness_limite with (f:= fn N) (x:=c) ; assumption. + rewrite Main ; reflexivity. + reflexivity. + assert (h_pos : h > 0). + case sgn_h ; intro Hyp. + assumption. + apply False_ind ; apply hpos ; symmetry ; assumption. + clear sgn_h. + assert (pr1 : forall c : R, x < c < x + h -> derivable_pt (fn N) c). + intros c c_encad ; unfold derivable_pt. + exists (fn' N c) ; apply Dfn_eq_fn'. + assert (t : Boule x delta c). + apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta; destruct c_encad. + apply Rabs_def2 in xinb; apply Rabs_def1; fourier. + apply Pdelta in t; tauto. + assert (pr2 : forall c : R, x < c < x + h -> derivable_pt id c). + solve[intros; apply derivable_id]. + assert (xh_x : x < x + h) by fourier. + assert (pr3 : forall c : R, x <= c <= x + h -> continuity_pt (fn N) c). + intros c c_encad ; apply derivable_continuous_pt. + exists (fn' N c) ; apply Dfn_eq_fn' ; intuition. + assert (t : Boule x delta c). + apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta. + apply Rabs_def2 in xinb; apply Rabs_def1; fourier. + apply Pdelta in t; tauto. + assert (pr4 : forall c : R, x <= c <= x + h -> continuity_pt id c). + solve[intros; apply derivable_continuous ; apply derivable_id]. + destruct (MVT (fn N) id x (x+h) pr1 pr2 xh_x pr3 pr4) as [c [P Hc]]. + assert (Hc' : h * derive_pt (fn N) c (pr1 c P) = fn N (x+h) - fn N x). + pattern h at 1; replace h with (id (x + h) - id x) by (unfold id; field). + rewrite <- Rmult_1_r ; replace 1 with (derive_pt id c (pr2 c P)) by reg. + assumption. + rewrite <- Hc'; clear Hc Hc'. + replace (derive_pt (fn N) c (pr1 c P)) with (fn' N c). + replace (h * fn' N c - h * g x) with (h * (fn' N c - g x)) by field. + rewrite Rabs_mult. + apply Rlt_trans with (Rabs h * eps / 4 + Rabs (f x - fn N x) + Rabs h * Rabs (fn' N c - g x)). + apply Rplus_lt_compat_r ; apply Rplus_lt_compat_r ; unfold R_dist in fnxh_CV_fxh ; + rewrite Rabs_minus_sym ; apply fnxh_CV_fxh. + unfold N; omega. + apply Rlt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 + Rabs h * Rabs (fn' N c - g x)). + apply Rplus_lt_compat_r ; apply Rplus_lt_compat_l. + unfold R_dist in fnx_CV_fx ; rewrite Rabs_minus_sym ; apply fnx_CV_fx. + unfold N ; omega. + replace (fn' N c - g x) with ((fn' N c - g c) + (g c - g x)) by field. + apply Rle_lt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 + + Rabs h * Rabs (fn' N c - g c) + Rabs h * Rabs (g c - g x)). + rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite Rplus_assoc ; + apply Rplus_le_compat_l ; apply Rplus_le_compat_l ; + rewrite <- Rmult_plus_distr_l ; apply Rmult_le_compat_l. + solve[apply Rabs_pos]. + solve[apply Rabs_triang]. + apply Rlt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 + + Rabs h * (eps / 8) + Rabs h * Rabs (g c - g x)). + apply Rplus_lt_compat_r; apply Rplus_lt_compat_l; apply Rmult_lt_compat_l. + apply Rabs_pos_lt ; assumption. + rewrite Rabs_minus_sym ; apply fn'c_CVU_gc. + unfold N ; omega. + assert (t : Boule x delta c). + destruct P. + apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta. + apply Rabs_def2 in xinb; apply Rabs_def1; fourier. + apply Pdelta in t; tauto. + apply Rlt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 + Rabs h * (eps / 8) + + Rabs h * (eps / 8)). + rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite Rplus_assoc ; + apply Rplus_lt_compat_l ; apply Rplus_lt_compat_l ; rewrite <- Rmult_plus_distr_l ; + rewrite <- Rmult_plus_distr_l ; apply Rmult_lt_compat_l. + apply Rabs_pos_lt ; assumption. + apply Rplus_lt_compat_l ; simpl in g_cont ; apply g_cont ; split ; [unfold D_x ; split |]. + solve[unfold no_cond ; intuition]. + apply Rlt_not_eq ; exact (proj1 P). + apply Rlt_trans with (Rabs h). + apply Rabs_def1. + destruct P; rewrite Rabs_pos_eq;fourier. + apply Rle_lt_trans with 0. + assert (t := Rabs_pos h); clear -t; fourier. + clear -P; destruct P; fourier. + clear -Pdelta xhinbxdelta. + apply Pdelta in xhinbxdelta; destruct xhinbxdelta as [_ P']. + apply Rabs_def2 in P'; simpl in P'; destruct P'; + apply Rabs_def1; fourier. + rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite <- Rmult_plus_distr_l. + replace (Rabs h * eps / 4 + (Rabs h * eps / 4 + Rabs h * (eps / 8 + eps / 8))) with + (Rabs h * (eps / 4 + eps / 4 + eps / 8 + eps / 8)) by field. + apply Rmult_lt_compat_l. + apply Rabs_pos_lt ; assumption. + fourier. + assert (H := pr1 c P) ; elim H ; clear H ; intros l Hl. + assert (Temp : l = fn' N c). + assert (bc'rc : Boule c' r c). + assert (t : Boule x delta c). + clear - xhinbxdelta P. + destruct P; apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta. + apply Rabs_def1; fourier. + apply Pdelta in t; tauto. + assert (Hl' := Dfn_eq_fn' c N bc'rc). + unfold derivable_pt_abs in Hl; clear -Hl Hl'. + apply uniqueness_limite with (f:= fn N) (x:=c) ; assumption. + rewrite <- Temp. + assert (Hl' : derivable_pt (fn N) c). + exists l ; apply Hl. + rewrite pr_nu_var with (g:= fn N) (pr2:=Hl'). + elim Hl' ; clear Hl' ; intros l' Hl'. + assert (Main : l = l'). + apply uniqueness_limite with (f:= fn N) (x:=c) ; assumption. + rewrite Main ; reflexivity. + reflexivity. + replace ((f (x + h) - f x) / h - g x) with ((/h) * ((f (x + h) - f x) - h * g x)). + rewrite Rabs_mult ; rewrite Rabs_Rinv. + replace eps with (/ Rabs h * (Rabs h * eps)). + apply Rmult_lt_compat_l. + apply Rinv_0_lt_compat ; apply Rabs_pos_lt ; assumption. + replace (f (x + h) - f x - h * g x) with (f (x + h) - fn N (x + h) - (f x - fn N x) + + (fn N (x + h) - fn N x - h * g x)) by field. + assumption. + field ; apply Rgt_not_eq ; apply Rabs_pos_lt ; assumption. + assumption. + field. assumption. +Qed.
\ No newline at end of file diff --git a/theories/Reals/Ranalysis_reg.v b/theories/Reals/Ranalysis_reg.v new file mode 100644 index 00000000..a4b18288 --- /dev/null +++ b/theories/Reals/Ranalysis_reg.v @@ -0,0 +1,800 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +Require Import Rbase. +Require Import Rfunctions. +Require Import Rtrigo1. +Require Import SeqSeries. +Require Export Ranalysis1. +Require Export Ranalysis2. +Require Export Ranalysis3. +Require Export Rtopology. +Require Export MVT. +Require Export PSeries_reg. +Require Export Exp_prop. +Require Export Rtrigo_reg. +Require Export Rsqrt_def. +Require Export R_sqrt. +Require Export Rtrigo_calc. +Require Export Rgeom. +Require Export RList. +Require Export Sqrt_reg. +Require Export Ranalysis4. +Require Export Rpower. +Local Open Scope R_scope. + +Axiom AppVar : R. + +(**********) +Ltac intro_hyp_glob trm := + match constr:trm with + | (?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 + end + | (?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 + end + | (?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 + end + | (?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 + | |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2 + | |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2 + | _ => idtac + end + | (- ?X1)%F => + match goal with + | |- (derivable _) => intro_hyp_glob X1 + | |- (continuity _) => intro_hyp_glob X1 + | _ => idtac + end + | (/ ?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 => + 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 + end. + +(**********) +Ltac intro_hyp_pt trm pt := + match constr:trm with + | (?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 _ _ _ = _) => + intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | _ => idtac + end + | (?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 _ _ _ = _) => + intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | _ => idtac + end + | (?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 _ _ _ = _) => + intro_hyp_pt X1 pt; intro_hyp_pt X2 pt + | _ => idtac + end + | (?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 + | |- (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 _ _) => + let pt_f1 := eval cbv beta in (X2 pt) in + (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 + end + | (- ?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 + end + | (/ ?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 + | |- (derivable_pt _ _) => cut (0 < pt); [ intro | try assumption ] + | |- (continuity_pt _ _) => + cut (0 <= pt); [ intro | try assumption ] + | |- (derive_pt _ _ _ = _) => + cut (0 < pt); [ intro | try assumption ] + | _ => idtac + end + | Rabs => + match goal with + | |- (derivable_pt _ _) => + cut (pt <> 0); [ intro | try assumption ] + | _ => idtac + end + | ?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 + end. + +(**********) +Ltac is_diff_pt := + match goal with + | |- (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 _) _) => + unfold pow_fct in |- *; apply derivable_pt_pow + | |- (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) => + 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 |- * + (* regles de differentiabilite *) + (* PLUS *) + | |- (derivable_pt (?X1 + ?X2) ?X3) => + apply (derivable_pt_plus X1 X2 X3); is_diff_pt + (* MOINS *) + | |- (derivable_pt (?X1 - ?X2) ?X3) => + apply (derivable_pt_minus X1 X2 X3); is_diff_pt + (* OPPOSE *) + | |- (derivable_pt (- ?X1) ?X2) => + apply (derivable_pt_opp X1 X2); + is_diff_pt + (* MULTIPLICATION PAR UN SCALAIRE *) + | |- (derivable_pt (mult_real_fct ?X1 ?X2) ?X3) => + apply (derivable_pt_scal X2 X1 X3); is_diff_pt + (* MULTIPLICATION *) + | |- (derivable_pt (?X1 * ?X2) ?X3) => + apply (derivable_pt_mult X1 X2 X3); is_diff_pt + (* DIVISION *) + | |- (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) => + + (* INVERSION *) + 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) => + + (* COMPOSITION *) + 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) => + cut (derivable X1); [ intro HypDDPT; apply HypDDPT | assumption ] + | |- (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 |- * + end. + +(**********) +Ltac is_diff_glob := + match goal with + | |- (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 _)) => + unfold pow_fct in |- *; + apply derivable_pow + (* regles de differentiabilite *) + (* PLUS *) + | |- (derivable (?X1 + ?X2)) => + apply (derivable_plus X1 X2); is_diff_glob + (* MOINS *) + | |- (derivable (?X1 - ?X2)) => + apply (derivable_minus X1 X2); is_diff_glob + (* OPPOSE *) + | |- (derivable (- ?X1)) => + apply (derivable_opp X1); + is_diff_glob + (* MULTIPLICATION PAR UN SCALAIRE *) + | |- (derivable (mult_real_fct ?X1 ?X2)) => + apply (derivable_scal X2 X1); is_diff_glob + (* MULTIPLICATION *) + | |- (derivable (?X1 * ?X2)) => + apply (derivable_mult X1 X2); is_diff_glob + (* DIVISION *) + | |- (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)) => + + (* INVERSION *) + 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 _)) => + + (* COMPOSITION *) + unfold derivable in |- *; intro; try is_diff_pt + | |- (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 _) => + 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 |- * + end. + +(**********) +Ltac is_cont_pt := + match goal with + | |- (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_id X1) + | |- (continuity_pt (fct_cte _) _) => + apply derivable_continuous_pt; apply derivable_pt_const + | |- (continuity_pt sin _) => + apply derivable_continuous_pt; apply derivable_pt_sin + | |- (continuity_pt cos _) => + apply derivable_continuous_pt; apply derivable_pt_cos + | |- (continuity_pt sinh _) => + apply derivable_continuous_pt; apply derivable_pt_sinh + | |- (continuity_pt cosh _) => + apply derivable_continuous_pt; apply derivable_pt_cosh + | |- (continuity_pt exp _) => + apply derivable_continuous_pt; apply derivable_pt_exp + | |- (continuity_pt (pow_fct _) _) => + unfold pow_fct in |- *; apply derivable_continuous_pt; + 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) => + apply (Rcontinuity_abs X1) + (* regles de differentiabilite *) + (* PLUS *) + | |- (continuity_pt (?X1 + ?X2) ?X3) => + apply (continuity_pt_plus X1 X2 X3); is_cont_pt + (* MOINS *) + | |- (continuity_pt (?X1 - ?X2) ?X3) => + apply (continuity_pt_minus X1 X2 X3); is_cont_pt + (* OPPOSE *) + | |- (continuity_pt (- ?X1) ?X2) => + apply (continuity_pt_opp X1 X2); + is_cont_pt + (* MULTIPLICATION PAR UN SCALAIRE *) + | |- (continuity_pt (mult_real_fct ?X1 ?X2) ?X3) => + apply (continuity_pt_scal X2 X1 X3); is_cont_pt + (* MULTIPLICATION *) + | |- (continuity_pt (?X1 * ?X2) ?X3) => + apply (continuity_pt_mult X1 X2 X3); is_cont_pt + (* DIVISION *) + | |- (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) => + + (* 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) => + + (* COMPOSITION *) + 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) => + cut (continuity X1); [ intro HypDDPT; apply HypDDPT | assumption ] + | _:(derivable_pt ?X1 ?X2) |- (continuity_pt ?X1 ?X2) => + apply derivable_continuous_pt; assumption + | _:(derivable ?X1) |- (continuity_pt ?X1 ?X2) => + cut (continuity X1); + [ 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 |- * + end. + +(**********) +Ltac is_cont_glob := + match goal with + | |- (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_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 _)) => + unfold pow_fct in |- *; apply derivable_continuous; apply derivable_pow + | |- (continuity sinh) => + apply derivable_continuous; apply derivable_sinh + | |- (continuity cosh) => + apply derivable_continuous; apply derivable_cosh + | |- (continuity Rabs) => + apply Rcontinuity_abs + (* regles de continuite *) + (* PLUS *) + | |- (continuity (?X1 + ?X2)) => + apply (continuity_plus X1 X2); + try is_cont_glob || assumption + (* MOINS *) + | |- (continuity (?X1 - ?X2)) => + apply (continuity_minus X1 X2); + try is_cont_glob || assumption + (* OPPOSE *) + | |- (continuity (- ?X1)) => + apply (continuity_opp X1); try is_cont_glob || assumption + (* INVERSE *) + | |- (continuity (/ ?X1)) => + apply (continuity_inv X1); + try is_cont_glob || assumption + (* MULTIPLICATION PAR UN SCALAIRE *) + | |- (continuity (mult_real_fct ?X1 ?X2)) => + apply (continuity_scal X2 X1); + try is_cont_glob || assumption + (* MULTIPLICATION *) + | |- (continuity (?X1 * ?X2)) => + apply (continuity_mult X1 X2); + try is_cont_glob || assumption + (* DIVISION *) + | |- (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 _)) => + + (* COMPOSITION *) + 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 _) => + intro HypTruE; clear HypTruE; is_cont_glob + | _:(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 |- * + end. + +(**********) +Ltac rew_term trm := + match constr:trm with + | (?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 + | _ => constr:(p1 + p2)%F + 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 + | _ => constr:(p1 - p2)%F + 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) => + 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) => + 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 + | _ => constr:(p1 * p2)%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) => + 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) => + 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) => + 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) + end. + +(**********) +Ltac deriv_proof trm pt := + match constr:trm with + | (?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 => + 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 => + 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 => + match goal with + | 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 + end + | (/ ?X1)%F => + match goal with + | id:(?X1 pt <> 0) |- _ => + let p1 := deriv_proof X1 pt in + constr:(derivable_pt_inv X1 pt p1 id) + | _ => constr:False + end + | (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 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 => + match goal with + | id:(0 < pt) |- _ => constr:(derivable_pt_sqrt pt id) + | _ => constr:False + end + | (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 + end. + +(**********) +Ltac simplify_derive trm pt := + match constr:trm with + | (?X1 + ?X2)%F => + try rewrite derive_pt_plus; simplify_derive X1 pt; + simplify_derive X2 pt + | (?X1 - ?X2)%F => + try rewrite derive_pt_minus; simplify_derive X1 pt; + simplify_derive X2 pt + | (?X1 * ?X2)%F => + try rewrite derive_pt_mult; simplify_derive X1 pt; + simplify_derive X2 pt + | (?X1 / ?X2)%F => + try rewrite derive_pt_div; simplify_derive X1 pt; simplify_derive X2 pt + | (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_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 => + 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 + end. + +(**********) +Ltac reg := + match goal with + | |- (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 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 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 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 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 |- *; ring || ring_simplify + | try apply pr_nu ]) || is_diff_pt) + end. diff --git a/theories/Reals/Ratan.v b/theories/Reals/Ratan.v new file mode 100644 index 00000000..1a0ea969 --- /dev/null +++ b/theories/Reals/Ratan.v @@ -0,0 +1,1602 @@ +Require Import Fourier. +Require Import Rbase. +Require Import PSeries_reg. +Require Import Rtrigo1. +Require Import Ranalysis_reg. +Require Import Rfunctions. +Require Import AltSeries. +Require Import Rseries. +Require Import SeqProp. +Require Import Ranalysis5. +Require Import SeqSeries. +Require Import PartSum. + +Local Open Scope R_scope. + +(** Tools *) + +Lemma Ropp_div : forall x y, -x/y = -(x/y). +Proof. +intros x y; unfold Rdiv; rewrite <-Ropp_mult_distr_l_reverse; reflexivity. +Qed. + +Definition pos_half_prf : 0 < /2. +Proof. fourier. Qed. + +Definition pos_half := mkposreal (/2) pos_half_prf. + +Lemma Boule_half_to_interval : + forall x , Boule (/2) pos_half x -> 0 <= x <= 1. +Proof. +unfold Boule, pos_half; simpl. +intros x b; apply Rabs_def2 in b; destruct b; split; fourier. +Qed. + +Lemma Boule_lt : forall c r x, Boule c r x -> Rabs x < Rabs c + r. +Proof. +unfold Boule; intros c r x h. +apply Rabs_def2 in h; destruct h; apply Rabs_def1; + (destruct (Rle_lt_dec 0 c);[rewrite Rabs_pos_eq; fourier | + rewrite <- Rabs_Ropp, Rabs_pos_eq; fourier]). +Qed. + +(* The following lemma does not belong here. *) +Lemma Un_cv_ext : + forall un vn, (forall n, un n = vn n) -> + forall l, Un_cv un l -> Un_cv vn l. +Proof. +intros un vn quv l P eps ep; destruct (P eps ep) as [N Pn]; exists N. +intro n; rewrite <- quv; apply Pn. +Qed. + +(* The following two lemmas are general purposes about alternated series. + They do not belong here. *) +Lemma Alt_first_term_bound :forall f l N n, + Un_decreasing f -> Un_cv f 0 -> + Un_cv (sum_f_R0 (tg_alt f)) l -> + (N <= n)%nat -> + R_dist (sum_f_R0 (tg_alt f) n) l <= f N. +Proof. +intros f l. +assert (WLOG : + forall n P, (forall k, (0 < k)%nat -> P k) -> + ((forall k, (0 < k)%nat -> P k) -> P 0%nat) -> P n). +clear. +intros [ | n] P Hs Ho;[solve[apply Ho, Hs] | apply Hs; auto with arith]. +intros N; pattern N; apply WLOG; clear N. +intros [ | N] Npos n decr to0 cv nN. + clear -Npos; elimtype False; omega. + assert (decr' : Un_decreasing (fun i => f (S N + i)%nat)). + intros k; replace (S N+S k)%nat with (S (S N+k)) by ring. + apply (decr (S N + k)%nat). + assert (to' : Un_cv (fun i => f (S N + i)%nat) 0). + intros eps ep; destruct (to0 eps ep) as [M PM]. + exists M; intros k kM; apply PM; omega. + assert (cv' : Un_cv + (sum_f_R0 (tg_alt (fun i => ((-1) ^ S N * f(S N + i)%nat)))) + (l - sum_f_R0 (tg_alt f) N)). + intros eps ep; destruct (cv eps ep) as [M PM]; exists M. + intros n' nM. + match goal with |- ?C => set (U := C) end. + assert (nM' : (n' + S N >= M)%nat) by omega. + generalize (PM _ nM'); unfold R_dist. + rewrite (tech2 (tg_alt f) N (n' + S N)). + assert (t : forall a b c, (a + b) - c = b - (c - a)) by (intros; ring). + rewrite t; clear t; unfold U, R_dist; clear U. + replace (n' + S N - S N)%nat with n' by omega. + rewrite <- (sum_eq (tg_alt (fun i => (-1) ^ S N * f(S N + i)%nat))). + tauto. + intros i _; unfold tg_alt. + rewrite <- Rmult_assoc, <- pow_add, !(plus_comm i); reflexivity. + omega. + assert (cv'' : Un_cv (sum_f_R0 (tg_alt (fun i => f (S N + i)%nat))) + ((-1) ^ S N * (l - sum_f_R0 (tg_alt f) N))). + apply (Un_cv_ext (fun n => (-1) ^ S N * + sum_f_R0 (tg_alt (fun i : nat => (-1) ^ S N * f (S N + i)%nat)) n)). + intros n0; rewrite scal_sum; apply sum_eq; intros i _. + unfold tg_alt; ring_simplify; replace (((-1) ^ S N) ^ 2) with 1. + ring. + rewrite <- pow_mult, mult_comm, pow_mult; replace ((-1) ^2) with 1 by ring. + rewrite pow1; reflexivity. + apply CV_mult. + solve[intros eps ep; exists 0%nat; intros; rewrite R_dist_eq; auto]. + assumption. + destruct (even_odd_cor N) as [p [Neven | Nodd]]. + rewrite Neven; destruct (alternated_series_ineq _ _ p decr to0 cv) as [B C]. + case (even_odd_cor n) as [p' [neven | nodd]]. + rewrite neven. + destruct (alternated_series_ineq _ _ p' decr to0 cv) as [D E]. + unfold R_dist; rewrite Rabs_pos_eq;[ | fourier]. + assert (dist : (p <= p')%nat) by omega. + assert (t := decreasing_prop _ _ _ (CV_ALT_step1 f decr) dist). + apply Rle_trans with (sum_f_R0 (tg_alt f) (2 * p) - l). + unfold Rminus; apply Rplus_le_compat_r; exact t. + match goal with _ : ?a <= l, _ : l <= ?b |- _ => + replace (f (S (2 * p))) with (b - a) by + (rewrite tech5; unfold tg_alt; rewrite pow_1_odd; ring); fourier + end. + rewrite nodd; destruct (alternated_series_ineq _ _ p' decr to0 cv) as [D E]. + unfold R_dist; rewrite <- Rabs_Ropp, Rabs_pos_eq, Ropp_minus_distr; + [ | fourier]. + assert (dist : (p <= p')%nat) by omega. + apply Rle_trans with (l - sum_f_R0 (tg_alt f) (S (2 * p))). + unfold Rminus; apply Rplus_le_compat_l, Ropp_le_contravar. + solve[apply Rge_le, (growing_prop _ _ _ (CV_ALT_step0 f decr) dist)]. + unfold Rminus; rewrite tech5, Ropp_plus_distr, <- Rplus_assoc. + unfold tg_alt at 2; rewrite pow_1_odd, Ropp_mult_distr_l_reverse; fourier. + rewrite Nodd; destruct (alternated_series_ineq _ _ p decr to0 cv) as [B _]. + destruct (alternated_series_ineq _ _ (S p) decr to0 cv) as [_ C]. + assert (keep : (2 * S p = S (S ( 2 * p)))%nat) by ring. + case (even_odd_cor n) as [p' [neven | nodd]]. + rewrite neven; + destruct (alternated_series_ineq _ _ p' decr to0 cv) as [D E]. + unfold R_dist; rewrite Rabs_pos_eq;[ | fourier]. + assert (dist : (S p < S p')%nat) by omega. + apply Rle_trans with (sum_f_R0 (tg_alt f) (2 * S p) - l). + unfold Rminus; apply Rplus_le_compat_r, + (decreasing_prop _ _ _ (CV_ALT_step1 f decr)). + omega. + rewrite keep, tech5; unfold tg_alt at 2; rewrite <- keep, pow_1_even. + fourier. + rewrite nodd; destruct (alternated_series_ineq _ _ p' decr to0 cv) as [D E]. + unfold R_dist; rewrite <- Rabs_Ropp, Rabs_pos_eq;[ | fourier]. + rewrite Ropp_minus_distr. + apply Rle_trans with (l - sum_f_R0 (tg_alt f) (S (2 * p))). + unfold Rminus; apply Rplus_le_compat_l, Ropp_le_contravar, Rge_le, + (growing_prop _ _ _ (CV_ALT_step0 f decr)); omega. + generalize C; rewrite keep, tech5; unfold tg_alt. + rewrite <- keep, pow_1_even. + assert (t : forall a b c, a <= b + 1 * c -> a - b <= c) by (intros; fourier). + solve[apply t]. +clear WLOG; intros Hyp [ | n] decr to0 cv _. + generalize (alternated_series_ineq f l 0 decr to0 cv). + unfold R_dist, tg_alt; simpl; rewrite !Rmult_1_l, !Rmult_1_r. + assert (f 1%nat <= f 0%nat) by apply decr. + rewrite Ropp_mult_distr_l_reverse. + intros [A B]; rewrite Rabs_pos_eq; fourier. +apply Rle_trans with (f 1%nat). + apply (Hyp 1%nat (le_n 1) (S n) decr to0 cv). + omega. +solve[apply decr]. +Qed. + +Lemma Alt_CVU : forall (f : nat -> R -> R) g h c r, + (forall x, Boule c r x ->Un_decreasing (fun n => f n x)) -> + (forall x, Boule c r x -> Un_cv (fun n => f n x) 0) -> + (forall x, Boule c r x -> + Un_cv (sum_f_R0 (tg_alt (fun i => f i x))) (g x)) -> + (forall x n, Boule c r x -> f n x <= h n) -> + (Un_cv h 0) -> + CVU (fun N x => sum_f_R0 (tg_alt (fun i => f i x)) N) g c r. +Proof. +intros f g h c r decr to0 to_g bound bound0 eps ep. +assert (ep' : 0 <eps/2) by fourier. +destruct (bound0 _ ep) as [N Pn]; exists N. +intros n y nN dy. +rewrite <- Rabs_Ropp, Ropp_minus_distr; apply Rle_lt_trans with (f n y). + solve[apply (Alt_first_term_bound (fun i => f i y) (g y) n n); auto]. +apply Rle_lt_trans with (h n). + apply bound; assumption. +clear - nN Pn. +generalize (Pn _ nN); unfold R_dist; rewrite Rminus_0_r; intros t. +apply Rabs_def2 in t; tauto. +Qed. + +(* The following lemmas are general purpose lemmas about squares. + They do not belong here *) + +Lemma pow2_ge_0 : forall x, 0 <= x ^ 2. +Proof. +intros x; destruct (Rle_lt_dec 0 x). + replace (x ^ 2) with (x * x) by field. + apply Rmult_le_pos; assumption. + replace (x ^ 2) with ((-x) * (-x)) by field. +apply Rmult_le_pos; fourier. +Qed. + +Lemma pow2_abs : forall x, Rabs x ^ 2 = x ^ 2. +Proof. +intros x; destruct (Rle_lt_dec 0 x). + rewrite Rabs_pos_eq;[field | assumption]. +rewrite <- Rabs_Ropp, Rabs_pos_eq;[field | fourier]. +Qed. + +(** * Properties of tangent *) + +Lemma derivable_pt_tan : forall x, -PI/2 < x < PI/2 -> derivable_pt tan x. +Proof. +intros x xint. + unfold derivable_pt, tan. + apply derivable_pt_div ; [reg | reg | ]. + apply Rgt_not_eq. + unfold Rgt ; apply cos_gt_0; + [unfold Rdiv; rewrite <- Ropp_mult_distr_l_reverse; fold (-PI/2) |];tauto. +Qed. + +Lemma derive_pt_tan : forall (x:R), + forall (Pr1: -PI/2 < x < PI/2), + derive_pt tan x (derivable_pt_tan x Pr1) = 1 + (tan x)^2. +Proof. +intros x pr. +assert (cos x <> 0). + apply Rgt_not_eq, cos_gt_0; rewrite <- ?Ropp_div; tauto. +unfold tan; reg; unfold pow, Rsqr; field; assumption. +Qed. + +(** Proof that tangent is a bijection *) +(* to be removed? *) + +Lemma derive_increasing_interv : + forall (a b:R) (f:R -> R), + a < b -> + forall (pr:forall x, a < x < b -> derivable_pt f x), + (forall t:R, forall (t_encad : a < t < b), 0 < derive_pt f t (pr t t_encad)) -> + forall x y:R, a < x < b -> a < y < b -> x < y -> f x < f y. +Proof. +intros a b f a_lt_b pr Df_gt_0 x y x_encad y_encad x_lt_y. + assert (derivable_id_interv : forall c : R, x < c < y -> derivable_pt id c). + intros ; apply derivable_pt_id. + assert (derivable_f_interv : forall c : R, x < c < y -> derivable_pt f c). + intros c c_encad. apply pr. split. + apply Rlt_trans with (r2:=x) ; [exact (proj1 x_encad) | exact (proj1 c_encad)]. + apply Rlt_trans with (r2:=y) ; [exact (proj2 c_encad) | exact (proj2 y_encad)]. + assert (f_cont_interv : forall c : R, x <= c <= y -> continuity_pt f c). + intros c c_encad; apply derivable_continuous_pt ; apply pr. split. + apply Rlt_le_trans with (r2:=x) ; [exact (proj1 x_encad) | exact (proj1 c_encad)]. + apply Rle_lt_trans with (r2:=y) ; [ exact (proj2 c_encad) | exact (proj2 y_encad)]. + assert (id_cont_interv : forall c : R, x <= c <= y -> continuity_pt id c). + intros ; apply derivable_continuous_pt ; apply derivable_pt_id. + elim (MVT f id x y derivable_f_interv derivable_id_interv x_lt_y f_cont_interv id_cont_interv). + intros c Temp ; elim Temp ; clear Temp ; intros Pr eq. + replace (id y - id x) with (y - x) in eq by intuition. + replace (derive_pt id c (derivable_id_interv c Pr)) with 1 in eq. + assert (Hyp : f y - f x > 0). + rewrite Rmult_1_r in eq. rewrite <- eq. + apply Rmult_gt_0_compat. + apply Rgt_minus ; assumption. + assert (c_encad2 : a <= c < b). + split. + apply Rlt_le ; apply Rlt_trans with (r2:=x) ; [exact (proj1 x_encad) | exact (proj1 Pr)]. + apply Rle_lt_trans with (r2:=y) ; [apply Rlt_le ; exact (proj2 Pr) | exact (proj2 y_encad)]. + assert (c_encad : a < c < b). + split. + apply Rlt_trans with (r2:=x) ; [exact (proj1 x_encad) | exact (proj1 Pr)]. + apply Rle_lt_trans with (r2:=y) ; [apply Rlt_le ; exact (proj2 Pr) | exact (proj2 y_encad)]. + assert (Temp := Df_gt_0 c c_encad). + assert (Temp2 := pr_nu f c (derivable_f_interv c Pr) (pr c c_encad)). + rewrite Temp2 ; apply Temp. + apply Rminus_gt ; exact Hyp. + symmetry ; rewrite derive_pt_eq ; apply derivable_pt_lim_id. +Qed. + +(* begin hide *) +Lemma plus_Rsqr_gt_0 : forall x, 1 + x ^ 2 > 0. +Proof. +intro m. replace 0 with (0+0) by intuition. + apply Rplus_gt_ge_compat. intuition. + elim (total_order_T m 0) ; intro s'. case s'. + intros m_cond. replace 0 with (0*0) by intuition. + replace (m ^ 2) with ((-m)^2). + apply Rle_ge ; apply Rmult_le_compat ; intuition ; apply Rlt_le ; rewrite Rmult_1_r ; intuition. + field. + intro H' ; rewrite H' ; right ; field. + left. intuition. +Qed. +(* end hide *) + +(* The following lemmas about PI should probably be in Rtrigo. *) + +Lemma PI2_lower_bound : + forall x, 0 < x < 2 -> 0 < cos x -> x < PI/2. +Proof. +intros x [xp xlt2] cx. +destruct (Rtotal_order x (PI/2)) as [xltpi2 | [xeqpi2 | xgtpi2]]. + assumption. + now case (Rgt_not_eq _ _ cx); rewrite xeqpi2, cos_PI2. +destruct (MVT_cor1 cos (PI/2) x derivable_cos xgtpi2) as + [c [Pc [cint1 cint2]]]. +revert Pc; rewrite cos_PI2, Rminus_0_r. +rewrite <- (pr_nu cos c (derivable_pt_cos c)), derive_pt_cos. +assert (0 < c < 2) by (split; assert (t := PI2_RGT_0); fourier). +assert (0 < sin c) by now apply sin_pos_tech. +intros Pc. +case (Rlt_not_le _ _ cx). +rewrite <- (Rplus_0_l (cos x)), Pc, Ropp_mult_distr_l_reverse. +apply Rle_minus, Rmult_le_pos;[apply Rlt_le; assumption | fourier ]. +Qed. + +Lemma PI2_3_2 : 3/2 < PI/2. +Proof. +apply PI2_lower_bound;[split; fourier | ]. +destruct (pre_cos_bound (3/2) 1) as [t _]; [fourier | fourier | ]. +apply Rlt_le_trans with (2 := t); clear t. +unfold cos_approx; simpl; unfold cos_term. +simpl mult; replace ((-1)^ 0) with 1 by ring; replace ((-1)^2) with 1 by ring; + replace ((-1)^4) with 1 by ring; replace ((-1)^1) with (-1) by ring; + replace ((-1)^3) with (-1) by ring; replace 3 with (IZR 3) by (simpl; ring); + replace 2 with (IZR 2) by (simpl; ring); simpl Z.of_nat; + rewrite !INR_IZR_INZ, Ropp_mult_distr_l_reverse, Rmult_1_l. +match goal with |- _ < ?a => +replace a with ((- IZR 3 ^ 6 * IZR (Z.of_nat (fact 0)) * IZR (Z.of_nat (fact 2)) * + IZR (Z.of_nat (fact 4)) + + IZR 3 ^ 4 * IZR 2 ^ 2 * IZR (Z.of_nat (fact 0)) * IZR (Z.of_nat (fact 2)) * + IZR (Z.of_nat (fact 6)) - + IZR 3 ^ 2 * IZR 2 ^ 4 * IZR (Z.of_nat (fact 0)) * IZR (Z.of_nat (fact 4)) * + IZR (Z.of_nat (fact 6)) + + IZR 2 ^ 6 * IZR (Z.of_nat (fact 2)) * IZR (Z.of_nat (fact 4)) * + IZR (Z.of_nat (fact 6))) / + (IZR 2 ^ 6 * IZR (Z.of_nat (fact 0)) * IZR (Z.of_nat (fact 2)) * + IZR (Z.of_nat (fact 4)) * IZR (Z.of_nat (fact 6))));[ | field; + repeat apply conj;((rewrite <- INR_IZR_INZ; apply INR_fact_neq_0) || + (apply Rgt_not_eq; apply (IZR_lt 0); reflexivity)) ] +end. +rewrite !fact_simpl, !Nat2Z.inj_mul; simpl Z.of_nat. +unfold Rdiv; apply Rmult_lt_0_compat. +unfold Rminus; rewrite !pow_IZR, <- !opp_IZR, <- !mult_IZR, <- !opp_IZR, + <- !plus_IZR; apply (IZR_lt 0); reflexivity. +apply Rinv_0_lt_compat; rewrite !pow_IZR, <- !mult_IZR; apply (IZR_lt 0). +reflexivity. +Qed. + +Lemma PI2_1 : 1 < PI/2. +Proof. assert (t := PI2_3_2); fourier. Qed. + +Lemma tan_increasing : + forall x y:R, + -PI/2 < x -> + x < y -> + y < PI/2 -> tan x < tan y. +Proof. +intros x y Z_le_x x_lt_y y_le_1. + assert (x_encad : -PI/2 < x < PI/2). + split ; [assumption | apply Rlt_trans with (r2:=y) ; assumption]. + assert (y_encad : -PI/2 < y < PI/2). + split ; [apply Rlt_trans with (r2:=x) ; intuition | intuition ]. + assert (local_derivable_pt_tan : forall x : R, -PI/2 < x < PI/2 -> + derivable_pt tan x). + intros ; apply derivable_pt_tan ; intuition. + apply derive_increasing_interv with (a:=-PI/2) (b:=PI/2) (pr:=local_derivable_pt_tan) ; intuition. + fourier. + assert (Temp := pr_nu tan t (derivable_pt_tan t t_encad) (local_derivable_pt_tan t t_encad)) ; + rewrite <- Temp ; clear Temp. + assert (Temp := derive_pt_tan t t_encad) ; rewrite Temp ; clear Temp. + apply plus_Rsqr_gt_0. +Qed. + +Lemma tan_is_inj : forall x y, -PI/2 < x < PI/2 -> -PI/2 < y < PI/2 -> + tan x = tan y -> x = y. +Proof. + intros a b a_encad b_encad fa_eq_fb. + case(total_order_T a b). + intro s ; case s ; clear s. + intro Hf. + assert (Hfalse := tan_increasing a b (proj1 a_encad) Hf (proj2 b_encad)). + case (Rlt_not_eq (tan a) (tan b)) ; assumption. + intuition. + intro Hf. assert (Hfalse := tan_increasing b a (proj1 b_encad) Hf (proj2 a_encad)). + case (Rlt_not_eq (tan b) (tan a)) ; [|symmetry] ; assumption. +Qed. + +Lemma exists_atan_in_frame : + forall lb ub y, lb < ub -> -PI/2 < lb -> ub < PI/2 -> + tan lb < y < tan ub -> {x | lb < x < ub /\ tan x = y}. +Proof. +intros lb ub y lb_lt_ub lb_cond ub_cond y_encad. + case y_encad ; intros y_encad1 y_encad2. + assert (f_cont : forall a : R, lb <= a <= ub -> continuity_pt tan a). + intros a a_encad. apply derivable_continuous_pt ; apply derivable_pt_tan. + split. apply Rlt_le_trans with (r2:=lb) ; intuition. + apply Rle_lt_trans with (r2:=ub) ; intuition. + assert (Cont : forall a : R, lb <= a <= ub -> continuity_pt (fun x => tan x - y) a). + intros a a_encad. unfold continuity_pt, continue_in, limit1_in, limit_in ; simpl ; unfold R_dist. + intros eps eps_pos. elim (f_cont a a_encad eps eps_pos). + intros alpha alpha_pos. destruct alpha_pos as (alpha_pos,Temp). + exists alpha. split. + assumption. intros x x_cond. + replace (tan x - y - (tan a - y)) with (tan x - tan a) by field. + exact (Temp x x_cond). + assert (H1 : (fun x : R => tan x - y) lb < 0). + apply Rlt_minus. assumption. + assert (H2 : 0 < (fun x : R => tan x - y) ub). + apply Rgt_minus. assumption. + destruct (IVT_interv (fun x => tan x - y) lb ub Cont lb_lt_ub H1 H2) as (x,Hx). + exists x. + destruct Hx as (Hyp,Result). + intuition. + assert (Temp2 : x <> lb). + intro Hfalse. rewrite Hfalse in Result. + assert (Temp2 : y <> tan lb). + apply Rgt_not_eq ; assumption. + clear - Temp2 Result. apply Temp2. + intuition. + clear -Temp2 H3. + case H3 ; intuition. apply False_ind ; apply Temp2 ; symmetry ; assumption. + assert (Temp : x <> ub). + intro Hfalse. rewrite Hfalse in Result. + assert (Temp2 : y <> tan ub). + apply Rlt_not_eq ; assumption. + clear - Temp2 Result. apply Temp2. + intuition. + case H4 ; intuition. +Qed. + +(** * Definition of arctangent as the reciprocal function of tangent and proof of this status *) +Lemma tan_1_gt_1 : tan 1 > 1. +Proof. +assert (0 < cos 1) by (apply cos_gt_0; assert (t:=PI2_1); fourier). +assert (t1 : cos 1 <= 1 - 1/2 + 1/24). + destruct (pre_cos_bound 1 0) as [_ t]; try fourier; revert t. + unfold cos_approx, cos_term; simpl; intros t; apply Rle_trans with (1:=t). + clear t; apply Req_le; field. +assert (t2 : 1 - 1/6 <= sin 1). + destruct (pre_sin_bound 1 0) as [t _]; try fourier; revert t. + unfold sin_approx, sin_term; simpl; intros t; apply Rle_trans with (2:=t). + clear t; apply Req_le; field. +pattern 1 at 2; replace 1 with + (cos 1 / cos 1) by (field; apply Rgt_not_eq; fourier). +apply Rlt_gt; apply (Rmult_lt_compat_r (/ cos 1) (cos 1) (sin 1)). + apply Rinv_0_lt_compat; assumption. +apply Rle_lt_trans with (1 := t1); apply Rlt_le_trans with (2 := t2). +fourier. +Qed. + +Definition frame_tan y : {x | 0 < x < PI/2 /\ Rabs y < tan x}. +destruct (total_order_T (Rabs y) 1). + assert (yle1 : Rabs y <= 1) by (destruct s; fourier). + clear s; exists 1; split;[split; [exact Rlt_0_1 | exact PI2_1] | ]. + apply Rle_lt_trans with (1 := yle1); exact tan_1_gt_1. +assert (0 < / (Rabs y + 1)). + apply Rinv_0_lt_compat; fourier. +set (u := /2 * / (Rabs y + 1)). +assert (0 < u). + apply Rmult_lt_0_compat; [fourier | assumption]. +assert (vlt1 : / (Rabs y + 1) < 1). + apply Rmult_lt_reg_r with (Rabs y + 1). + assert (t := Rabs_pos y); fourier. + rewrite Rinv_l; [rewrite Rmult_1_l | apply Rgt_not_eq]; fourier. +assert (vlt2 : u < 1). + apply Rlt_trans with (/ (Rabs y + 1)). + rewrite double_var. + assert (t : forall x, 0 < x -> x < x + x) by (clear; intros; fourier). + unfold u; rewrite Rmult_comm; apply t. + unfold Rdiv; rewrite Rmult_comm; assumption. + assumption. +assert(int : 0 < PI / 2 - u < PI / 2). + split. + assert (t := PI2_1); apply Rlt_Rminus, Rlt_trans with (2 := t); assumption. + assert (dumb : forall x y, 0 < y -> x - y < x) by (clear; intros; fourier). + apply dumb; clear dumb; assumption. +exists (PI/2 - u). +assert (tmp : forall x y, 0 < x -> y < 1 -> x * y < x). + clear; intros x y x0 y1; pattern x at 2; rewrite <- (Rmult_1_r x). + apply Rmult_lt_compat_l; assumption. +assert (0 < sin u). + apply sin_gt_0;[ assumption | ]. + assert (t := PI2_Rlt_PI); assert (t' := PI2_1). + apply Rlt_trans with (2 := Rlt_trans _ _ _ t' t); assumption. +split. + assumption. + apply Rlt_trans with (/2 * / cos(PI / 2 - u)). + rewrite cos_shift. + assert (sin u < u). + assert (t1 : 0 <= u) by (apply Rlt_le; assumption). + assert (t2 : u <= 4) by + (apply Rle_trans with 1;[apply Rlt_le | fourier]; assumption). + destruct (pre_sin_bound u 0 t1 t2) as [_ t]. + apply Rle_lt_trans with (1 := t); clear t1 t2 t. + unfold sin_approx; simpl; unfold sin_term; simpl ((-1) ^ 0); + replace ((-1) ^ 2) with 1 by ring; simpl ((-1) ^ 1); + rewrite !Rmult_1_r, !Rmult_1_l; simpl plus; simpl (INR (fact 1)). + rewrite <- (fun x => tech_pow_Rmult x 0), <- (fun x => tech_pow_Rmult x 2), + <- (fun x => tech_pow_Rmult x 4). + rewrite (Rmult_comm (-1)); simpl ((/(Rabs y + 1)) ^ 0). + unfold Rdiv; rewrite Rinv_1, !Rmult_assoc, <- !Rmult_plus_distr_l. + apply tmp;[assumption | ]. + rewrite Rplus_assoc, Rmult_1_l; pattern 1 at 3; rewrite <- Rplus_0_r. + apply Rplus_lt_compat_l. + rewrite <- Rmult_assoc. + match goal with |- (?a * (-1)) + _ < 0 => + rewrite <- (Rplus_opp_l a), Ropp_mult_distr_r_reverse, Rmult_1_r + end. + apply Rplus_lt_compat_l. + assert (0 < u ^ 2) by (apply pow_lt; assumption). + replace (u ^ 4) with (u ^ 2 * u ^ 2) by ring. + rewrite Rmult_assoc; apply Rmult_lt_compat_l; auto. + apply Rlt_trans with (u ^ 2 * /INR (fact 3)). + apply Rmult_lt_compat_l; auto. + apply Rinv_lt_contravar. + solve[apply Rmult_lt_0_compat; apply INR_fact_lt_0]. + rewrite !INR_IZR_INZ; apply IZR_lt; reflexivity. + rewrite Rmult_comm; apply tmp. + solve[apply Rinv_0_lt_compat, INR_fact_lt_0]. + apply Rlt_trans with (2 := vlt2). + simpl; unfold u; apply tmp; auto; rewrite Rmult_1_r; assumption. + apply Rlt_trans with (Rabs y + 1);[fourier | ]. + pattern (Rabs y + 1) at 1; rewrite <- (Rinv_involutive (Rabs y + 1)); + [ | apply Rgt_not_eq; fourier]. + rewrite <- Rinv_mult_distr. + apply Rinv_lt_contravar. + apply Rmult_lt_0_compat. + apply Rmult_lt_0_compat;[fourier | assumption]. + assumption. + replace (/(Rabs y + 1)) with (2 * u). + fourier. + unfold u; field; apply Rgt_not_eq; clear -r; fourier. + solve[discrR]. + apply Rgt_not_eq; assumption. +unfold tan. +set (u' := PI / 2); unfold Rdiv; apply Rmult_lt_compat_r; unfold u'. + apply Rinv_0_lt_compat. + rewrite cos_shift; assumption. +assert (vlt3 : u < /4). + replace (/4) with (/2 * /2) by field. + unfold u; apply Rmult_lt_compat_l;[fourier | ]. + apply Rinv_lt_contravar. + apply Rmult_lt_0_compat; fourier. + fourier. +assert (1 < PI / 2 - u) by (assert (t := PI2_3_2); fourier). +apply Rlt_trans with (sin 1). + assert (t' : 1 <= 4) by fourier. + destruct (pre_sin_bound 1 0 (Rlt_le _ _ Rlt_0_1) t') as [t _]. + apply Rlt_le_trans with (2 := t); clear t. + simpl plus; replace (sin_approx 1 1) with (5/6);[fourier | ]. + unfold sin_approx, sin_term; simpl; field. +apply sin_increasing_1. + assert (t := PI2_1); fourier. + apply Rlt_le, PI2_1. + assert (t := PI2_1); fourier. + fourier. +assumption. +Qed. + +Lemma ub_opp : forall x, x < PI/2 -> -PI/2 < -x. +Proof. +intros x h; rewrite Ropp_div; apply Ropp_lt_contravar; assumption. +Qed. + +Lemma pos_opp_lt : forall x, 0 < x -> -x < x. +Proof. intros; fourier. Qed. + +Lemma tech_opp_tan : forall x y, -tan x < y -> tan (-x) < y. +intros; rewrite tan_neg; assumption. +Qed. + +Definition pre_atan (y : R) : {x : R | -PI/2 < x < PI/2 /\ tan x = y}. +destruct (frame_tan y) as [ub [[ub0 ubpi2] Ptan_ub]]. +set (pr := (conj (tech_opp_tan _ _ (proj2 (Rabs_def2 _ _ Ptan_ub))) + (proj1 (Rabs_def2 _ _ Ptan_ub)))). +destruct (exists_atan_in_frame (-ub) ub y (pos_opp_lt _ ub0) (ub_opp _ ubpi2) + ubpi2 pr) as [v [[vl vu] vq]]. +exists v; clear pr. +split;[rewrite Ropp_div; split; fourier | assumption]. +Qed. + +Definition atan x := let (v, _) := pre_atan x in v. + +Lemma atan_bound : forall x, -PI/2 < atan x < PI/2. +Proof. +intros x; unfold atan; destruct (pre_atan x) as [v [int _]]; exact int. +Qed. + +Lemma atan_right_inv : forall x, tan (atan x) = x. +Proof. +intros x; unfold atan; destruct (pre_atan x) as [v [_ q]]; exact q. +Qed. + +Lemma atan_opp : forall x, atan (- x) = - atan x. +Proof. +intros x; generalize (atan_bound (-x)); rewrite Ropp_div;intros [a b]. +generalize (atan_bound x); rewrite Ropp_div; intros [c d]. +apply tan_is_inj; try rewrite Ropp_div; try split; try fourier. +rewrite tan_neg, !atan_right_inv; reflexivity. +Qed. + +Lemma derivable_pt_atan : forall x, derivable_pt atan x. +Proof. +intros x. +destruct (frame_tan x) as [ub [[ub0 ubpi] P]]. +assert (lb_lt_ub : -ub < ub) by apply pos_opp_lt, ub0. +assert (xint : tan(-ub) < x < tan ub). + assert (xint' : x < tan ub /\ -(tan ub) < x) by apply Rabs_def2, P. + rewrite tan_neg; tauto. +assert (inv_p : forall x, tan(-ub) <= x -> x <= tan ub -> + comp tan atan x = id x). + intros; apply atan_right_inv. +assert (int_tan : forall y, tan (- ub) <= y -> y <= tan ub -> + -ub <= atan y <= ub). + clear -ub0 ubpi; intros y lo up; split. + destruct (Rle_lt_dec (-ub) (atan y)) as [h | abs]; auto. + assert (y < tan (-ub)). + rewrite <- (atan_right_inv y); apply tan_increasing. + destruct (atan_bound y); assumption. + assumption. + fourier. + fourier. + destruct (Rle_lt_dec (atan y) ub) as [h | abs]; auto. + assert (tan ub < y). + rewrite <- (atan_right_inv y); apply tan_increasing. + rewrite Ropp_div; fourier. + assumption. + destruct (atan_bound y); assumption. + fourier. +assert (incr : forall x y, -ub <= x -> x < y -> y <= ub -> tan x < tan y). + intros y z l yz u; apply tan_increasing. + rewrite Ropp_div; fourier. + assumption. + fourier. +assert (der : forall a, -ub <= a <= ub -> derivable_pt tan a). + intros a [la ua]; apply derivable_pt_tan. + rewrite Ropp_div; split; fourier. +assert (df_neq : derive_pt tan (atan x) + (derivable_pt_recip_interv_prelim1 tan atan + (- ub) ub x lb_lt_ub xint inv_p int_tan incr der) <> 0). + rewrite <- (pr_nu tan (atan x) + (derivable_pt_tan (atan x) (atan_bound x))). + rewrite derive_pt_tan. + solve[apply Rgt_not_eq, plus_Rsqr_gt_0]. +apply (derivable_pt_recip_interv tan atan (-ub) ub x + lb_lt_ub xint inv_p int_tan incr der). +exact df_neq. +Qed. + +Lemma atan_increasing : forall x y, x < y -> atan x < atan y. +intros x y d. +assert (t1 := atan_bound x). +assert (t2 := atan_bound y). +destruct (Rlt_le_dec (atan x) (atan y)) as [lt | bad]. + assumption. +apply Rlt_not_le in d. +case d. +rewrite <- (atan_right_inv y), <- (atan_right_inv x). +destruct bad as [ylt | yx]. + apply Rlt_le, tan_increasing; try tauto. +solve[rewrite yx; apply Rle_refl]. +Qed. + +Lemma atan_0 : atan 0 = 0. +apply tan_is_inj; try (apply atan_bound). + assert (t := PI_RGT_0); rewrite Ropp_div; split; fourier. +rewrite atan_right_inv, tan_0. +reflexivity. +Qed. + +Lemma atan_1 : atan 1 = PI/4. +assert (ut := PI_RGT_0). +assert (-PI/2 < PI/4 < PI/2) by (rewrite Ropp_div; split; fourier). +assert (t := atan_bound 1). +apply tan_is_inj; auto. +rewrite tan_PI4, atan_right_inv; reflexivity. +Qed. + +(** atan's derivative value is the function 1 / (1+x²) *) + +Lemma derive_pt_atan : forall x, + derive_pt atan x (derivable_pt_atan x) = + 1 / (1 + x²). +Proof. +intros x. +destruct (frame_tan x) as [ub [[ub0 ubpi] Pub]]. +assert (lb_lt_ub : -ub < ub) by apply pos_opp_lt, ub0. +assert (xint : tan(-ub) < x < tan ub). + assert (xint' : x < tan ub /\ -(tan ub) < x) by apply Rabs_def2, Pub. + rewrite tan_neg; tauto. +assert (inv_p : forall x, tan(-ub) <= x -> x <= tan ub -> + comp tan atan x = id x). + intros; apply atan_right_inv. +assert (int_tan : forall y, tan (- ub) <= y -> y <= tan ub -> + -ub <= atan y <= ub). + clear -ub0 ubpi; intros y lo up; split. + destruct (Rle_lt_dec (-ub) (atan y)) as [h | abs]; auto. + assert (y < tan (-ub)). + rewrite <- (atan_right_inv y); apply tan_increasing. + destruct (atan_bound y); assumption. + assumption. + fourier. + fourier. + destruct (Rle_lt_dec (atan y) ub) as [h | abs]; auto. + assert (tan ub < y). + rewrite <- (atan_right_inv y); apply tan_increasing. + rewrite Ropp_div; fourier. + assumption. + destruct (atan_bound y); assumption. + fourier. +assert (incr : forall x y, -ub <= x -> x < y -> y <= ub -> tan x < tan y). + intros y z l yz u; apply tan_increasing. + rewrite Ropp_div; fourier. + assumption. + fourier. +assert (der : forall a, -ub <= a <= ub -> derivable_pt tan a). + intros a [la ua]; apply derivable_pt_tan. + rewrite Ropp_div; split; fourier. +assert (df_neq : derive_pt tan (atan x) + (derivable_pt_recip_interv_prelim1 tan atan + (- ub) ub x lb_lt_ub xint inv_p int_tan incr der) <> 0). + rewrite <- (pr_nu tan (atan x) + (derivable_pt_tan (atan x) (atan_bound x))). + rewrite derive_pt_tan. + solve[apply Rgt_not_eq, plus_Rsqr_gt_0]. +assert (t := derive_pt_recip_interv tan atan (-ub) ub x lb_lt_ub + xint incr int_tan der inv_p df_neq). +rewrite <- (pr_nu atan x (derivable_pt_recip_interv tan atan (- ub) ub + x lb_lt_ub xint inv_p int_tan incr der df_neq)). +rewrite t. +assert (t' := atan_bound x). +rewrite <- (pr_nu tan (atan x) (derivable_pt_tan _ t')). +rewrite derive_pt_tan, atan_right_inv. +replace (Rsqr x) with (x ^ 2) by (unfold Rsqr; ring). +reflexivity. +Qed. + +(** * Definition of the arctangent function as the sum of the arctan power series *) +(* Proof taken from Guillaume Melquiond's interval package for Coq *) + +Definition Ratan_seq x := fun n => (x ^ (2 * n + 1) / INR (2 * n + 1))%R. + +Lemma Ratan_seq_decreasing : forall x, (0 <= x <= 1)%R -> Un_decreasing (Ratan_seq x). +Proof. +intros x Hx n. + unfold Ratan_seq, Rdiv. + apply Rmult_le_compat. apply pow_le. + exact (proj1 Hx). + apply Rlt_le. + apply Rinv_0_lt_compat. + apply lt_INR_0. + omega. + destruct (proj1 Hx) as [Hx1|Hx1]. + destruct (proj2 Hx) as [Hx2|Hx2]. + (* . 0 < x < 1 *) + rewrite <- (Rinv_involutive x). + assert (/ x <> 0)%R by auto with real. + repeat rewrite <- Rinv_pow with (1 := H). + apply Rlt_le. + apply Rinv_lt_contravar. + apply Rmult_lt_0_compat ; apply pow_lt ; auto with real. + apply Rlt_pow. + rewrite <- Rinv_1. + apply Rinv_lt_contravar. + rewrite Rmult_1_r. + exact Hx1. + exact Hx2. + omega. + apply Rgt_not_eq. + exact Hx1. + (* . x = 1 *) + rewrite Hx2. + do 2 rewrite pow1. + apply Rle_refl. + (* . x = 0 *) + rewrite <- Hx1. + do 2 (rewrite pow_i ; [ idtac | omega ]). + apply Rle_refl. + apply Rlt_le. + apply Rinv_lt_contravar. + apply Rmult_lt_0_compat ; apply lt_INR_0 ; omega. + apply lt_INR. + omega. +Qed. + +Lemma Ratan_seq_converging : forall x, (0 <= x <= 1)%R -> Un_cv (Ratan_seq x) 0. +Proof. +intros x Hx eps Heps. + destruct (archimed (/ eps)) as (HN,_). + assert (0 < up (/ eps))%Z. + apply lt_IZR. + apply Rlt_trans with (2 := HN). + apply Rinv_0_lt_compat. + exact Heps. + case_eq (up (/ eps)) ; + intros ; rewrite H0 in H ; try discriminate H. + rewrite H0 in HN. + simpl in HN. + pose (N := Pos.to_nat p). + fold N in HN. + clear H H0. + exists N. + intros n Hn. + unfold R_dist. + rewrite Rminus_0_r. + unfold Ratan_seq. + rewrite Rabs_right. + apply Rle_lt_trans with (1 ^ (2 * n + 1) / INR (2 * n + 1))%R. + unfold Rdiv. + apply Rmult_le_compat_r. + apply Rlt_le. + apply Rinv_0_lt_compat. + apply lt_INR_0. + omega. + apply pow_incr. + exact Hx. + rewrite pow1. + apply Rle_lt_trans with (/ INR (2 * N + 1))%R. + unfold Rdiv. + rewrite Rmult_1_l. + apply Rle_Rinv. + apply lt_INR_0. + omega. + replace 0 with (INR 0) by intuition. + apply lt_INR. + omega. + intuition. + rewrite <- (Rinv_involutive eps). + apply Rinv_lt_contravar. + apply Rmult_lt_0_compat. + auto with real. + apply lt_INR_0. + omega. + apply Rlt_trans with (INR N). + destruct (archimed (/ eps)) as (H,_). + assert (0 < up (/ eps))%Z. + apply lt_IZR. + apply Rlt_trans with (2 := H). + apply Rinv_0_lt_compat. + exact Heps. + exact HN. + apply lt_INR. + omega. + apply Rgt_not_eq. + exact Heps. + apply Rle_ge. + unfold Rdiv. + apply Rmult_le_pos. + apply pow_le. + exact (proj1 Hx). + apply Rlt_le. + apply Rinv_0_lt_compat. + apply lt_INR_0. + omega. +Qed. + +Definition ps_atan_exists_01 (x : R) (Hx:0 <= x <= 1) : + {l : R | Un_cv (fun N : nat => sum_f_R0 (tg_alt (Ratan_seq x)) N) l}. +exact (alternated_series (Ratan_seq x) + (Ratan_seq_decreasing _ Hx) (Ratan_seq_converging _ Hx)). +Defined. + +Lemma Ratan_seq_opp : forall x n, Ratan_seq (-x) n = -Ratan_seq x n. +Proof. +intros x n; unfold Ratan_seq. +rewrite !pow_add, !pow_mult, !pow_1. +unfold Rdiv; replace ((-x) ^ 2) with (x ^ 2) by ring; ring. +Qed. + +Lemma sum_Ratan_seq_opp : + forall x n, sum_f_R0 (tg_alt (Ratan_seq (- x))) n = + - sum_f_R0 (tg_alt (Ratan_seq x)) n. +Proof. +intros x n; replace (-sum_f_R0 (tg_alt (Ratan_seq x)) n) with + (-1 * sum_f_R0 (tg_alt (Ratan_seq x)) n) by ring. +rewrite scal_sum; apply sum_eq; intros i _; unfold tg_alt. +rewrite Ratan_seq_opp; ring. +Qed. + +Definition ps_atan_exists_1 (x : R) (Hx : -1 <= x <= 1) : + {l : R | Un_cv (fun N : nat => sum_f_R0 (tg_alt (Ratan_seq x)) N) l}. +destruct (Rle_lt_dec 0 x). + assert (pr : 0 <= x <= 1) by tauto. + exact (ps_atan_exists_01 x pr). +assert (pr : 0 <= -x <= 1) by (destruct Hx; split; fourier). +destruct (ps_atan_exists_01 _ pr) as [v Pv]. +exists (-v). + apply (Un_cv_ext (fun n => (- 1) * sum_f_R0 (tg_alt (Ratan_seq (- x))) n)). + intros n; rewrite sum_Ratan_seq_opp; ring. +replace (-v) with (-1 * v) by ring. +apply CV_mult;[ | assumption]. +solve[intros; exists 0%nat; intros; rewrite R_dist_eq; auto]. +Qed. + +Definition in_int (x : R) : {-1 <= x <= 1}+{~ -1 <= x <= 1}. +destruct (Rle_lt_dec x 1). + destruct (Rle_lt_dec (-1) x). + left;split; auto. + right;intros [a1 a2]; fourier. +right;intros [a1 a2]; fourier. +Qed. + +Definition ps_atan (x : R) : R := + match in_int x with + left h => let (v, _) := ps_atan_exists_1 x h in v + | right h => atan x + end. + +(** * Proof of the equivalence of the two definitions between -1 and 1 *) + +Lemma ps_atan0_0 : ps_atan 0 = 0. +Proof. +unfold ps_atan. + destruct (in_int 0) as [h1 | h2]. + destruct (ps_atan_exists_1 0 h1) as [v P]. + apply (UL_sequence _ _ _ P). + apply (Un_cv_ext (fun n => 0)). + symmetry;apply sum_eq_R0. + intros i _; unfold tg_alt, Ratan_seq; rewrite plus_comm; simpl. + unfold Rdiv; rewrite !Rmult_0_l, Rmult_0_r; reflexivity. + intros eps ep; exists 0%nat; intros n _; unfold R_dist. + rewrite Rminus_0_r, Rabs_pos_eq; auto with real. +case h2; split; fourier. +Qed. + +Lemma ps_atan_exists_1_opp : + forall x h h', proj1_sig (ps_atan_exists_1 (-x) h) = + -(proj1_sig (ps_atan_exists_1 x h')). +Proof. +intros x h h'; destruct (ps_atan_exists_1 (-x) h) as [v Pv]. +destruct (ps_atan_exists_1 x h') as [u Pu]; simpl. +assert (Pu' : Un_cv (fun N => (-1) * sum_f_R0 (tg_alt (Ratan_seq x)) N) (-1 * u)). + apply CV_mult;[ | assumption]. + intros eps ep; exists 0%nat; intros; rewrite R_dist_eq; assumption. +assert (Pv' : Un_cv + (fun N : nat => -1 * sum_f_R0 (tg_alt (Ratan_seq x)) N) v). + apply Un_cv_ext with (2 := Pv); intros n; rewrite sum_Ratan_seq_opp; ring. +replace (-u) with (-1 * u) by ring. +apply UL_sequence with (1:=Pv') (2:= Pu'). +Qed. + +Lemma ps_atan_opp : forall x, ps_atan (-x) = -ps_atan x. +Proof. +intros x; unfold ps_atan. +destruct (in_int (- x)) as [inside | outside]. + destruct (in_int x) as [ins' | outs']. + generalize (ps_atan_exists_1_opp x inside ins'). + intros h; exact h. + destruct inside; case outs'; split; fourier. +destruct (in_int x) as [ins' | outs']. + destruct outside; case ins'; split; fourier. +apply atan_opp. +Qed. + +(** atan = ps_atan *) + +Lemma ps_atanSeq_continuity_pt_1 : forall (N:nat) (x:R), + 0 <= x -> + x <= 1 -> + continuity_pt (fun x => sum_f_R0 (tg_alt (Ratan_seq x)) N) x. +Proof. +assert (Sublemma : forall (x:R) (N:nat), sum_f_R0 (tg_alt (Ratan_seq x)) N = x * (comp (fun x => sum_f_R0 (fun n => (fun i : nat => (-1) ^ i / INR (2 * i + 1)) n * x ^ n) N) (fun x => x ^ 2) x)). + intros x N. + induction N. + unfold tg_alt, Ratan_seq, comp ; simpl ; field. + simpl sum_f_R0 at 1. + rewrite IHN. + replace (comp (fun x => sum_f_R0 (fun n : nat => (-1) ^ n / INR (2 * n + 1) * x ^ n) (S N)) (fun x => x ^ 2)) + with (comp (fun x => sum_f_R0 (fun n : nat => (-1) ^ n / INR (2 * n + 1) * x ^ n) N + (-1) ^ (S N) / INR (2 * (S N) + 1) * x ^ (S N)) (fun x => x ^ 2)). + unfold comp. + rewrite Rmult_plus_distr_l. + apply Rplus_eq_compat_l. + unfold tg_alt, Ratan_seq. + rewrite <- Rmult_assoc. + case (Req_dec x 0) ; intro Hyp. + rewrite Hyp ; rewrite pow_i. rewrite Rmult_0_l ; rewrite Rmult_0_l. + unfold Rdiv ; rewrite Rmult_0_l ; rewrite Rmult_0_r ; reflexivity. + intuition. + replace (x * ((-1) ^ S N / INR (2 * S N + 1)) * (x ^ 2) ^ S N) with (x ^ (2 * S N + 1) * ((-1) ^ S N / INR (2 * S N + 1))). + rewrite Rmult_comm ; unfold Rdiv at 1. + rewrite Rmult_assoc ; apply Rmult_eq_compat_l. + field. apply Rgt_not_eq ; intuition. + rewrite Rmult_assoc. + replace (x * ((-1) ^ S N / INR (2 * S N + 1) * (x ^ 2) ^ S N)) with (((-1) ^ S N / INR (2 * S N + 1) * (x ^ 2) ^ S N) * x). + rewrite Rmult_assoc. + replace ((x ^ 2) ^ S N * x) with (x ^ (2 * S N + 1)). + rewrite Rmult_comm at 1 ; reflexivity. + rewrite <- pow_mult. + assert (Temp : forall x n, x ^ n * x = x ^ (n+1)). + intros a n ; induction n. rewrite pow_O. simpl ; intuition. + simpl ; rewrite Rmult_assoc ; rewrite IHn ; intuition. + rewrite Temp ; reflexivity. + rewrite Rmult_comm ; reflexivity. + intuition. +intros N x x_lb x_ub. + intros eps eps_pos. + assert (continuity_id : continuity id). + apply derivable_continuous ; exact derivable_id. +assert (Temp := continuity_mult id (comp + (fun x1 : R => + sum_f_R0 (fun n : nat => (-1) ^ n / INR (2 * n + 1) * x1 ^ n) N) + (fun x1 : R => x1 ^ 2)) + continuity_id). +assert (Temp2 : continuity + (comp + (fun x1 : R => + sum_f_R0 (fun n : nat => (-1) ^ n / INR (2 * n + 1) * x1 ^ n) N) + (fun x1 : R => x1 ^ 2))). + apply continuity_comp. + reg. + apply continuity_finite_sum. + elim (Temp Temp2 x eps eps_pos) ; clear Temp Temp2 ; intros alpha T ; destruct T as (alpha_pos, T). + exists alpha ; split. + intuition. +intros x0 x0_cond. + rewrite Sublemma ; rewrite Sublemma. +apply T. +intuition. +Qed. + +(** Definition of ps_atan's derivative *) + +Definition Datan_seq := fun (x:R) (n:nat) => x ^ (2*n). + +Lemma pow_lt_1_compat : forall x n, 0 <= x < 1 -> (0 < n)%nat -> + 0 <= x ^ n < 1. +Proof. +intros x n hx; induction 1; simpl. + rewrite Rmult_1_r; tauto. +split. + apply Rmult_le_pos; tauto. +rewrite <- (Rmult_1_r 1); apply Rmult_le_0_lt_compat; intuition. +Qed. + +Lemma Datan_seq_Rabs : forall x n, Datan_seq (Rabs x) n = Datan_seq x n. +Proof. +intros x n; unfold Datan_seq; rewrite !pow_mult, pow2_abs; reflexivity. +Qed. + +Lemma Datan_seq_pos : forall x n, 0 < x -> 0 < Datan_seq x n. +Proof. +intros x n x_lb ; unfold Datan_seq ; induction n. + simpl ; intuition. + replace (x ^ (2 * S n)) with ((x ^ 2) * (x ^ (2 * n))). + apply Rmult_gt_0_compat. + replace (x^2) with (x*x) by field ; apply Rmult_gt_0_compat ; assumption. + assumption. + replace (2 * S n)%nat with (S (S (2 * n))) by intuition. + simpl ; field. +Qed. + +Lemma Datan_sum_eq :forall x n, + sum_f_R0 (tg_alt (Datan_seq x)) n = (1 - (- x ^ 2) ^ S n)/(1 + x ^ 2). +Proof. +intros x n. +assert (dif : - x ^ 2 <> 1). +apply Rlt_not_eq; apply Rle_lt_trans with 0;[ | apply Rlt_0_1]. +assert (t := pow2_ge_0 x); fourier. +replace (1 + x ^ 2) with (1 - - (x ^ 2)) by ring; rewrite <- (tech3 _ n dif). +apply sum_eq; unfold tg_alt, Datan_seq; intros i _. +rewrite pow_mult, <- Rpow_mult_distr, Ropp_mult_distr_l_reverse, Rmult_1_l. +reflexivity. +Qed. + +Lemma Datan_seq_increasing : forall x y n, (n > 0)%nat -> 0 <= x < y -> Datan_seq x n < Datan_seq y n. +Proof. +intros x y n n_lb x_encad ; assert (x_pos : x >= 0) by intuition. + assert (y_pos : y > 0). apply Rle_lt_trans with (r2:=x) ; intuition. + induction n. + apply False_ind ; intuition. + clear -x_encad x_pos y_pos ; induction n ; unfold Datan_seq. + case x_pos ; clear x_pos ; intro x_pos. + simpl ; apply Rmult_gt_0_lt_compat ; intuition. fourier. + rewrite x_pos ; rewrite pow_i. replace (y ^ (2*1)) with (y*y). + apply Rmult_gt_0_compat ; assumption. + simpl ; field. + intuition. + assert (Hrew : forall a, a^(2 * S (S n)) = (a ^ 2) * (a ^ (2 * S n))). + clear ; intro a ; replace (2 * S (S n))%nat with (S (S (2 * S n)))%nat by intuition. + simpl ; field. + case x_pos ; clear x_pos ; intro x_pos. + rewrite Hrew ; rewrite Hrew. + apply Rmult_gt_0_lt_compat ; intuition. + apply Rmult_gt_0_lt_compat ; intuition ; fourier. + rewrite x_pos. + rewrite pow_i ; intuition. +Qed. + +Lemma Datan_seq_decreasing : forall x, -1 < x -> x < 1 -> Un_decreasing (Datan_seq x). +Proof. +intros x x_lb x_ub n. +unfold Datan_seq. +replace (2 * S n)%nat with (2 + 2 * n)%nat by ring. +rewrite <- (Rmult_1_l (x ^ (2 * n))). +rewrite pow_add. +apply Rmult_le_compat_r. +rewrite pow_mult; apply pow_le, pow2_ge_0. +apply Rlt_le; rewrite <- pow2_abs. +assert (intabs : 0 <= Rabs x < 1). + split;[apply Rabs_pos | apply Rabs_def1]; tauto. +apply (pow_lt_1_compat (Rabs x) 2) in intabs. + tauto. +omega. +Qed. + +Lemma Datan_seq_CV_0 : forall x, -1 < x -> x < 1 -> Un_cv (Datan_seq x) 0. +Proof. +intros x x_lb x_ub eps eps_pos. +assert (x_ub2 : Rabs (x^2) < 1). + rewrite Rabs_pos_eq;[ | apply pow2_ge_0]. + rewrite <- pow2_abs. + assert (H: 0 <= Rabs x < 1) + by (split;[apply Rabs_pos | apply Rabs_def1; auto]). + apply (pow_lt_1_compat _ 2) in H;[tauto | omega]. +elim (pow_lt_1_zero (x^2) x_ub2 eps eps_pos) ; intros N HN ; exists N ; intros n Hn. +unfold R_dist, Datan_seq. +replace (x ^ (2 * n) - 0) with ((x ^ 2) ^ n). apply HN ; assumption. +rewrite pow_mult ; field. +Qed. + +Lemma Datan_lim : forall x, -1 < x -> x < 1 -> + Un_cv (fun N : nat => sum_f_R0 (tg_alt (Datan_seq x)) N) (/ (1 + x ^ 2)). +Proof. +intros x x_lb x_ub eps eps_pos. +assert (Tool0 : 0 <= x ^ 2) by apply pow2_ge_0. +assert (Tool1 : 0 < (1 + x ^ 2)). + solve[apply Rplus_lt_le_0_compat ; intuition]. +assert (Tool2 : / (1 + x ^ 2) > 0). + apply Rinv_0_lt_compat ; tauto. +assert (x_ub2' : 0<= Rabs (x^2) < 1). + rewrite Rabs_pos_eq, <- pow2_abs;[ | apply pow2_ge_0]. + apply pow_lt_1_compat;[split;[apply Rabs_pos | ] | omega]. + apply Rabs_def1; assumption. +assert (x_ub2 : Rabs (x^2) < 1) by tauto. +assert (eps'_pos : ((1+x^2)*eps) > 0). + apply Rmult_gt_0_compat ; assumption. +elim (pow_lt_1_zero _ x_ub2 _ eps'_pos) ; intros N HN ; exists N. +intros n Hn. +assert (H1 : - x^2 <> 1). + apply Rlt_not_eq; apply Rle_lt_trans with (2 := Rlt_0_1). +assert (t := pow2_ge_0 x); fourier. +rewrite Datan_sum_eq. +unfold R_dist. +assert (tool : forall a b, a / b - /b = (-1 + a) /b). + intros a b; rewrite <- (Rmult_1_l (/b)); unfold Rdiv, Rminus. + rewrite <- Ropp_mult_distr_l_reverse, Rmult_plus_distr_r, Rplus_comm. + reflexivity. +set (u := 1 + x ^ 2); rewrite tool; unfold Rminus; rewrite <- Rplus_assoc. +unfold Rdiv, u. +rewrite Rplus_opp_l, Rplus_0_l, Ropp_mult_distr_l_reverse, Rabs_Ropp. +rewrite Rabs_mult; clear tool u. +assert (tool : forall k, Rabs ((-x ^ 2) ^ k) = Rabs ((x ^ 2) ^ k)). + clear -Tool0; induction k;[simpl; rewrite Rabs_R1;tauto | ]. + rewrite <- !(tech_pow_Rmult _ k), !Rabs_mult, Rabs_Ropp, IHk, Rabs_pos_eq. + reflexivity. + exact Tool0. +rewrite tool, (Rabs_pos_eq (/ _)); clear tool;[ | apply Rlt_le; assumption]. +assert (tool : forall a b c, 0 < b -> a < b * c -> a * / b < c). + intros a b c bp h; replace c with (b * c * /b). + apply Rmult_lt_compat_r. + apply Rinv_0_lt_compat; assumption. + assumption. + field; apply Rgt_not_eq; exact bp. +apply tool;[exact Tool1 | ]. +apply HN; omega. +Qed. + +Lemma Datan_CVU_prelim : forall c (r : posreal), Rabs c + r < 1 -> + CVU (fun N x => sum_f_R0 (tg_alt (Datan_seq x)) N) + (fun y : R => / (1 + y ^ 2)) c r. +Proof. +intros c r ub_ub eps eps_pos. +apply (Alt_CVU (fun x n => Datan_seq n x) + (fun x => /(1 + x ^ 2)) + (Datan_seq (Rabs c + r)) c r). + intros x inb; apply Datan_seq_decreasing; + try (apply Boule_lt in inb; apply Rabs_def2 in inb; + destruct inb; fourier). + intros x inb; apply Datan_seq_CV_0; + try (apply Boule_lt in inb; apply Rabs_def2 in inb; + destruct inb; fourier). + intros x inb; apply (Datan_lim x); + try (apply Boule_lt in inb; apply Rabs_def2 in inb; + destruct inb; fourier). + intros x [ | n] inb. + solve[unfold Datan_seq; apply Rle_refl]. + rewrite <- (Datan_seq_Rabs x); apply Rlt_le, Datan_seq_increasing. + omega. + apply Boule_lt in inb; intuition. + solve[apply Rabs_pos]. + apply Datan_seq_CV_0. + apply Rlt_trans with 0;[fourier | ]. + apply Rplus_le_lt_0_compat. + solve[apply Rabs_pos]. + destruct r; assumption. + assumption. +assumption. +Qed. + +Lemma Datan_is_datan : forall (N:nat) (x:R), + -1 <= x -> + x < 1 -> +derivable_pt_lim (fun x => sum_f_R0 (tg_alt (Ratan_seq x)) N) x (sum_f_R0 (tg_alt (Datan_seq x)) N). +Proof. +assert (Tool : forall N, (-1) ^ (S (2 * N)) = - 1). + intro n ; induction n. + simpl ; field. + replace ((-1) ^ S (2 * S n)) with ((-1) ^ 2 * (-1) ^ S (2*n)). + rewrite IHn ; field. + rewrite <- pow_add. + replace (2 + S (2 * n))%nat with (S (2 * S n))%nat. + reflexivity. + intuition. +intros N x x_lb x_ub. + induction N. + unfold Datan_seq, Ratan_seq, tg_alt ; simpl. + intros eps eps_pos. + elim (derivable_pt_lim_id x eps eps_pos) ; intros delta Hdelta ; exists delta. + intros h hneq h_b. + replace (1 * ((x + h) * 1 / 1) - 1 * (x * 1 / 1)) with (id (x + h) - id x). + rewrite Rmult_1_r. + apply Hdelta ; assumption. + unfold id ; field ; assumption. + intros eps eps_pos. + assert (eps_3_pos : (eps/3) > 0) by fourier. + elim (IHN (eps/3) eps_3_pos) ; intros delta1 Hdelta1. + assert (Main : derivable_pt_lim (fun x : R =>tg_alt (Ratan_seq x) (S N)) x ((tg_alt (Datan_seq x)) (S N))). + clear -Tool ; intros eps' eps'_pos. + elim (derivable_pt_lim_pow x (2 * (S N) + 1) eps' eps'_pos) ; intros delta Hdelta ; exists delta. + intros h h_neq h_b ; unfold tg_alt, Ratan_seq, Datan_seq. + replace (((-1) ^ S N * ((x + h) ^ (2 * S N + 1) / INR (2 * S N + 1)) - + (-1) ^ S N * (x ^ (2 * S N + 1) / INR (2 * S N + 1))) / h - + (-1) ^ S N * x ^ (2 * S N)) + with (((-1)^(S N)) * ((((x + h) ^ (2 * S N + 1) / INR (2 * S N + 1)) - + (x ^ (2 * S N + 1) / INR (2 * S N + 1))) / h - x ^ (2 * S N))). + rewrite Rabs_mult ; rewrite pow_1_abs ; rewrite Rmult_1_l. + replace (((x + h) ^ (2 * S N + 1) / INR (2 * S N + 1) - + x ^ (2 * S N + 1) / INR (2 * S N + 1)) / h - x ^ (2 * S N)) + with ((/INR (2* S N + 1)) * (((x + h) ^ (2 * S N + 1) - x ^ (2 * S N + 1)) / h - + INR (2 * S N + 1) * x ^ pred (2 * S N + 1))). + rewrite Rabs_mult. + case (Req_dec (((x + h) ^ (2 * S N + 1) - x ^ (2 * S N + 1)) / h - + INR (2 * S N + 1) * x ^ pred (2 * S N + 1)) 0) ; intro Heq. + rewrite Heq ; rewrite Rabs_R0 ; rewrite Rmult_0_r ; assumption. + apply Rlt_trans with (r2:=Rabs + (((x + h) ^ (2 * S N + 1) - x ^ (2 * S N + 1)) / h - + INR (2 * S N + 1) * x ^ pred (2 * S N + 1))). + rewrite <- Rmult_1_l ; apply Rmult_lt_compat_r. + apply Rabs_pos_lt ; assumption. + rewrite Rabs_right. + replace 1 with (/1) by field. + apply Rinv_1_lt_contravar ; intuition. + apply Rgt_ge ; replace (INR (2 * S N + 1)) with (INR (2*S N) + 1) ; + [apply RiemannInt.RinvN_pos | ]. + replace (2 * S N + 1)%nat with (S (2 * S N))%nat by intuition ; + rewrite S_INR ; reflexivity. + apply Hdelta ; assumption. + rewrite Rmult_minus_distr_l. + replace (/ INR (2 * S N + 1) * (INR (2 * S N + 1) * x ^ pred (2 * S N + 1))) with (x ^ (2 * S N)). + unfold Rminus ; rewrite Rplus_comm. + replace (((x + h) ^ (2 * S N + 1) / INR (2 * S N + 1) + + - (x ^ (2 * S N + 1) / INR (2 * S N + 1))) / h + - x ^ (2 * S N)) + with (- x ^ (2 * S N) + (((x + h) ^ (2 * S N + 1) / INR (2 * S N + 1) + + - (x ^ (2 * S N + 1) / INR (2 * S N + 1))) / h)) by intuition. + apply Rplus_eq_compat_l. field. + split ; [apply Rgt_not_eq|] ; intuition. + clear ; replace (pred (2 * S N + 1)) with (2 * S N)%nat by intuition. + field ; apply Rgt_not_eq ; intuition. + field ; split ; [apply Rgt_not_eq |] ; intuition. + elim (Main (eps/3) eps_3_pos) ; intros delta2 Hdelta2. + destruct delta1 as (delta1, delta1_pos) ; destruct delta2 as (delta2, delta2_pos). + pose (mydelta := Rmin delta1 delta2). + assert (mydelta_pos : mydelta > 0). + unfold mydelta ; rewrite Rmin_Rgt ; split ; assumption. + pose (delta := mkposreal mydelta mydelta_pos) ; exists delta ; intros h h_neq h_b. + clear Main IHN. + unfold Rminus at 1. + apply Rle_lt_trans with (r2:=eps/3 + eps / 3). + assert (Temp : (sum_f_R0 (tg_alt (Ratan_seq (x + h))) (S N) - + sum_f_R0 (tg_alt (Ratan_seq x)) (S N)) / h + + - sum_f_R0 (tg_alt (Datan_seq x)) (S N) = ((sum_f_R0 (tg_alt (Ratan_seq (x + h))) N - + sum_f_R0 (tg_alt (Ratan_seq x)) N) / h) + (- + sum_f_R0 (tg_alt (Datan_seq x)) N) + ((tg_alt (Ratan_seq (x + h)) (S N) - tg_alt (Ratan_seq x) (S N)) / + h - tg_alt (Datan_seq x) (S N))). + simpl ; field ; intuition. + apply Rle_trans with (r2:= Rabs ((sum_f_R0 (tg_alt (Ratan_seq (x + h))) N - + sum_f_R0 (tg_alt (Ratan_seq x)) N) / h + + - sum_f_R0 (tg_alt (Datan_seq x)) N) + + Rabs ((tg_alt (Ratan_seq (x + h)) (S N) - tg_alt (Ratan_seq x) (S N)) / h - + tg_alt (Datan_seq x) (S N))). + rewrite Temp ; clear Temp ; apply Rabs_triang. + apply Rplus_le_compat ; apply Rlt_le ; [apply Hdelta1 | apply Hdelta2] ; + intuition ; apply Rlt_le_trans with (r2:=delta) ; intuition unfold delta, mydelta. + apply Rmin_l. + apply Rmin_r. + fourier. +Qed. + +Lemma Ratan_CVU' : + CVU (fun N x => sum_f_R0 (tg_alt (Ratan_seq x)) N) + ps_atan (/2) (mkposreal (/2) pos_half_prf). +Proof. +apply (Alt_CVU (fun i r => Ratan_seq r i) ps_atan PI_tg (/2) pos_half); + lazy beta. + now intros; apply Ratan_seq_decreasing, Boule_half_to_interval. + now intros; apply Ratan_seq_converging, Boule_half_to_interval. + intros x b; apply Boule_half_to_interval in b. + unfold ps_atan; destruct (in_int x) as [inside | outside]; + [ | destruct b; case outside; split; fourier]. + destruct (ps_atan_exists_1 x inside) as [v Pv]. + apply Un_cv_ext with (2 := Pv);[reflexivity]. + intros x n b; apply Boule_half_to_interval in b. + rewrite <- (Rmult_1_l (PI_tg n)); unfold Ratan_seq, PI_tg. + apply Rmult_le_compat_r. + apply Rlt_le, Rinv_0_lt_compat, (lt_INR 0); omega. + rewrite <- (pow1 (2 * n + 1)); apply pow_incr; assumption. +exact PI_tg_cv. +Qed. + +Lemma Ratan_CVU : + CVU (fun N x => sum_f_R0 (tg_alt (Ratan_seq x)) N) + ps_atan 0 (mkposreal 1 Rlt_0_1). +Proof. +intros eps ep; destruct (Ratan_CVU' eps ep) as [N Pn]. +exists N; intros n x nN b_y. +case (Rtotal_order 0 x) as [xgt0 | [x0 | x0]]. + assert (Boule (/2) {| pos := / 2; cond_pos := pos_half_prf|} x). + revert b_y; unfold Boule; simpl; intros b_y; apply Rabs_def2 in b_y. + destruct b_y; unfold Boule; simpl; apply Rabs_def1; fourier. + apply Pn; assumption. + rewrite <- x0, ps_atan0_0. + rewrite <- (sum_eq (fun _ => 0)), sum_cte, Rmult_0_l, Rminus_0_r, Rabs_pos_eq. + assumption. + apply Rle_refl. + intros i _; unfold tg_alt, Ratan_seq, Rdiv; rewrite plus_comm; simpl. + solve[rewrite !Rmult_0_l, Rmult_0_r; auto]. +replace (ps_atan x - sum_f_R0 (tg_alt (Ratan_seq x)) n) with + (-(ps_atan (-x) - sum_f_R0 (tg_alt (Ratan_seq (-x))) n)). + rewrite Rabs_Ropp. + assert (Boule (/2) {| pos := / 2; cond_pos := pos_half_prf|} (-x)). + revert b_y; unfold Boule; simpl; intros b_y; apply Rabs_def2 in b_y. + destruct b_y; unfold Boule; simpl; apply Rabs_def1; fourier. + apply Pn; assumption. +unfold Rminus; rewrite ps_atan_opp, Ropp_plus_distr, sum_Ratan_seq_opp. +rewrite !Ropp_involutive; reflexivity. +Qed. + +Lemma Alt_PI_tg : forall n, PI_tg n = Ratan_seq 1 n. +Proof. +intros n; unfold PI_tg, Ratan_seq, Rdiv; rewrite pow1, Rmult_1_l. +reflexivity. +Qed. + +Lemma Ratan_is_ps_atan : forall eps, eps > 0 -> + exists N, forall n, (n >= N)%nat -> forall x, -1 < x -> x < 1 -> + Rabs (sum_f_R0 (tg_alt (Ratan_seq x)) n - ps_atan x) < eps. +Proof. +intros eps ep. +destruct (Ratan_CVU _ ep) as [N1 PN1]. +exists N1; intros n nN x xm1 x1; rewrite <- Rabs_Ropp, Ropp_minus_distr. +apply PN1; [assumption | ]. +unfold Boule; simpl; rewrite Rminus_0_r; apply Rabs_def1; assumption. +Qed. + +Lemma Datan_continuity : continuity (fun x => /(1+x ^ 2)). +Proof. +apply continuity_inv. +apply continuity_plus. +apply continuity_const ; unfold constant ; intuition. +apply derivable_continuous ; apply derivable_pow. +intro x ; apply Rgt_not_eq ; apply Rge_gt_trans with (1+0) ; [|fourier] ; + apply Rplus_ge_compat_l. + replace (x^2) with (x²). + apply Rle_ge ; apply Rle_0_sqr. + unfold Rsqr ; field. +Qed. + +Lemma derivable_pt_lim_ps_atan : forall x, -1 < x < 1 -> + derivable_pt_lim ps_atan x ((fun y => /(1 + y ^ 2)) x). +Proof. +intros x x_encad. +destruct (boule_in_interval (-1) 1 x x_encad) as [c [r [Pcr1 [P1 P2]]]]. +change (/ (1 + x ^ 2)) with ((fun u => /(1 + u ^ 2)) x). +assert (t := derivable_pt_lim_CVU). +apply derivable_pt_lim_CVU with + (fn := (fun N x => sum_f_R0 (tg_alt (Ratan_seq x)) N)) + (fn' := (fun N x => sum_f_R0 (tg_alt (Datan_seq x)) N)) + (c := c) (r := r). + assumption. + intros y N inb; apply Rabs_def2 in inb; destruct inb. + apply Datan_is_datan. + fourier. + fourier. + intros y inb; apply Rabs_def2 in inb; destruct inb. + assert (y_gt_0 : -1 < y) by fourier. + assert (y_lt_1 : y < 1) by fourier. + intros eps eps_pos ; elim (Ratan_is_ps_atan eps eps_pos). + intros N HN ; exists N; intros n n_lb ; apply HN ; tauto. + apply Datan_CVU_prelim. + replace ((c - r + (c + r)) / 2) with c by field. + unfold mkposreal_lb_ub; simpl. + replace ((c + r - (c - r)) / 2) with (r :R) by field. + assert (Rabs c < 1 - r). + unfold Boule in Pcr1; destruct r; simpl in *; apply Rabs_def1; + apply Rabs_def2 in Pcr1; destruct Pcr1; fourier. + fourier. +intros; apply Datan_continuity. +Qed. + +Lemma derivable_pt_ps_atan : + forall x, -1 < x < 1 -> derivable_pt ps_atan x. +Proof. +intros x x_encad. +exists (/(1+x^2)) ; apply derivable_pt_lim_ps_atan; assumption. +Qed. + +Lemma ps_atan_continuity_pt_1 : forall eps : R, + eps > 0 -> + exists alp : R, + alp > 0 /\ + (forall x, x < 1 -> 0 < x -> R_dist x 1 < alp -> + dist R_met (ps_atan x) (Alt_PI/4) < eps). +Proof. +intros eps eps_pos. +assert (eps_3_pos : eps / 3 > 0) by fourier. +elim (Ratan_is_ps_atan (eps / 3) eps_3_pos) ; intros N1 HN1. +unfold Alt_PI. +destruct exist_PI as [v Pv]; replace ((4 * v)/4) with v by field. +assert (Pv' : Un_cv (sum_f_R0 (tg_alt (Ratan_seq 1))) v). + apply Un_cv_ext with (2:= Pv). + intros; apply sum_eq; intros; unfold tg_alt; rewrite Alt_PI_tg; tauto. +destruct (Pv' (eps / 3) eps_3_pos) as [N2 HN2]. +set (N := (N1 + N2)%nat). +assert (O_lb : 0 <= 1) by intuition ; assert (O_ub : 1 <= 1) by intuition ; + elim (ps_atanSeq_continuity_pt_1 N 1 O_lb O_ub (eps / 3) eps_3_pos) ; intros alpha Halpha ; + clear -HN1 HN2 Halpha eps_3_pos; destruct Halpha as (alpha_pos, Halpha). +exists alpha ; split;[assumption | ]. +intros x x_ub x_lb x_bounds. +simpl ; unfold R_dist. +replace (ps_atan x - v) with ((ps_atan x - sum_f_R0 (tg_alt (Ratan_seq x)) N) + + (sum_f_R0 (tg_alt (Ratan_seq x)) N - sum_f_R0 (tg_alt (Ratan_seq 1)) N) + + (sum_f_R0 (tg_alt (Ratan_seq 1)) N - v)). +apply Rle_lt_trans with (r2:=Rabs (ps_atan x - sum_f_R0 (tg_alt (Ratan_seq x)) N) + + Rabs ((sum_f_R0 (tg_alt (Ratan_seq x)) N - sum_f_R0 (tg_alt (Ratan_seq 1)) N) + + (sum_f_R0 (tg_alt (Ratan_seq 1)) N - v))). +rewrite Rplus_assoc ; apply Rabs_triang. + replace eps with (2 / 3 * eps + eps / 3). + rewrite Rplus_comm. + apply Rplus_lt_compat. + apply Rle_lt_trans with (r2 := Rabs (sum_f_R0 (tg_alt (Ratan_seq x)) N - sum_f_R0 (tg_alt (Ratan_seq 1)) N) + + Rabs (sum_f_R0 (tg_alt (Ratan_seq 1)) N - v)). + apply Rabs_triang. + apply Rlt_le_trans with (r2:= eps / 3 + eps / 3). + apply Rplus_lt_compat. + simpl in Halpha ; unfold R_dist in Halpha. + apply Halpha ; split. + unfold D_x, no_cond ; split ; [ | apply Rgt_not_eq ] ; intuition. + intuition. + apply HN2; unfold N; omega. + fourier. + rewrite <- Rabs_Ropp, Ropp_minus_distr; apply HN1. + unfold N; omega. + fourier. + assumption. + field. +ring. +Qed. + +Lemma Datan_eq_DatanSeq_interv : forall x, -1 < x < 1 -> + forall (Pratan:derivable_pt ps_atan x) (Prmymeta:derivable_pt atan x), + derive_pt ps_atan x Pratan = derive_pt atan x Prmymeta. +Proof. +assert (freq : 0 < tan 1) by apply (Rlt_trans _ _ _ Rlt_0_1 tan_1_gt_1). +intros x x_encad Pratan Prmymeta. + rewrite pr_nu_var2_interv with (g:=ps_atan) (lb:=-1) (ub:=tan 1) + (pr2 := derivable_pt_ps_atan x x_encad). + rewrite pr_nu_var2_interv with (f:=atan) (g:=atan) (lb:=-1) (ub:= 1) (pr2:=derivable_pt_atan x). + assert (Temp := derivable_pt_lim_ps_atan x x_encad). + assert (Hrew1 : derive_pt ps_atan x (derivable_pt_ps_atan x x_encad) = (/(1+x^2))). + apply derive_pt_eq_0 ; assumption. + rewrite derive_pt_atan. + rewrite Hrew1. + replace (Rsqr x) with (x ^ 2) by (unfold Rsqr; ring). + unfold Rdiv; rewrite Rmult_1_l; reflexivity. + fourier. + assumption. + intros; reflexivity. + fourier. + assert (t := tan_1_gt_1); split;destruct x_encad; fourier. +intros; reflexivity. +Qed. + +Lemma atan_eq_ps_atan : + forall x, 0 < x < 1 -> atan x = ps_atan x. +Proof. +intros x x_encad. +assert (pr1 : forall c : R, 0 < c < x -> derivable_pt (atan - ps_atan) c). + intros c c_encad. + apply derivable_pt_minus. + exact (derivable_pt_atan c). + apply derivable_pt_ps_atan. + destruct x_encad; destruct c_encad; split; fourier. +assert (pr2 : forall c : R, 0 < c < x -> derivable_pt id c). + intros ; apply derivable_pt_id; fourier. +assert (delta_cont : forall c : R, 0 <= c <= x -> continuity_pt (atan - ps_atan) c). + intros c [[c_encad1 | c_encad1 ] [c_encad2 | c_encad2]]; + apply continuity_pt_minus. + apply derivable_continuous_pt ; apply derivable_pt_atan. + apply derivable_continuous_pt ; apply derivable_pt_ps_atan. + split; destruct x_encad; fourier. + apply derivable_continuous_pt, derivable_pt_atan. + apply derivable_continuous_pt, derivable_pt_ps_atan. + subst c; destruct x_encad; split; fourier. + apply derivable_continuous_pt, derivable_pt_atan. + apply derivable_continuous_pt, derivable_pt_ps_atan. + subst c; split; fourier. + apply derivable_continuous_pt, derivable_pt_atan. + apply derivable_continuous_pt, derivable_pt_ps_atan. + subst c; destruct x_encad; split; fourier. +assert (id_cont : forall c : R, 0 <= c <= x -> continuity_pt id c). + intros ; apply derivable_continuous ; apply derivable_id. +assert (x_lb : 0 < x) by (destruct x_encad; fourier). +elim (MVT (atan - ps_atan)%F id 0 x pr1 pr2 x_lb delta_cont id_cont) ; intros d Temp ; elim Temp ; intros d_encad Main. +clear - Main x_encad. +assert (Temp : forall (pr: derivable_pt (atan - ps_atan) d), derive_pt (atan - ps_atan) d pr = 0). + intro pr. + assert (d_encad3 : -1 < d < 1). + destruct d_encad; destruct x_encad; split; fourier. + pose (pr3 := derivable_pt_minus atan ps_atan d (derivable_pt_atan d) (derivable_pt_ps_atan d d_encad3)). + rewrite <- pr_nu_var2_interv with (f:=(atan - ps_atan)%F) (g:=(atan - ps_atan)%F) (lb:=0) (ub:=x) (pr1:=pr3) (pr2:=pr). + unfold pr3. rewrite derive_pt_minus. + rewrite Datan_eq_DatanSeq_interv with (Prmymeta := derivable_pt_atan d). + intuition. + assumption. + destruct d_encad; fourier. + assumption. + reflexivity. +assert (iatan0 : atan 0 = 0). + apply tan_is_inj. + apply atan_bound. + rewrite Ropp_div; assert (t := PI2_RGT_0); split; fourier. + rewrite tan_0, atan_right_inv; reflexivity. +generalize Main; rewrite Temp, Rmult_0_r. +replace ((atan - ps_atan)%F x) with (atan x - ps_atan x) by intuition. +replace ((atan - ps_atan)%F 0) with (atan 0 - ps_atan 0) by intuition. +rewrite iatan0, ps_atan0_0, !Rminus_0_r. +replace (derive_pt id d (pr2 d d_encad)) with 1. + rewrite Rmult_1_r. + solve[intros M; apply Rminus_diag_uniq; auto]. +rewrite pr_nu_var with (g:=id) (pr2:=derivable_pt_id d). + symmetry ; apply derive_pt_id. +tauto. +Qed. + + +Theorem Alt_PI_eq : Alt_PI = PI. +apply Rmult_eq_reg_r with (/4); fold (Alt_PI/4); fold (PI/4); + [ | apply Rgt_not_eq; fourier]. +assert (0 < PI/6) by (apply PI6_RGT_0). +assert (t1:= PI2_1). +assert (t2 := PI_4). +assert (m := Alt_PI_RGT_0). +assert (-PI/2 < 1 < PI/2) by (rewrite Ropp_div; split; fourier). +apply cond_eq; intros eps ep. +change (R_dist (Alt_PI/4) (PI/4) < eps). +assert (ca : continuity_pt atan 1). + apply derivable_continuous_pt, derivable_pt_atan. +assert (Xe : exists eps', exists eps'', + eps' + eps'' <= eps /\ 0 < eps' /\ 0 < eps''). + exists (eps/2); exists (eps/2); repeat apply conj; fourier. +destruct Xe as [eps' [eps'' [eps_ineq [ep' ep'']]]]. +destruct (ps_atan_continuity_pt_1 _ ep') as [alpha [a0 Palpha]]. +destruct (ca _ ep'') as [beta [b0 Pbeta]]. +assert (Xa : exists a, 0 < a < 1 /\ R_dist a 1 < alpha /\ + R_dist a 1 < beta). + exists (Rmax (/2) (Rmax (1 - alpha /2) (1 - beta /2))). + assert (/2 <= Rmax (/2) (Rmax (1 - alpha /2) (1 - beta /2))) by apply Rmax_l. + assert (Rmax (1 - alpha /2) (1 - beta /2) <= + Rmax (/2) (Rmax (1 - alpha /2) (1 - beta /2))) by apply Rmax_r. + assert ((1 - alpha /2) <= Rmax (1 - alpha /2) (1 - beta /2)) by apply Rmax_l. + assert ((1 - beta /2) <= Rmax (1 - alpha /2) (1 - beta /2)) by apply Rmax_r. + assert (Rmax (1 - alpha /2) (1 - beta /2) < 1) + by (apply Rmax_lub_lt; fourier). + split;[split;[ | apply Rmax_lub_lt]; fourier | ]. + assert (0 <= 1 - Rmax (/ 2) (Rmax (1 - alpha / 2) (1 - beta / 2))). + assert (Rmax (/2) (Rmax (1 - alpha / 2) + (1 - beta /2)) <= 1) by (apply Rmax_lub; fourier). + fourier. + split; unfold R_dist; rewrite <-Rabs_Ropp, Ropp_minus_distr, + Rabs_pos_eq;fourier. +destruct Xa as [a [[Pa0 Pa1] [P1 P2]]]. +apply Rle_lt_trans with (1 := R_dist_tri _ _ (ps_atan a)). +apply Rlt_le_trans with (2 := eps_ineq). +apply Rplus_lt_compat. +rewrite R_dist_sym; apply Palpha; assumption. +rewrite <- atan_eq_ps_atan. + rewrite <- atan_1; apply (Pbeta a); auto. + split; [ | exact P2]. +split;[exact I | apply Rgt_not_eq; assumption]. +split; assumption. +Qed. + +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). +Proof. +intros; rewrite <- Alt_PI_eq; apply Alt_PI_ineq. +Qed. + diff --git a/theories/Reals/Raxioms.v b/theories/Reals/Raxioms.v index 8f01d7d0..200019a8 100644 --- a/theories/Reals/Raxioms.v +++ b/theories/Reals/Raxioms.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -12,7 +12,7 @@ Require Export ZArith_base. Require Export Rdefinitions. -Open Local Scope R_scope. +Local Open Scope R_scope. (*********************************************************) (** * Field axioms *) @@ -122,8 +122,8 @@ Arguments INR n%nat. Definition IZR (z:Z) : R := match z with | Z0 => 0 - | Zpos n => INR (nat_of_P n) - | Zneg n => - INR (nat_of_P n) + | Zpos n => INR (Pos.to_nat n) + | Zneg n => - INR (Pos.to_nat n) end. Arguments IZR z%Z. diff --git a/theories/Reals/Rbase.v b/theories/Reals/Rbase.v index dbf9ad71..29715ed9 100644 --- a/theories/Reals/Rbase.v +++ b/theories/Reals/Rbase.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Rbasic_fun.v b/theories/Reals/Rbasic_fun.v index 4bc7fd10..560f389b 100644 --- a/theories/Reals/Rbasic_fun.v +++ b/theories/Reals/Rbasic_fun.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -45,10 +45,10 @@ Qed. (*********) Lemma Rmin_Rgt_l : forall r1 r2 r, Rmin r1 r2 > r -> r1 > r /\ r2 > r. Proof. - intros r1 r2 r; unfold Rmin in |- *; case (Rle_dec r1 r2); intros. + intros r1 r2 r; unfold Rmin; case (Rle_dec r1 r2); intros. split. assumption. - unfold Rgt in |- *; unfold Rgt in H; exact (Rlt_le_trans r r1 r2 H r0). + unfold Rgt; 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. @@ -57,7 +57,7 @@ Qed. (*********) Lemma Rmin_Rgt_r : forall r1 r2 r, r1 > r /\ r2 > r -> Rmin r1 r2 > r. Proof. - intros; unfold Rmin in |- *; case (Rle_dec r1 r2); elim H; clear H; intros; + intros; unfold Rmin; case (Rle_dec r1 r2); elim H; clear H; intros; assumption. Qed. @@ -72,14 +72,14 @@ Qed. (*********) Lemma Rmin_l : forall x y:R, Rmin x y <= x. Proof. - intros; unfold Rmin in |- *; case (Rle_dec x y); intro H1; + intros; unfold Rmin; case (Rle_dec x y); intro H1; [ right; reflexivity | auto with real ]. Qed. (*********) Lemma Rmin_r : forall x y:R, Rmin x y <= y. Proof. - intros; unfold Rmin in |- *; case (Rle_dec x y); intro H1; + intros; unfold Rmin; case (Rle_dec x y); intro H1; [ assumption | auto with real ]. Qed. @@ -123,20 +123,20 @@ Qed. (*********) Lemma Rmin_pos : forall x y:R, 0 < x -> 0 < y -> 0 < Rmin x y. Proof. - intros; unfold Rmin in |- *. + intros; unfold Rmin. case (Rle_dec x y); intro; assumption. Qed. (*********) Lemma Rmin_glb : forall x y z:R, z <= x -> z <= y -> z <= Rmin x y. Proof. - intros; unfold Rmin in |- *; case (Rle_dec x y); intro; assumption. + intros; unfold Rmin; case (Rle_dec x y); intro; assumption. Qed. (*********) Lemma Rmin_glb_lt : forall x y z:R, z < x -> z < y -> z < Rmin x y. Proof. - intros; unfold Rmin in |- *; case (Rle_dec x y); intro; assumption. + intros; unfold Rmin; case (Rle_dec x y); intro; assumption. Qed. (*******************************) @@ -167,8 +167,8 @@ Qed. Lemma Rmax_Rle : forall r1 r2 r, r <= Rmax r1 r2 <-> r <= r1 \/ r <= r2. 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; + unfold Rmax; case (Rle_dec r1 r2); intros; auto. + intro; unfold Rmax; 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; @@ -177,7 +177,7 @@ Qed. Lemma Rmax_comm : forall x y:R, Rmax x y = Rmax y x. Proof. - intros p q; unfold Rmax in |- *; case (Rle_dec p q); case (Rle_dec q p); auto; + intros p q; unfold Rmax; case (Rle_dec p q); case (Rle_dec q p); auto; intros H1 H2; apply Rle_antisym; auto with real. Qed. @@ -188,14 +188,14 @@ Notation RmaxSym := Rmax_comm (only parsing). (*********) Lemma Rmax_l : forall x y:R, x <= Rmax x y. Proof. - intros; unfold Rmax in |- *; case (Rle_dec x y); intro H1; + intros; unfold Rmax; case (Rle_dec x y); intro H1; [ assumption | auto with real ]. Qed. (*********) Lemma Rmax_r : forall x y:R, y <= Rmax x y. Proof. - intros; unfold Rmax in |- *; case (Rle_dec x y); intro H1; + intros; unfold Rmax; case (Rle_dec x y); intro H1; [ right; reflexivity | auto with real ]. Qed. @@ -232,7 +232,7 @@ Qed. Lemma RmaxRmult : 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 |- *. + intros p q r H; unfold Rmax. 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. @@ -246,7 +246,7 @@ Qed. (*********) Lemma Rmax_stable_in_negreal : forall x y:negreal, Rmax x y < 0. Proof. - intros; unfold Rmax in |- *; case (Rle_dec x y); intro; + intros; unfold Rmax; case (Rle_dec x y); intro; [ apply (cond_neg y) | apply (cond_neg x) ]. Qed. @@ -265,7 +265,7 @@ Qed. (*********) Lemma Rmax_neg : forall x y:R, x < 0 -> y < 0 -> Rmax x y < 0. Proof. - intros; unfold Rmax in |- *. + intros; unfold Rmax. case (Rle_dec x y); intro; assumption. Qed. @@ -278,7 +278,7 @@ Lemma Rcase_abs : forall r, {r < 0} + {r >= 0}. 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). + left; fold (0 > r); apply (Rnot_le_lt 0 r b). Qed. (*********) @@ -291,27 +291,27 @@ Definition Rabs r : R := (*********) Lemma Rabs_R0 : Rabs 0 = 0. Proof. - unfold Rabs in |- *; case (Rcase_abs 0); auto; intro. + unfold Rabs; case (Rcase_abs 0); auto; intro. generalize (Rlt_irrefl 0); intro; exfalso; auto. Qed. Lemma Rabs_R1 : Rabs 1 = 1. Proof. -unfold Rabs in |- *; case (Rcase_abs 1); auto with real. +unfold Rabs; 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. Proof. - intros; unfold Rabs in |- *; case (Rcase_abs r); intro; auto. + intros; unfold Rabs; case (Rcase_abs r); intro; auto. apply Ropp_neq_0_compat; auto. Qed. (*********) Lemma Rabs_left : forall r, r < 0 -> Rabs r = - r. Proof. - intros; unfold Rabs in |- *; case (Rcase_abs r); trivial; intro; + intros; unfold Rabs; case (Rcase_abs r); trivial; intro; absurd (r >= 0). exact (Rlt_not_ge r 0 H). assumption. @@ -320,7 +320,7 @@ Qed. (*********) Lemma Rabs_right : forall r, r >= 0 -> Rabs r = r. Proof. - intros; unfold Rabs in |- *; case (Rcase_abs r); intro. + intros; unfold Rabs; case (Rcase_abs r); intro. absurd (r >= 0). exact (Rlt_not_ge r 0 r0). assumption. @@ -331,21 +331,21 @@ Lemma Rabs_left1 : forall a:R, a <= 0 -> Rabs a = - a. Proof. intros a H; case H; intros H1. apply Rabs_left; auto. - rewrite H1; simpl in |- *; rewrite Rabs_right; auto with real. + rewrite H1; simpl; rewrite Rabs_right; auto with real. Qed. (*********) Lemma Rabs_pos : forall x:R, 0 <= Rabs x. Proof. - intros; unfold Rabs in |- *; case (Rcase_abs x); intro. + intros; unfold Rabs; 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. + rewrite Ropp_0 in H; unfold Rle; left; assumption. apply Rge_le; assumption. Qed. Lemma Rle_abs : forall x:R, x <= Rabs x. Proof. - intro; unfold Rabs in |- *; case (Rcase_abs x); intros; fourier. + intro; unfold Rabs; case (Rcase_abs x); intros; fourier. Qed. Definition RRle_abs := Rle_abs. @@ -353,7 +353,7 @@ Definition RRle_abs := Rle_abs. (*********) Lemma Rabs_pos_eq : forall x:R, 0 <= x -> Rabs x = x. Proof. - intros; unfold Rabs in |- *; case (Rcase_abs x); intro; + intros; unfold Rabs; case (Rcase_abs x); intro; [ generalize (Rgt_not_le 0 x r); intro; exfalso; auto | trivial ]. Qed. @@ -368,7 +368,7 @@ Lemma Rabs_pos_lt : forall x:R, x <> 0 -> 0 < Rabs x. Proof. intros; generalize (Rabs_pos x); intro; unfold Rle in H0; elim H0; intro; auto. - exfalso; clear H0; elim H; clear H; generalize H1; unfold Rabs in |- *; + exfalso; clear H0; elim H; clear H; generalize H1; unfold Rabs; 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); @@ -378,7 +378,7 @@ Qed. (*********) Lemma Rabs_minus_sym : forall x y:R, Rabs (x - y) = Rabs (y - x). Proof. - intros; unfold Rabs in |- *; case (Rcase_abs (x - y)); + intros; unfold Rabs; 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; exfalso; @@ -397,7 +397,7 @@ Qed. (*********) Lemma Rabs_mult : forall x y:R, Rabs (x * y) = Rabs x * Rabs y. Proof. - intros; unfold Rabs in |- *; case (Rcase_abs (x * y)); case (Rcase_abs x); + intros; unfold Rabs; 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); @@ -448,7 +448,7 @@ Qed. (*********) Lemma Rabs_Rinv : forall r, r <> 0 -> Rabs (/ r) = / Rabs r. Proof. - intro; unfold Rabs in |- *; case (Rcase_abs r); case (Rcase_abs (/ r)); auto; + intro; unfold Rabs; 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. @@ -470,7 +470,7 @@ Proof. cut (Rabs (-1) = 1). intros; rewrite H0. ring. - unfold Rabs in |- *; case (Rcase_abs (-1)). + unfold Rabs; case (Rcase_abs (-1)). intro; ring. intro H0; generalize (Rge_le (-1) 0 H0); intros. generalize (Ropp_le_ge_contravar 0 (-1) H1). @@ -483,13 +483,13 @@ Qed. (*********) Lemma Rabs_triang : forall a b:R, Rabs (a + b) <= Rabs a + Rabs b. Proof. - intros a b; unfold Rabs in |- *; case (Rcase_abs (a + b)); case (Rcase_abs a); + intros a b; unfold Rabs; 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. + unfold Rle; 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). @@ -497,7 +497,7 @@ Proof. (**) 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. + unfold Rle; 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). @@ -521,27 +521,27 @@ Proof. (**) 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); + unfold Rminus; 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); + unfold Rminus; 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; right; reflexivity. Qed. (*********) Lemma Rabs_triang_inv : forall a b:R, Rabs a - Rabs b <= Rabs (a - b). 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)); + unfold Rminus; 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))); @@ -561,7 +561,7 @@ Proof. 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; + rewrite Heq; unfold Rminus; 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). @@ -576,8 +576,8 @@ Qed. (*********) Lemma Rabs_def1 : forall x a:R, x < a -> - a < x -> Rabs x < a. Proof. - unfold Rabs in |- *; intros; case (Rcase_abs x); intro. - generalize (Ropp_lt_gt_contravar (- a) x H0); unfold Rgt in |- *; + unfold Rabs; intros; case (Rcase_abs x); intro. + generalize (Ropp_lt_gt_contravar (- a) x H0); unfold Rgt; rewrite Ropp_involutive; intro; assumption. assumption. Qed. @@ -585,15 +585,15 @@ Qed. (*********) Lemma Rabs_def2 : forall x a:R, Rabs x < a -> x < a /\ - a < x. Proof. - unfold Rabs in |- *; intro x; case (Rcase_abs x); intros. - generalize (Ropp_gt_lt_0_contravar x r); unfold Rgt in |- *; intro; + unfold Rabs; intro x; case (Rcase_abs x); intros. + generalize (Ropp_gt_lt_0_contravar x r); unfold Rgt; 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. + unfold Rgt; 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 |- *; + generalize (Ropp_lt_gt_0_contravar a H0); intro; fold (0 > - a); + generalize (Rge_gt_trans x 0 (- a) r H1); unfold Rgt; intro; split; assumption. Qed. @@ -623,16 +623,16 @@ Proof. apply RmaxLess1; auto. Qed. -Lemma Rabs_Zabs : forall z:Z, Rabs (IZR z) = IZR (Zabs z). +Lemma Rabs_Zabs : forall z:Z, Rabs (IZR z) = IZR (Z.abs z). Proof. - intros z; case z; simpl in |- *; auto with real. + intros z; case z; simpl; 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. -Lemma abs_IZR : forall z, IZR (Zabs z) = Rabs (IZR z). +Lemma abs_IZR : forall z, IZR (Z.abs z) = Rabs (IZR z). Proof. intros. now rewrite Rabs_Zabs. diff --git a/theories/Reals/Rcomplete.v b/theories/Reals/Rcomplete.v index 77cb560c..8e0e0692 100644 --- a/theories/Reals/Rcomplete.v +++ b/theories/Reals/Rcomplete.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -11,7 +11,7 @@ Require Import Rfunctions. Require Import Rseries. Require Import SeqProp. Require Import Max. -Open Local Scope R_scope. +Local Open Scope R_scope. (****************************************************) (* R is complete : *) @@ -37,7 +37,7 @@ Proof. intros. exists x. rewrite <- H2 in p0. - unfold Un_cv in |- *. + unfold Un_cv. intros. unfold Un_cv in p; unfold Un_cv in p0. cut (0 < eps / 3). @@ -46,7 +46,7 @@ Proof. elim (p0 (eps / 3) H4); intros. exists (max x1 x2). intros. - unfold R_dist in |- *. + unfold R_dist. 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 ]. @@ -54,14 +54,14 @@ Proof. 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)); + unfold Rminus; 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). + unfold Rminus; 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)). @@ -69,7 +69,7 @@ Proof. 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). + unfold Rminus; 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)). @@ -85,26 +85,26 @@ Proof. repeat apply Rplus_lt_compat. unfold R_dist in H5. apply H5. - unfold ge in |- *; apply le_trans with (max x1 x2). + unfold ge; 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). + unfold ge; 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). + unfold ge; apply le_trans with (max x1 x2). apply le_max_r. assumption. right. - pattern eps at 4 in |- *; replace eps with (3 * (eps / 3)). + pattern eps at 4; 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; + unfold Rdiv; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m; discrR. + unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. apply cond_eq. intros. @@ -130,10 +130,10 @@ Proof. repeat apply Rplus_lt_compat. rewrite <- Rabs_Ropp. replace (- (x - Wn N)) with (Wn N - x); [ apply H4 | ring ]. - unfold ge, N in |- *. + unfold ge, N. apply le_trans with (max N1 N2); apply le_max_l. - unfold Wn, Vn in |- *. - unfold sequence_majorant, sequence_minorant in |- *. + unfold Wn, Vn. + unfold sequence_majorant, sequence_minorant. assert (H7 := approx_maj (fun k:nat => Un (N + k)%nat) (maj_ss Un N (cauchy_maj Un H))). @@ -169,13 +169,13 @@ Proof. [ repeat apply Rplus_lt_compat | ring ]. assumption. apply H6. - unfold ge in |- *. + unfold ge. apply le_trans with N. - unfold N in |- *; apply le_max_r. + unfold N; apply le_max_r. apply le_plus_l. - unfold ge in |- *. + unfold ge. apply le_trans with N. - unfold N in |- *; apply le_max_r. + unfold N; 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); @@ -183,14 +183,14 @@ Proof. reflexivity. reflexivity. apply H5. - unfold ge in |- *; apply le_trans with (max N1 N2). + unfold ge; 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)). + unfold N; apply le_max_l. + pattern eps at 4; replace eps with (5 * (eps / 5)). ring. - unfold Rdiv in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m. + unfold Rdiv; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m. discrR. - unfold Rdiv in |- *; apply Rmult_lt_0_compat. + unfold Rdiv; apply Rmult_lt_0_compat. assumption. apply Rinv_0_lt_compat. prove_sup0; try apply lt_O_Sn. diff --git a/theories/Reals/Rdefinitions.v b/theories/Reals/Rdefinitions.v index 83c6b82d..f7d03ed8 100644 --- a/theories/Reals/Rdefinitions.v +++ b/theories/Reals/Rdefinitions.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -21,7 +21,7 @@ Delimit Scope R_scope with R. (* Automatically open scope R_scope for arguments of type R *) Bind Scope R_scope with R. -Open Local Scope R_scope. +Local Open Scope R_scope. Parameter R0 : R. Parameter R1 : R. diff --git a/theories/Reals/Rderiv.v b/theories/Reals/Rderiv.v index 105d8347..e714f5f8 100644 --- a/theories/Reals/Rderiv.v +++ b/theories/Reals/Rderiv.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -16,7 +16,7 @@ Require Import Rfunctions. Require Import Rlimit. Require Import Fourier. Require Import Omega. -Open Local Scope R_scope. +Local Open Scope R_scope. (*********) Definition D_x (D:R -> Prop) (y x:R) : Prop := D x /\ y <> x. @@ -34,18 +34,18 @@ Lemma cont_deriv : 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 |- *; + unfold continue_in; unfold D_in; unfold limit1_in; + unfold limit_in; unfold Rdiv; simpl; 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; + unfold Rgt; 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; + rewrite H2 in H1; unfold R_dist; 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); @@ -68,7 +68,7 @@ Proof. 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; + unfold Rgt; apply Rinv_0_lt_compat; apply Rabs_pos_lt; apply Rmult_integral_contrapositive; split. discrR. assumption. @@ -80,17 +80,17 @@ Proof. 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; + H1); unfold Rgt; 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; + unfold Rgt; 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 (not_eq_sym H5); clear H5; intro H5; generalize (Rminus_eq_contra x1 x0 H5); intro; generalize H1; - pattern (d x0) at 1 in |- *; + pattern (d x0) at 1; 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 <- (Rinv_l (x1 - x0) H9); unfold R_dist; + unfold Rminus at 1; 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))); @@ -113,7 +113,7 @@ Proof. ; 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 |- *; + fold (f x1 - f x0 - d x0 * (x1 - x0)); rewrite (Rmult_comm (x1 - x0) (d x0)) in H10; clear H1; intro; generalize @@ -123,7 +123,7 @@ Proof. 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 |- *; + Rabs (x1 - x0) * eps) H1); unfold Rminus at 2; 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))) @@ -162,7 +162,7 @@ Proof. (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. + unfold Rabs; case (Rcase_abs 2); auto. intro; cut (0 < 2). intro ; elim (Rlt_asym 0 2 H7 r). fourier. @@ -174,14 +174,14 @@ Qed. Lemma Dconst : 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. + unfold D_in; intros; unfold limit1_in; + unfold limit_in; unfold Rdiv; intros; + simpl; split with eps; split; auto. + intros; rewrite (Rminus_diag_eq y y (eq_refl y)); rewrite Rmult_0_l; + unfold R_dist; rewrite (Rminus_diag_eq 0 0 (eq_refl 0)); + unfold Rabs; case (Rcase_abs 0); intro. absurd (0 < 0); auto. - red in |- *; intro; apply (Rlt_irrefl 0 H1). + red; intro; apply (Rlt_irrefl 0 H1). unfold Rgt in H0; assumption. Qed. @@ -189,15 +189,15 @@ Qed. Lemma Dx : 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; + unfold D_in; unfold Rdiv; intros; unfold limit1_in; + unfold limit_in; intros; simpl; 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. + rewrite (Rinv_r (x - x0) (Rminus_eq_contra x x0 (not_eq_sym H3))); + unfold R_dist; rewrite (Rminus_diag_eq 1 1 (eq_refl 1)); + unfold Rabs; case (Rcase_abs 0); intro. absurd (0 < 0); auto. - red in |- *; intro; apply (Rlt_irrefl 0 r). + red; intro; apply (Rlt_irrefl 0 r). unfold Rgt in H; assumption. Qed. @@ -208,12 +208,12 @@ Lemma Dadd : 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; + unfold D_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); + df x0) (dg x0) x0 H H0); clear H H0; unfold limit1_in; + unfold limit_in; simpl; 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; @@ -233,8 +233,8 @@ Lemma Dmult : 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 |- *; + intros; unfold D_in; generalize H H0; intros; unfold D_in in H, H0; + generalize (cont_deriv f df D x0 H1); unfold continue_in; intro; generalize (limit_mul (fun x:R => (g x - g x0) * / (x - x0)) ( @@ -250,8 +250,8 @@ Proof. (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; + simpl in H; unfold limit1_in; unfold limit_in; + simpl; 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; @@ -268,9 +268,9 @@ Proof. ((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; + unfold limit1_in; unfold limit_in; simpl; 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; + intros a b; rewrite (b (eq_refl (g x0))); unfold Rgt in H; assumption. Qed. @@ -281,7 +281,7 @@ Lemma Dmult_const : 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; + unfold D_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. @@ -291,10 +291,10 @@ 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. 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 (Dmult_const D f df x0 (-1) H); unfold D_in; + unfold limit1_in; unfold limit_in; intros; generalize (H0 eps H1); clear H0; intro; elim H0; - clear H0; intros; elim H0; clear H0; simpl in |- *; + clear H0; intros; elim H0; clear H0; simpl; intros; split with x; split; auto. intros; generalize (H2 x1 H3); clear H2; intro; rewrite Ropp_mult_distr_l_reverse in H2; @@ -313,7 +313,7 @@ Lemma Dminus : 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; + unfold Rminus; 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. @@ -324,14 +324,14 @@ Lemma Dx_pow_n : 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. + simpl; 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 ]. + [ intro a; rewrite <- a; clear a | simpl; 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); + H D x0)); unfold D_in; unfold limit1_in; + unfold limit_in; simpl; 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; @@ -340,7 +340,7 @@ Proof. 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 (Peano_dec.eq_nat_dec n0 0) ; intros cond. - rewrite cond in H2; rewrite cond; simpl in H2; simpl in |- *; + rewrite cond in H2; rewrite cond; simpl in H2; simpl; 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 ]; @@ -355,8 +355,8 @@ Lemma Dcomp : 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; + intros Df Dg df dg f g x0 H H0; generalize H H0; unfold D_in; + unfold Rdiv; 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); @@ -376,8 +376,8 @@ Proof. (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; + intro; unfold limit1_in; unfold limit_in; + simpl; 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. @@ -391,7 +391,7 @@ Proof. 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 (Rminus_diag_eq (g (f x0)) (g (f x0)) (eq_refl (g (f x0)))); rewrite (Rmult_0_l (/ (x2 - x0))); assumption. clear H10 H5; elim H11; clear H11; intros; elim H5; clear H5; intros; cut @@ -405,8 +405,8 @@ Proof. 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; + clear H5 H3 H4 H2; unfold limit1_in; unfold limit_in; + simpl; 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; @@ -425,8 +425,8 @@ Proof. 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; + intro; unfold D_in; unfold limit1_in; + unfold limit_in; simpl; 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. diff --git a/theories/Reals/Reals.v b/theories/Reals/Reals.v index a15e9949..03bf534d 100644 --- a/theories/Reals/Reals.v +++ b/theories/Reals/Reals.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Rfunctions.v b/theories/Reals/Rfunctions.v index c0cd7864..4724d0e5 100644 --- a/theories/Reals/Rfunctions.v +++ b/theories/Reals/Rfunctions.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -25,8 +25,8 @@ Require Export SplitRmult. Require Export ArithProp. Require Import Omega. Require Import Zpower. -Open Local Scope nat_scope. -Open Local Scope R_scope. +Local Open Scope nat_scope. +Local Open Scope R_scope. (*******************************) (** * Lemmas about factorial *) @@ -82,6 +82,15 @@ Proof. intros n0 H' m; rewrite H'; auto with real. Qed. +Lemma Rpow_mult_distr : forall (x y:R) (n:nat), (x * y) ^ n = x^n * y^n. +Proof. +intros x y n ; induction n. + field. + simpl. + repeat (rewrite Rmult_assoc) ; apply Rmult_eq_compat_l. + rewrite IHn ; field. +Qed. + Lemma pow_nonzero : forall (x:R) (n:nat), x <> 0 -> x ^ n <> 0. Proof. intro; simple induction n; simpl. @@ -212,8 +221,8 @@ Qed. Lemma RPow_abs : forall (x:R) (n:nat), Rabs x ^ n = Rabs (x ^ n). Proof. intro; simple induction n; simpl. - apply sym_eq; apply Rabs_pos_eq; apply Rlt_le; apply Rlt_0_1. - intros; rewrite H; apply sym_eq; apply Rabs_mult. + symmetry; apply Rabs_pos_eq; apply Rlt_le; apply Rlt_0_1. + intros; rewrite H; symmetry; apply Rabs_mult. Qed. @@ -517,16 +526,16 @@ Qed. (*i Due to L.Thery i*) Ltac case_eq name := - generalize (refl_equal name); pattern name at -1; case name. + generalize (eq_refl name); pattern name at -1; case 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 + | Zpos p => x ^ Pos.to_nat p + | Zneg p => / x ^ Pos.to_nat p end. -Infix Local "^Z" := powerRZ (at level 30, right associativity) : R_scope. +Local Infix "^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. @@ -539,7 +548,7 @@ Proof. reflexivity. Qed. -Lemma powerRZ_1 : forall x:R, x ^Z Zsucc 0 = x. +Lemma powerRZ_1 : forall x:R, x ^Z Z.succ 0 = x. Proof. simpl; auto with real. Qed. @@ -549,67 +558,63 @@ Proof. destruct z; simpl; auto with real. Qed. +Lemma powerRZ_pos_sub (x:R) (n m:positive) : x <> 0 -> + x ^Z (Z.pos_sub n m) = x ^ Pos.to_nat n * / x ^ Pos.to_nat m. +Proof. + intro Hx. + rewrite Z.pos_sub_spec. + case Pos.compare_spec; intro H; simpl. + - subst; auto with real. + - rewrite Pos2Nat.inj_sub by trivial. + rewrite Pos2Nat.inj_lt in H. + rewrite (pow_RN_plus x _ (Pos.to_nat n)) by auto with real. + rewrite plus_comm, le_plus_minus_r by auto with real. + rewrite Rinv_mult_distr, Rinv_involutive; auto with real. + - rewrite Pos2Nat.inj_sub by trivial. + rewrite Pos2Nat.inj_lt in H. + rewrite (pow_RN_plus x _ (Pos.to_nat m)) by auto with real. + rewrite plus_comm, le_plus_minus_r by auto with real. + reflexivity. +Qed. + Lemma powerRZ_add : 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; - auto with real. -(* POS/POS *) - rewrite Pplus_plus; auto with real. -(* POS/NEG *) - rewrite Z.pos_sub_spec. - case Pcompare_spec; intros; simpl. - subst; auto with real. - rewrite Pminus_minus by trivial. - rewrite (pow_RN_plus x _ (nat_of_P n1)) by auto with real. - rewrite plus_comm, le_plus_minus_r by (now apply lt_le_weak, Plt_lt). - rewrite Rinv_mult_distr, Rinv_involutive; auto with real. - rewrite Pminus_minus by trivial. - rewrite (pow_RN_plus x _ (nat_of_P m1)) by auto with real. - rewrite plus_comm, le_plus_minus_r by (now apply lt_le_weak, Plt_lt). - reflexivity. -(* NEG/POS *) - rewrite Z.pos_sub_spec. - case Pcompare_spec; intros; simpl. - subst; auto with real. - rewrite Pminus_minus by trivial. - rewrite (pow_RN_plus x _ (nat_of_P m1)) by auto with real. - rewrite plus_comm, le_plus_minus_r by (now apply lt_le_weak, Plt_lt). - rewrite Rinv_mult_distr, Rinv_involutive; auto with real. - rewrite Pminus_minus by trivial. - rewrite (pow_RN_plus x _ (nat_of_P n1)) by auto with real. - rewrite plus_comm, le_plus_minus_r by (now apply lt_le_weak, Plt_lt). - auto with real. -(* NEG/NEG *) - rewrite Pplus_plus; auto with real. - intros H'; rewrite pow_add; auto with real. - apply Rinv_mult_distr; auto. - apply pow_nonzero; auto. - apply pow_nonzero; auto. + intros x [|n|n] [|m|m]; simpl; intros; auto with real. + - (* + + *) + rewrite Pos2Nat.inj_add; auto with real. + - (* + - *) + now apply powerRZ_pos_sub. + - (* - + *) + rewrite Rmult_comm. now apply powerRZ_pos_sub. + - (* - - *) + rewrite Pos2Nat.inj_add; auto with real. + rewrite pow_add; auto with real. + apply Rinv_mult_distr; 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. + 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; auto with real. - intros m1 H'; rewrite nat_of_P_of_succ_nat; simpl. - replace (Zpower_nat (Z_of_nat n) (S m1)) with - (Z_of_nat n * Zpower_nat (Z_of_nat n) m1)%Z. + intros m1 H'; rewrite SuccNat2Pos.id_succ; simpl. + 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. rewrite H'; simpl. case m1; simpl; auto with real. - intros m2; rewrite nat_of_P_of_succ_nat; auto. + intros m2; rewrite SuccNat2Pos.id_succ; auto. unfold Zpower_nat; auto. Qed. Lemma Zpower_pos_powerRZ : - forall n m, IZR (Zpower_pos n m) = IZR n ^Z Zpos m. + forall n m, IZR (Z.pow_pos n m) = IZR n ^Z Zpos m. Proof. intros. rewrite Zpower_pos_nat; simpl. - induction (nat_of_P m). + induction (Pos.to_nat m). easy. unfold Zpower_nat; simpl. rewrite mult_IZR. @@ -629,10 +634,10 @@ 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 (Z.abs_nat m)) = IZR n ^Z m. Proof. intros n m; case m; simpl; auto with zarith. - intros p H'; elim (nat_of_P p); simpl; auto with zarith. + intros p H'; elim (Pos.to_nat p); simpl; auto with zarith. intros n0 H'0; rewrite <- H'0; simpl; auto with zarith. rewrite <- mult_IZR; auto. intros p H'; absurd (0 <= Zneg p)%Z; auto with zarith. @@ -641,9 +646,9 @@ Qed. Lemma powerRZ_R1 : forall n:Z, 1 ^Z n = 1. Proof. intros n; case n; simpl; auto. - intros p; elim (nat_of_P p); simpl; auto; intros n0 H'; rewrite H'; + intros p; elim (Pos.to_nat p); simpl; auto; intros n0 H'; rewrite H'; ring. - intros p; elim (nat_of_P p); simpl. + intros p; elim (Pos.to_nat p); simpl. exact Rinv_1. intros n1 H'; rewrite Rinv_mult_distr; try rewrite Rinv_1; try rewrite H'; auto with real. @@ -751,9 +756,9 @@ Qed. Lemma R_dist_refl : forall x y:R, R_dist x y = 0 <-> x = y. Proof. unfold R_dist; intros; split_Rabs; split; intros. - rewrite (Ropp_minus_distr x y) in H; apply sym_eq; + rewrite (Ropp_minus_distr x y) in H; symmetry; apply (Rminus_diag_uniq y x H). - rewrite (Ropp_minus_distr x y); generalize (sym_eq H); intro; + rewrite (Ropp_minus_distr x y); generalize (eq_sym H); intro; apply (Rminus_diag_eq y x H0). apply (Rminus_diag_uniq x y H). apply (Rminus_diag_eq x y H). diff --git a/theories/Reals/Rgeom.v b/theories/Reals/Rgeom.v index bda64e77..ffa11608 100644 --- a/theories/Reals/Rgeom.v +++ b/theories/Reals/Rgeom.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -9,9 +9,9 @@ Require Import Rbase. Require Import Rfunctions. Require Import SeqSeries. -Require Import Rtrigo. +Require Import Rtrigo1. Require Import R_sqrt. -Open Local Scope R_scope. +Local Open Scope R_scope. (** * Distance *) @@ -20,23 +20,23 @@ Definition dist_euc (x0 y0 x1 y1:R) : R := Lemma distance_refl : forall x0 y0:R, dist_euc x0 y0 x0 y0 = 0. Proof. - intros x0 y0; unfold dist_euc in |- *; apply Rsqr_inj; + intros x0 y0; unfold dist_euc; 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 + [ unfold Rsqr; 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. Proof. - intros x0 y0 x1 y1; unfold dist_euc in |- *; apply Rsqr_inj; + intros x0 y0 x1 y1; unfold dist_euc; 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 + [ unfold Rsqr; ring | apply Rplus_le_le_0_compat | apply Rplus_le_le_0_compat ] ]; apply Rle_0_sqr. Qed. @@ -49,8 +49,8 @@ Lemma law_cosines : 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 + unfold dist_euc; intros; repeat rewrite Rsqr_sqrt; + [ rewrite H; unfold Rsqr; ring | apply Rplus_le_le_0_compat | apply Rplus_le_le_0_compat | apply Rplus_le_le_0_compat ]; apply Rle_0_sqr. @@ -60,7 +60,7 @@ 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. Proof. - intros; unfold dist_euc in |- *; apply Rsqr_incr_0; + intros; unfold dist_euc; 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)); @@ -112,7 +112,7 @@ Definition yt (y ty:R) : R := y + ty. Lemma translation_0 : forall x y:R, xt x 0 = x /\ yt y 0 = y. Proof. - intros x y; split; [ unfold xt in |- * | unfold yt in |- * ]; ring. + intros x y; split; [ unfold xt | unfold yt ]; ring. Qed. Lemma isometric_translation : @@ -120,7 +120,7 @@ Lemma isometric_translation : 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. + intros; unfold Rsqr, xt, yt; ring. Qed. (******************************************************************) @@ -132,13 +132,13 @@ 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. Proof. - intros x y; unfold xr, yr in |- *; split; rewrite cos_0; rewrite sin_0; ring. + intros x y; unfold xr, yr; 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. Proof. - intros x y; unfold xr, yr in |- *; split; rewrite cos_PI2; rewrite sin_PI2; + intros x y; unfold xr, yr; split; rewrite cos_PI2; rewrite sin_PI2; ring. Qed. @@ -148,7 +148,7 @@ Lemma isometric_rotation_0 : Rsqr (xr x1 y1 theta - xr x2 y2 theta) + Rsqr (yr x1 y1 theta - yr x2 y2 theta). Proof. - intros; unfold xr, yr in |- *; + intros; unfold xr, yr; replace (x1 * cos theta + y1 * sin theta - (x2 * cos theta + y2 * sin theta)) with (cos theta * (x1 - x2) + sin theta * (y1 - y2)); @@ -168,7 +168,7 @@ Lemma isometric_rotation : 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; + unfold dist_euc; 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; diff --git a/theories/Reals/RiemannInt.v b/theories/Reals/RiemannInt.v index 8acfd75b..0a00ca22 100644 --- a/theories/Reals/RiemannInt.v +++ b/theories/Reals/RiemannInt.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -9,13 +9,13 @@ Require Import Rfunctions. Require Import SeqSeries. -Require Import Ranalysis. +Require Import Ranalysis_reg. Require Import Rbase. Require Import RiemannInt_SF. Require Import Classical_Prop. Require Import Classical_Pred_Type. Require Import Max. -Open Local Scope R_scope. +Local Open Scope R_scope. Set Implicit Arguments. @@ -51,19 +51,19 @@ Lemma RiemannInt_P1 : 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; + unfold Riemann_integrable; intros; elim (X eps); clear X; intros; elim p; clear p; intros; exists (mkStepFun (StepFun_P6 (pre x))); exists (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 |- * + unfold Rmin | apply Rle_trans with (Rmax b a); try assumption; right; - unfold Rmax in |- * ]; + unfold Rmax ]; (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); + generalize H0; unfold RiemannInt_SF; case (Rle_dec a b); case (Rle_dec b a); intros; (replace (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre x0)))) @@ -89,11 +89,11 @@ Lemma RiemannInt_P2 : Rabs (RiemannInt_SF (wn n)) < un n) -> { 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; apply R_complete; unfold Un_cv in H; unfold Cauchy_crit; intros; assert (H3 : 0 < eps / 2). - unfold Rdiv in |- *; apply Rmult_lt_0_compat; + unfold Rdiv; 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 |- *; + elim (H _ H3); intros N0 H4; exists N0; intros; unfold R_dist; 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)); @@ -105,15 +105,15 @@ Proof. apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 1 (wn n) (wn m)))). apply StepFun_P37; try assumption. - intros; simpl in |- *; + intros; simpl; 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; + unfold Rmin; 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; + unfold Rmax; 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. @@ -156,14 +156,14 @@ Proof. 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 |- * + unfold Rmin | apply Rle_trans with (Rmax b a); try assumption; right; - unfold Rmax in |- * ]; + unfold Rmax ]; (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; + generalize H3; unfold RiemannInt_SF; case (Rle_dec a b); + case (Rle_dec b a); unfold wn'; intros; (replace (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre (wn n0))))) (subdivision (mkStepFun (StepFun_P6 (pre (wn n0)))))) with @@ -178,19 +178,19 @@ Proof. rewrite Rabs_Ropp in H4; apply H4. apply H4. assert (H3 := RiemannInt_P2 _ _ _ _ H H1 H2); elim H3; intros; - exists (- x); unfold Un_cv in |- *; unfold Un_cv in p; + exists (- x); unfold Un_cv; unfold Un_cv in p; intros; elim (p _ H4); intros; exists x0; intros; - generalize (H5 _ H6); unfold R_dist, RiemannInt_SF in |- *; + generalize (H5 _ H6); unfold R_dist, RiemannInt_SF; 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; + [ unfold Rminus; 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; + | symmetry ; apply StepFun_P17 with (fe (vn n0)) a b; [ apply StepFun_P1 | apply StepFun_P2; apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre (vn n0))))) ] ]. @@ -218,9 +218,9 @@ Lemma RiemannInt_P4 : 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; + unfold Un_cv; unfold R_dist; intros f; intros; assert (H3 : 0 < eps / 3). - unfold Rdiv in |- *; apply Rmult_lt_0_compat; + unfold Rdiv; 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); @@ -255,7 +255,7 @@ Proof. 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 StepFun_P37; try assumption; intros; simpl; 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)). @@ -263,10 +263,10 @@ Proof. (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; + unfold Rmin; 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; + unfold Rmax; 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. @@ -279,20 +279,20 @@ Proof. 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 H; unfold ge; apply le_trans with N; try assumption; + unfold N; apply le_trans with (max N0 N1); apply le_max_l - | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; + | unfold Rminus; 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 H0; unfold ge; apply le_trans with N; try assumption; + unfold N; 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; + | unfold Rminus; 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 @@ -311,7 +311,7 @@ Proof. (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; + intros; simpl; 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)). @@ -319,10 +319,10 @@ Proof. (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; + unfold Rmin; 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; + unfold Rmax; 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. @@ -341,10 +341,10 @@ Proof. 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 H0; unfold ge; apply le_trans with N; try assumption; + unfold N; 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; + | unfold R_dist; unfold Rminus; 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)). @@ -352,15 +352,15 @@ Proof. 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 H; unfold ge; apply le_trans with N; try assumption; + unfold N; apply le_trans with (max N0 N1); apply le_max_l - | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; + | unfold Rminus; 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 H1; unfold ge; apply le_trans with N; try assumption; + unfold N; apply le_max_r. apply Rmult_eq_reg_l with 3; - [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l; + [ unfold Rdiv; rewrite Rmult_plus_distr_l; do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ ring | discrR ] | discrR ]. @@ -376,17 +376,17 @@ Definition RinvN (N:nat) : posreal := mkposreal _ (RinvN_pos N). Lemma RinvN_cv : Un_cv RinvN 0. Proof. - unfold Un_cv in |- *; intros; assert (H0 := archimed (/ eps)); elim H0; + unfold Un_cv; 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; + elim (IZN _ H2); intros; exists x; intros; unfold R_dist; + simpl; unfold Rminus; 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; + | left; change (0 < / (INR n + 1)); 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 ]. @@ -400,9 +400,9 @@ Proof. 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; + | pattern (INR x) at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; apply Rlt_0_1 ]. - red in |- *; intro; rewrite H6 in H; elim (Rlt_irrefl _ H). + red; intro; rewrite H6 in H; elim (Rlt_irrefl _ H). Qed. (**********) @@ -413,7 +413,7 @@ Lemma RiemannInt_P5 : forall (f:R -> R) (a b:R) (pr1 pr2:Riemann_integrable f a b), RiemannInt pr1 = RiemannInt pr2. Proof. - intros; unfold RiemannInt in |- *; + intros; unfold RiemannInt; case (RiemannInt_exists pr1 RinvN RinvN_cv); case (RiemannInt_exists pr2 RinvN RinvN_cv); intros; eapply UL_sequence; @@ -431,7 +431,7 @@ Lemma maxN : 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; + exists 0%nat; unfold I; 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; @@ -440,27 +440,27 @@ Proof. 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. + right; symmetry ; assumption. left; apply r. assert (H1 : 0 <= (b - a) / del). - unfold Rdiv in |- *; apply Rmult_le_pos; + unfold Rdiv; 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); + apply le_IZR; simpl; 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; + unfold Nbound; 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)); + | unfold Rdiv; 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; + | assert (H7 := cond_pos del); red; intro; rewrite H8 in H7; elim (Rlt_irrefl _ H7) ] ]. Qed. @@ -496,15 +496,15 @@ Proof. 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 bound; exists (b - a); unfold is_upper_bound; 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 |- *; + elim H2; intros; exists (Rmin x (b - a)); unfold E; split; [ split; - [ unfold Rmin in |- *; case (Rle_dec x (b - a)); intro; + [ unfold Rmin; 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)); @@ -519,7 +519,7 @@ Proof. 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); + unfold is_upper_bound; intros; assert (H14 := H12 x1); elim (not_and_or (D < x1) (E x1) H14); intro. case (Rle_dec x1 D); intro. assumption. @@ -551,7 +551,7 @@ Proof. exists (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; + | rewrite H3; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply (cond_pos eps) ]. exists (mkposreal _ Rlt_0_1); intros; elim H0; intros; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H3 H4) r)). @@ -560,14 +560,14 @@ Qed. Lemma SubEqui_P1 : 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. + intros; unfold SubEqui; 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. Proof. - intros; unfold SubEqui in |- *; case (maxN del h); intros; clear a0; + intros; unfold SubEqui; case (maxN del h); intros; clear a0; cut (forall (x:nat) (a:R) (del:posreal), pos_Rl (SubEquiN (S x) a b del) @@ -579,14 +579,14 @@ Proof. change (pos_Rl (SubEquiN (S n) (a0 + del0) b del0) (pred (Rlength (SubEquiN (S n) (a0 + del0) b del0))) = b) - in |- *; apply H ] ]. + ; apply H ] ]. Qed. Lemma SubEqui_P3 : 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 ]. + [ reflexivity | simpl; rewrite H; reflexivity ]. Qed. Lemma SubEqui_P4 : @@ -594,36 +594,36 @@ Lemma SubEqui_P4 : (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; inversion H; [ simpl; ring | elim (le_Sn_O _ H1) ] | intros; induction i as [| i Hreci]; - [ simpl in |- *; ring + [ simpl; 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 ] ] ]. + ; 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)). Proof. - intros; unfold SubEqui in |- *; apply SubEqui_P3. + intros; unfold SubEqui; 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. Proof. - intros; unfold SubEqui in |- *; apply SubEqui_P4; assumption. + intros; unfold SubEqui; apply SubEqui_P4; assumption. Qed. Lemma SubEqui_P7 : 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; + intros; unfold ordered_Rlist; 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; + rewrite SubEqui_P2; unfold max_N; case (maxN del h); intros; left; elim a0; intros; assumption. rewrite SubEqui_P5; reflexivity. apply lt_n_Sn. @@ -631,7 +631,7 @@ Proof. 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; + pattern (INR i * del) at 1; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; rewrite Rmult_1_l; left; apply (cond_pos del). Qed. @@ -641,11 +641,11 @@ Lemma SubEqui_P8 : (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. + pattern a at 1; 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; + pattern b at 2; 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 ] ]. @@ -671,42 +671,42 @@ Lemma RiemannInt_P6 : a < b -> (forall x:R, a <= x <= b -> continuity_pt f x) -> Riemann_integrable f a b. Proof. - intros; unfold Riemann_integrable in |- *; intro; + intros; unfold Riemann_integrable; intro; assert (H1 : 0 < eps / (2 * (b - a))). - unfold Rdiv in |- *; apply Rmult_lt_0_compat; + unfold Rdiv; 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; + unfold Rmin; 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; + unfold Rmax; 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: rewrite StepFun_P18; unfold Rdiv; 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; 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: apply Rminus_eq_contra; red; 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: apply Rminus_eq_contra; red; 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 |- *; + intros; rewrite H2 in H7; rewrite H3 in H7; simpl; + unfold fct_cte; cut (forall t:R, a <= t <= b -> @@ -716,14 +716,14 @@ Proof. 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 H9; rewrite H5; unfold Rminus; 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; + apply lt_pred_n_n; apply neq_O_lt; red; 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. @@ -738,7 +738,7 @@ Proof. 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; + unfold max_N; 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); @@ -755,10 +755,10 @@ Proof. 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; + exists 0%nat; unfold I; 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 |- *; + unfold Nbound; exists (S (max_N del H)); intros; unfold max_N; 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). @@ -767,7 +767,7 @@ Proof. 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; + unfold max_N; 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); @@ -778,8 +778,8 @@ Proof. assumption. elim H0; assumption. exists N; split. - rewrite SubEqui_P5; simpl in |- *; assumption. - unfold co_interval in |- *; split. + rewrite SubEqui_P5; simpl; assumption. + unfold co_interval; split. rewrite SubEqui_P6. apply H5. assumption. @@ -799,13 +799,13 @@ Qed. Lemma RiemannInt_P7 : forall (f:R -> R) (a:R), Riemann_integrable f a a. Proof. - unfold Riemann_integrable in |- *; intro f; intros; + unfold Riemann_integrable; 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; + intros; simpl; unfold fct_cte; replace t with a. + unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; right; reflexivity. - generalize H; unfold Rmin, Rmax in |- *; case (Rle_dec a a); intros; elim H0; + generalize H; unfold Rmin, Rmax; 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. @@ -826,9 +826,9 @@ Lemma RiemannInt_P8 : (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); + unfold RiemannInt; case (RiemannInt_exists pr1 RinvN RinvN_cv); intros; apply u. - unfold RiemannInt in |- *; case (RiemannInt_exists pr2 RinvN RinvN_cv); + unfold RiemannInt; case (RiemannInt_exists pr2 RinvN RinvN_cv); intros; cut (exists psi1 : nat -> StepFun a b, @@ -845,9 +845,9 @@ Proof. 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 (H1 := RinvN_cv); unfold Un_cv; intros; assert (H3 : 0 < eps / 3). - unfold Rdiv in |- *; apply Rmult_lt_0_compat; + unfold Rdiv; 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; @@ -855,10 +855,10 @@ Proof. 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; + | unfold Rminus; 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 |- *; + exists (max N0 N1); intros; unfold R_dist; apply Rle_lt_trans with (Rabs (RiemannInt_SF (phi_sequence RinvN pr1 n) + @@ -895,7 +895,7 @@ Proof. (mkStepFun (StepFun_P28 1 (psi1 n) (mkStepFun (StepFun_P6 (pre (psi2 n))))))). apply StepFun_P37; try assumption. - intros; simpl in |- *; rewrite Rmult_1_l; + intros; simpl; 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)). @@ -903,10 +903,10 @@ Proof. (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; + unfold Rmin; 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; + unfold Rmax; 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; @@ -919,7 +919,7 @@ Proof. [ apply RRle_abs | apply Rlt_trans with (pos (RinvN n)); [ assumption - | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1); + | apply H4; unfold ge; apply le_trans with (max N0 N1); [ apply le_max_l | assumption ] ] ]. elim (H n); intros; rewrite <- @@ -929,7 +929,7 @@ Proof. [ 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 H4; unfold ge; apply le_trans with (max N0 N1); [ apply le_max_l | assumption ] ] ]. assert (Hyp : b <= a). auto with real. @@ -948,7 +948,7 @@ Proof. (mkStepFun (StepFun_P28 1 (mkStepFun (StepFun_P6 (pre (psi1 n)))) (psi2 n)))). apply StepFun_P37; try assumption. - intros; simpl in |- *; rewrite Rmult_1_l; + intros; simpl; 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)). @@ -956,10 +956,10 @@ Proof. (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; + unfold Rmin; 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; + unfold Rmax; 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; @@ -976,18 +976,18 @@ Proof. [ 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 H4; unfold ge; 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 H4; unfold ge; apply le_trans with (max N0 N1); [ apply le_max_l | assumption ] ] ]. - unfold R_dist in H1; apply H1; unfold ge in |- *; + unfold R_dist in H1; apply H1; unfold ge; 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; + [ unfold Rdiv; rewrite Rmult_plus_distr_l; do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ ring | discrR ] | discrR ]. @@ -1002,7 +1002,7 @@ Lemma RiemannInt_P9 : 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 Rmult_0_r; rewrite double; pattern (RiemannInt pr) at 2; rewrite H; apply Rplus_opp_r | discrR ]. Qed. @@ -1011,9 +1011,9 @@ Lemma Req_EM_T : forall r1 r2:R, {r1 = r2} + {r1 <> r2}. 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) + [ right; red; 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) ]. + | right; red; intro; rewrite H in b; elim (Rlt_irrefl r2 b) ]. Qed. (* L1([a,b]) is a vectorial space *) @@ -1023,16 +1023,16 @@ Lemma RiemannInt_P10 : 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); + unfold Riemann_integrable; 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; + unfold Rdiv; 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; + unfold Rdiv; 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 ] ]. @@ -1040,7 +1040,7 @@ Proof. 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 |- *; + intros; simpl; 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 ]. @@ -1060,7 +1060,7 @@ Proof. [ rewrite Rmult_1_l; replace (/ Rabs l * (eps / 2)) with (eps / (2 * Rabs l)); [ apply H2 - | unfold Rdiv in |- *; rewrite Rinv_mult_distr; + | unfold Rdiv; rewrite Rinv_mult_distr; [ ring | discrR | apply Rabs_no_R0; assumption ] ] | apply Rabs_no_R0; assumption ]. Qed. @@ -1080,14 +1080,14 @@ Lemma RiemannInt_P11 : 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. + unfold Un_cv; intro f; intros; intros. case (Rle_dec a b); intro Hyp. assert (H4 : 0 < eps / 3). - unfold Rdiv in |- *; apply Rmult_lt_0_compat; + unfold Rdiv; 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 |- *. + set (N := max N0 N1); exists N; intros; unfold R_dist. apply Rle_lt_trans with (Rabs (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) + Rabs (RiemannInt_SF (phi1 n) - l)). @@ -1106,24 +1106,24 @@ Proof. 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 StepFun_P37; try assumption; intros; simpl; 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; + unfold Rmin; 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; + unfold Rmax; 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; + unfold Rmin; 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; + unfold Rmax; 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. @@ -1132,9 +1132,9 @@ Proof. 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; + apply H; unfold ge; apply le_trans with N; try assumption. + unfold N; apply le_max_l. + unfold R_dist; unfold Rminus; 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)). @@ -1142,24 +1142,24 @@ Proof. 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; + apply H; unfold ge; apply le_trans with N; try assumption; + unfold N; apply le_max_l. + unfold R_dist; unfold Rminus; 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. + unfold R_dist in H2; apply H2; unfold ge; apply le_trans with N; + try assumption; unfold N; apply le_max_r. apply Rmult_eq_reg_l with 3; - [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l; + [ unfold Rdiv; 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; + unfold Rdiv; 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 |- *. + set (N := max N0 N1); exists N; intros; unfold R_dist. apply Rle_lt_trans with (Rabs (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) + Rabs (RiemannInt_SF (phi1 n) - l)). @@ -1189,24 +1189,24 @@ Proof. (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 (psi1 n) (psi2 n))))))). apply StepFun_P37; try assumption. - intros; simpl in |- *; rewrite Rmult_1_l. + intros; simpl; 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; + unfold Rmin; 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; + unfold Rmax; 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; + unfold Rmin; 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; + unfold Rmax; case (Rle_dec a b); intro; [ elim Hyp; assumption | reflexivity ]. rewrite H10; rewrite H11; elim H6; intros; split; left; assumption. rewrite <- @@ -1224,9 +1224,9 @@ Proof. 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; + apply H; unfold ge; apply le_trans with N; try assumption. + unfold N; apply le_max_l. + unfold R_dist; unfold Rminus; 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)). @@ -1234,15 +1234,15 @@ Proof. 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; + apply H; unfold ge; apply le_trans with N; try assumption; + unfold N; apply le_max_l. + unfold R_dist; unfold Rminus; 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. + unfold R_dist in H2; apply H2; unfold ge; apply le_trans with N; + try assumption; unfold N; apply le_max_r. apply Rmult_eq_reg_l with 3; - [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l; + [ unfold Rdiv; rewrite Rmult_plus_distr_l; do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ ring | discrR ] | discrR ]. @@ -1255,8 +1255,8 @@ Lemma RiemannInt_P12 : 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); + pattern l at 2; rewrite H0; rewrite Rmult_0_l; rewrite Rplus_0_r; + unfold RiemannInt; case (RiemannInt_exists pr3 RinvN RinvN_cv); case (RiemannInt_exists pr1 RinvN RinvN_cv); intros; eapply UL_sequence; [ apply u0 @@ -1278,18 +1278,18 @@ Proof. [ apply H2; assumption | rewrite H0; ring ] ] | assumption ] ]. eapply UL_sequence. - unfold RiemannInt in |- *; case (RiemannInt_exists pr3 RinvN RinvN_cv); + unfold RiemannInt; case (RiemannInt_exists pr3 RinvN RinvN_cv); intros; apply u. - unfold Un_cv in |- *; intros; unfold RiemannInt in |- *; + unfold Un_cv; intros; unfold RiemannInt; case (RiemannInt_exists pr1 RinvN RinvN_cv); - case (RiemannInt_exists pr2 RinvN RinvN_cv); unfold Un_cv in |- *; + case (RiemannInt_exists pr2 RinvN RinvN_cv); unfold Un_cv; intros; assert (H2 : 0 < eps / 5). - unfold Rdiv in |- *; apply Rmult_lt_0_compat; + unfold Rdiv; 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; + unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; [ prove_sup0 | apply Rabs_pos_lt; assumption ] ]. @@ -1298,17 +1298,17 @@ Proof. 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; + [ unfold RinvN; apply H4; assumption + | unfold Rminus; 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; + [ unfold RinvN; apply H5; assumption + | unfold Rminus; 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 |- *. + unfold R_dist. apply Rle_lt_trans with (Rabs (RiemannInt_SF (phi_sequence RinvN pr3 n) - @@ -1381,10 +1381,10 @@ Proof. (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; + unfold Rmin; 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; + unfold Rmax; 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; @@ -1404,7 +1404,7 @@ Proof. (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. + intros; simpl; rewrite Rmult_1_l. apply Rle_trans with (Rabs (phi_sequence RinvN pr3 n x1 - (f x1 + l * g x1)) + Rabs @@ -1444,16 +1444,16 @@ Proof. 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 H4; unfold ge; apply le_trans with N; [ apply le_trans with (max N0 N1); - [ apply le_max_r | unfold N in |- *; apply le_max_l ] + [ apply le_max_r | unfold N; 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 H4; unfold ge; apply le_trans with N; [ apply le_trans with (max N0 N1); - [ apply le_max_r | unfold N in |- *; apply le_max_l ] + [ apply le_max_r | unfold N; apply le_max_l ] | assumption ] ]. apply Rmult_lt_reg_l with (/ Rabs l). apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. @@ -1462,28 +1462,28 @@ Proof. 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 H5; unfold ge; apply le_trans with N; [ apply le_trans with (max N2 N3); - [ apply le_max_r | unfold N in |- *; apply le_max_r ] + [ apply le_max_r | unfold N; apply le_max_r ] | assumption ] ]. - unfold Rdiv in |- *; rewrite Rinv_mult_distr; + unfold Rdiv; 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 H3; unfold ge; 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 le_trans with N; [ unfold N; 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 H6; unfold ge; 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; + | apply le_trans with N; [ unfold N; apply le_max_r | assumption ] ]. + unfold Rdiv; 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; + [ unfold Rdiv; do 2 rewrite Rmult_plus_distr_l; do 3 rewrite (Rmult_comm 5); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ ring | discrR ] | discrR ]. @@ -1500,11 +1500,11 @@ Proof. | assert (H : b <= a); [ auto with real | replace (RiemannInt pr3) with (- RiemannInt (RiemannInt_P1 pr3)); - [ idtac | symmetry in |- *; apply RiemannInt_P8 ]; + [ idtac | symmetry ; apply RiemannInt_P8 ]; replace (RiemannInt pr2) with (- RiemannInt (RiemannInt_P1 pr2)); - [ idtac | symmetry in |- *; apply RiemannInt_P8 ]; + [ idtac | symmetry ; apply RiemannInt_P8 ]; replace (RiemannInt pr1) with (- RiemannInt (RiemannInt_P1 pr1)); - [ idtac | symmetry in |- *; apply RiemannInt_P8 ]; + [ idtac | symmetry ; apply RiemannInt_P8 ]; rewrite (RiemannInt_P12 (RiemannInt_P1 pr1) (RiemannInt_P1 pr2) (RiemannInt_P1 pr3) H); ring ] ]. @@ -1512,11 +1512,11 @@ Qed. Lemma RiemannInt_P14 : forall a b c:R, Riemann_integrable (fct_cte c) a b. Proof. - unfold Riemann_integrable in |- *; intros; + unfold Riemann_integrable; 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; + [ intros; simpl; unfold Rminus; rewrite Rplus_opp_r; + rewrite Rabs_R0; unfold fct_cte; right; reflexivity | rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0; apply (cond_pos eps) ]. @@ -1526,11 +1526,11 @@ Lemma RiemannInt_P15 : 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; unfold RiemannInt; 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 |- *; + change (Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) (c * (b - a))); set (f := fct_cte c); assert (H1 : @@ -1549,13 +1549,13 @@ Proof. 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 |- *; + intros; unfold f; simpl; unfold Rminus; + rewrite Rplus_opp_r; rewrite Rabs_R0; unfold fct_cte; right; reflexivity. - unfold psi2 in |- *; rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0; + unfold psi2; 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 |- *; + unfold Un_cv; intros; split with 0%nat; intros; unfold R_dist; + unfold phi2; rewrite StepFun_P18; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply H. Qed. @@ -1563,9 +1563,9 @@ 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. Proof. - unfold Riemann_integrable in |- *; intro f; intros; elim (X eps); clear X; + unfold Riemann_integrable; 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 |- *; + split with psi; split; try assumption; intros; simpl; apply Rle_trans with (Rabs (f t - phi t)); [ apply Rabs_triang_inv2 | apply H; assumption ]. Qed. @@ -1579,9 +1579,9 @@ Proof. assert (H2 : l2 < l1). auto with real. clear n; assert (H3 : 0 < (l1 - l2) / 2). - unfold Rdiv in |- *; apply Rmult_lt_0_compat; + unfold Rdiv; 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; + elim (H1 _ H3); elim (H0 _ H3); clear H0 H1; unfold R_dist; 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). @@ -1589,9 +1589,9 @@ Proof. 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 H1; unfold ge; unfold N; apply le_max_r. apply Rmult_eq_reg_l with 2; - [ unfold Rdiv in |- *; do 2 rewrite (Rmult_comm 2); + [ unfold Rdiv; 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 ] @@ -1600,9 +1600,9 @@ Proof. 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 H0; unfold ge; unfold N; apply le_max_l. apply Rmult_eq_reg_l with 2; - [ unfold Rdiv in |- *; do 2 rewrite (Rmult_comm 2); + [ unfold Rdiv; 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 ] @@ -1614,7 +1614,7 @@ Lemma RiemannInt_P17 : (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 |- *; + intro f; intros; unfold RiemannInt; case (RiemannInt_exists pr1 RinvN RinvN_cv); case (RiemannInt_exists pr2 RinvN RinvN_cv); intros; set (phi1 := phi_sequence RinvN pr1) in u0; @@ -1622,7 +1622,7 @@ Proof. 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. + intro; unfold phi2; apply StepFun_P34; assumption. apply (continuity_seq Rabs (fun N:nat => RiemannInt_SF (phi1 N)) x0); try assumption. apply Rcontinuity_abs. @@ -1656,7 +1656,7 @@ Proof. apply (proj2_sig (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 |- *; + intros; unfold phi2; simpl; apply Rle_trans with (Rabs (f t - phi1 n t)). apply Rabs_triang_inv2. apply H1; assumption. @@ -1671,13 +1671,13 @@ Lemma RiemannInt_P18 : a <= b -> (forall x:R, a < x < b -> f x = g x) -> RiemannInt pr1 = RiemannInt pr2. Proof. - intro f; intros; unfold RiemannInt in |- *; + intro f; intros; unfold RiemannInt; 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 |- *; + change (Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) x); assert (H1 : exists psi1 : nat -> StepFun a b, @@ -1717,45 +1717,45 @@ Proof. try assumption. apply RinvN_cv. intro; elim (H2 n); intros; split; try assumption. - intros; unfold phi2_m in |- *; simpl in |- *; unfold phi2_aux in |- *; + intros; unfold phi2_m; simpl; unfold phi2_aux; 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; + rewrite e0; unfold Rminus; 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; + pattern a at 3; rewrite <- e0; apply H3; assumption. + rewrite e; unfold Rminus; 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; + pattern a at 3; rewrite <- e; apply H3; assumption. + rewrite e; unfold Rminus; 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. + pattern b at 3; rewrite <- e; apply H3; assumption. replace (f t) with (g t). apply H3; assumption. - symmetry in |- *; apply H0; elim H5; clear H5; intros. + symmetry ; apply H0; elim H5; clear H5; intros. assert (H7 : Rmin a b = a). - unfold Rmin in |- *; case (Rle_dec a b); intro; + unfold Rmin; 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; + unfold Rmax; 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 H5; intro; [ assumption | elim n1; symmetry ; 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; + intro; unfold Un_cv; 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 |- *; + intros; unfold phi2_m; simpl; unfold phi2_aux; 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 |- *; + intros; unfold phi2_m; simpl; unfold phi2_aux; 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). @@ -1764,10 +1764,10 @@ Proof. 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 |- *; + decompose [and] H2; clear H2; unfold adapted_couple; 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; + unfold constant_D_eq, open_interval; 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. @@ -1775,7 +1775,7 @@ Proof. 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; + unfold Rmin; case (Rle_dec a b); intro; [ reflexivity | elim n; assumption ]. assert (H11 : pos_Rl l (S i) <= b). replace b with (Rmax a b). @@ -1783,9 +1783,9 @@ Proof. 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; + unfold Rmax; 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); + elim H7; clear H7; intros; unfold phi2_aux; 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)). @@ -1852,12 +1852,12 @@ 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; + unfold primitive; 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); + symmetry ; unfold primitive; case (Rle_dec a a); case (Rle_dec a b); intros; [ apply RiemannInt_P9 | elim n; assumption @@ -1872,9 +1872,9 @@ Lemma RiemannInt_P21 : 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. + unfold Riemann_integrable; intros f a b c Hyp1 Hyp2 X X0 eps. assert (H : 0 < eps / 2). - unfold Rdiv in |- *; apply Rmult_lt_0_compat; + unfold Rdiv; 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]. @@ -1904,35 +1904,35 @@ Proof. 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 |- *; + intro; split with (mkStepFun X); split with (mkStepFun X2); simpl; split. - intros; unfold phi3, psi3 in |- *; case (Rle_dec t b); case (Rle_dec a t); + intros; unfold phi3, psi3; 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; + unfold Rmax; case (Rle_dec a b); intro; [ reflexivity | elim n; assumption ]. - unfold Rmin in |- *; case (Rle_dec a b); intro; + unfold Rmin; 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; + unfold Rmin; 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; + unfold Rmin; case (Rle_dec b c); intro; [ reflexivity | elim n0; assumption ]. - unfold Rmax in |- *; case (Rle_dec a c); case (Rle_dec b c); intros; + unfold Rmax; 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; + unfold Rmin; 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 @@ -1946,14 +1946,14 @@ Proof. elim H2; intros; assumption. apply Rle_antisym. apply StepFun_P37; try assumption. - simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros; + simpl; intros; unfold psi3; 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; + simpl; intros; unfold psi3; 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 @@ -1961,14 +1961,14 @@ Proof. | 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; + simpl; intros; unfold psi3; 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; + simpl; intros; unfold psi3; elim H0; clear H0; intros; case (Rle_dec a x); case (Rle_dec x b); intros; [ right; reflexivity | elim n; left; assumption @@ -1978,19 +1978,19 @@ Proof. 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; + clear H3; unfold adapted_couple; repeat split; try assumption. - intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *; + intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval; unfold constant_D_eq, open_interval in H9; intros; - rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : b < x). + rewrite <- (H9 x H7); unfold psi3; 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; + apply neq_O_lt; red; intro; rewrite <- H12 in H6; discriminate. - unfold Rmin in |- *; case (Rle_dec b c); intro; + unfold Rmin; 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; @@ -2001,18 +2001,18 @@ Proof. 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; + clear H3; unfold adapted_couple; repeat split; try assumption. - intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *; + intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval; unfold constant_D_eq, open_interval in H9; intros; - rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : x <= b). + rewrite <- (H9 x H7); unfold psi3; 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; + apply lt_pred_n_n; apply neq_O_lt; red; intro; rewrite <- H12 in H6; discriminate. - unfold Rmax in |- *; case (Rle_dec a b); intro; + unfold Rmax; case (Rle_dec a b); intro; [ reflexivity | elim n; assumption ]. assert (H11 : a <= x). apply Rle_trans with (pos_Rl l1 i). @@ -2020,9 +2020,9 @@ Proof. 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; + apply neq_O_lt; red; intro; rewrite <- H13 in H6; discriminate. - unfold Rmin in |- *; case (Rle_dec a b); intro; + unfold Rmin; 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; @@ -2031,18 +2031,18 @@ Proof. 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; + clear H3; unfold adapted_couple; repeat split; try assumption. - intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *; + intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval; unfold constant_D_eq, open_interval in H9; intros; - rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : x <= b). + rewrite <- (H9 x H7); unfold psi3; 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; + apply lt_pred_n_n; apply neq_O_lt; red; intro; rewrite <- H12 in H6; discriminate. - unfold Rmax in |- *; case (Rle_dec a b); intro; + unfold Rmax; case (Rle_dec a b); intro; [ reflexivity | elim n; assumption ]. assert (H11 : a <= x). apply Rle_trans with (pos_Rl l1 i). @@ -2050,32 +2050,32 @@ Proof. 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; + apply neq_O_lt; red; intro; rewrite <- H13 in H6; discriminate. - unfold Rmin in |- *; case (Rle_dec a b); intro; + unfold Rmin; 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; + unfold phi3; 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; + clear H3; unfold adapted_couple; repeat split; try assumption. - intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *; + intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval; unfold constant_D_eq, open_interval in H9; intros; - rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : b < x). + rewrite <- (H9 x H7); unfold psi3; 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; + apply neq_O_lt; red; intro; rewrite <- H12 in H6; discriminate. - unfold Rmin in |- *; case (Rle_dec b c); intro; + unfold Rmin; 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; + unfold phi3; 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 ] @@ -2086,7 +2086,7 @@ Lemma RiemannInt_P22 : 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; + unfold Riemann_integrable; 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. @@ -2097,18 +2097,18 @@ Proof. apply (pre psi). split; assumption. split with (mkStepFun H3); split with (mkStepFun H4); split. - simpl in |- *; intros; apply H. + simpl; 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; + unfold Rmax; case (Rle_dec a c); intro; [ reflexivity | elim n; assumption ]. - unfold Rmax in |- *; case (Rle_dec a b); intro; + unfold Rmax; 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; + unfold Rmin; case (Rle_dec a c); case (Rle_dec a b); intros; [ reflexivity | elim n; apply Rle_trans with c; assumption | elim n; assumption @@ -2121,12 +2121,12 @@ Proof. 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 |- *; + unfold Rminus; pattern (RiemannInt_SF psi) at 2; 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 |- *; + intros; simpl; unfold fct_cte; apply Rle_trans with (Rabs (f x - phi x)). apply Rabs_pos. apply H. @@ -2135,9 +2135,9 @@ Proof. elim H6; intros; split; left. apply Rle_lt_trans with c; assumption. assumption. - unfold Rmax in |- *; case (Rle_dec a b); intro; + unfold Rmax; case (Rle_dec a b); intro; [ reflexivity | elim n; apply Rle_trans with c; assumption ]. - unfold Rmin in |- *; case (Rle_dec a b); intro; + unfold Rmin; 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)). @@ -2147,16 +2147,16 @@ Proof. 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. + unfold RiemannInt_SF; case (Rle_dec a b); intro. eapply StepFun_P17. apply StepFun_P1. - simpl in |- *; apply StepFun_P1. + simpl; apply StepFun_P1. apply Ropp_eq_compat; eapply StepFun_P17. apply StepFun_P1. - simpl in |- *; apply StepFun_P1. + simpl; 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 |- *; + intros; simpl; unfold fct_cte; apply Rle_trans with (Rabs (f x - phi x)). apply Rabs_pos. apply H. @@ -2165,9 +2165,9 @@ Proof. elim H5; intros; split; left. assumption. apply Rlt_le_trans with c; assumption. - unfold Rmax in |- *; case (Rle_dec a b); intro; + unfold Rmax; case (Rle_dec a b); intro; [ reflexivity | elim n; apply Rle_trans with c; assumption ]. - unfold Rmin in |- *; case (Rle_dec a b); intro; + unfold Rmin; case (Rle_dec a b); intro; [ reflexivity | elim n; apply Rle_trans with c; assumption ]. rewrite StepFun_P18; ring. Qed. @@ -2176,7 +2176,7 @@ Lemma RiemannInt_P23 : 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; + unfold Riemann_integrable; 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. @@ -2187,18 +2187,18 @@ Proof. apply (pre psi). split; assumption. split with (mkStepFun H3); split with (mkStepFun H4); split. - simpl in |- *; intros; apply H. + simpl; 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; + unfold Rmin; case (Rle_dec c b); intro; [ reflexivity | elim n; assumption ]. - unfold Rmin in |- *; case (Rle_dec a b); intro; + unfold Rmin; 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; + unfold Rmax; case (Rle_dec c b); case (Rle_dec a b); intros; [ reflexivity | elim n; apply Rle_trans with c; assumption | elim n; assumption @@ -2211,12 +2211,12 @@ Proof. 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 |- *; + unfold Rminus; pattern (RiemannInt_SF psi) at 2; 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 |- *; + intros; simpl; unfold fct_cte; apply Rle_trans with (Rabs (f x - phi x)). apply Rabs_pos. apply H. @@ -2225,9 +2225,9 @@ Proof. elim H6; intros; split; left. assumption. apply Rlt_le_trans with c; assumption. - unfold Rmax in |- *; case (Rle_dec a b); intro; + unfold Rmax; case (Rle_dec a b); intro; [ reflexivity | elim n; apply Rle_trans with c; assumption ]. - unfold Rmin in |- *; case (Rle_dec a b); intro; + unfold Rmin; 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)). @@ -2237,16 +2237,16 @@ Proof. 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. + unfold RiemannInt_SF; case (Rle_dec a b); intro. eapply StepFun_P17. apply StepFun_P1. - simpl in |- *; apply StepFun_P1. + simpl; apply StepFun_P1. apply Ropp_eq_compat; eapply StepFun_P17. apply StepFun_P1. - simpl in |- *; apply StepFun_P1. + simpl; 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 |- *; + intros; simpl; unfold fct_cte; apply Rle_trans with (Rabs (f x - phi x)). apply Rabs_pos. apply H. @@ -2255,9 +2255,9 @@ Proof. elim H5; intros; split; left. apply Rle_lt_trans with c; assumption. assumption. - unfold Rmax in |- *; case (Rle_dec a b); intro; + unfold Rmax; case (Rle_dec a b); intro; [ reflexivity | elim n; apply Rle_trans with c; assumption ]. - unfold Rmin in |- *; case (Rle_dec a b); intro; + unfold Rmin; case (Rle_dec a b); intro; [ reflexivity | elim n; apply Rle_trans with c; assumption ]. rewrite StepFun_P18; ring. Qed. @@ -2290,14 +2290,14 @@ Lemma RiemannInt_P25 : (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 |- *; + intros f a b c pr1 pr2 pr3 Hyp1 Hyp2; unfold RiemannInt; 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. + symmetry ; eapply UL_sequence. apply u. - unfold Un_cv in |- *; intros; assert (H0 : 0 < eps / 3). - unfold Rdiv in |- *; apply Rmult_lt_0_compat; + unfold Un_cv; intros; assert (H0 : 0 < eps / 3). + unfold Rdiv; 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; @@ -2309,7 +2309,7 @@ Proof. 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 |- *; + unfold R_dist; apply Rle_lt_trans with (Rabs (RiemannInt_SF (phi_sequence RinvN pr3 n) - @@ -2330,8 +2330,8 @@ Proof. 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 ]. + unfold ge; apply le_trans with N0; + [ unfold N0; 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)). @@ -2343,17 +2343,17 @@ Proof. [ apply Rabs_triang | ring ]. apply Rplus_lt_compat. unfold R_dist in H1; apply H1. - unfold ge in |- *; apply le_trans with N0; + unfold ge; apply le_trans with N0; [ apply le_trans with (max N1 N2); - [ apply le_max_l | unfold N0 in |- *; apply le_max_l ] + [ apply le_max_l | unfold N0; apply le_max_l ] | assumption ]. unfold R_dist in H2; apply H2. - unfold ge in |- *; apply le_trans with N0; + unfold ge; apply le_trans with N0; [ apply le_trans with (max N1 N2); - [ apply le_max_r | unfold N0 in |- *; apply le_max_l ] + [ apply le_max_r | unfold N0; apply le_max_l ] | assumption ]. apply Rmult_eq_reg_l with 3; - [ unfold Rdiv in |- *; repeat rewrite Rmult_plus_distr_l; + [ unfold Rdiv; repeat rewrite Rmult_plus_distr_l; do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ ring | discrR ] | discrR ]. @@ -2390,8 +2390,8 @@ Proof. apply (proj2_sig (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; + unfold Un_cv; intros; assert (H4 : 0 < eps / 3). + unfold Rdiv; 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). @@ -2399,11 +2399,11 @@ Proof. 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; + unfold R_dist; unfold Rminus; 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 |- *; + intros; unfold R_dist; unfold Rminus; 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 |- *; @@ -2469,7 +2469,7 @@ Proof. (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; + intros; simpl; 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)); @@ -2480,28 +2480,28 @@ Proof. replace (Rmin a c) with a. apply Rle_trans with b; try assumption. left; assumption. - unfold Rmin in |- *; case (Rle_dec a c); intro; + unfold Rmin; 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; + unfold Rmax; 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; + unfold Rmin; 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; + unfold Rmax; 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; + intros; simpl; 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)); @@ -2511,23 +2511,23 @@ Proof. elim H14; intros; split. replace (Rmin a c) with a. left; assumption. - unfold Rmin in |- *; case (Rle_dec a c); intro; + unfold Rmin; 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; + unfold Rmax; 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; + unfold Rmin; 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; + unfold Rmax; case (Rle_dec a b); intro; [ reflexivity | elim n0; assumption ]. do 2 rewrite StepFun_P30. do 2 rewrite Rmult_1_l; @@ -2553,7 +2553,7 @@ Proof. assumption. apply H5; assumption. apply Rmult_eq_reg_l with 3; - [ unfold Rdiv in |- *; repeat rewrite Rmult_plus_distr_l; + [ unfold Rdiv; repeat rewrite Rmult_plus_distr_l; do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ ring | discrR ] | discrR ]. @@ -2608,13 +2608,13 @@ Lemma RiemannInt_P27 : 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; + unfold derivable_pt_lim; intros; assert (Hyp : 0 < eps / 2). + unfold Rdiv; 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))); + elim (H1 _ Hyp); unfold dist, D_x, no_cond; simpl; + unfold R_dist; 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)); + unfold del; unfold Rmin; case (Rle_dec (b - x) (x - a)); intro. case (Rle_dec x0 (b - x)); intro; [ elim H3; intros; assumption | apply Rlt_Rminus; assumption ]. @@ -2631,22 +2631,22 @@ Proof. 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)). + unfold del; 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)); + pattern b at 2; 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. + unfold del; apply Rle_trans with (x - Rmin (b - x) (x - a)). + pattern a at 1; replace a with (x + (a - x)); [ idtac | ring ]. + unfold Rminus; 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. + unfold Rminus; 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. + unfold Rminus; 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. @@ -2659,7 +2659,7 @@ Proof. 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. + unfold Rdiv; rewrite Rabs_mult; case (Rle_dec x (x + h0)); intro. apply Rle_lt_trans with (RiemannInt (RiemannInt_P16 @@ -2678,8 +2678,8 @@ Proof. 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; + unfold fct_cte; case (Req_dec x x1); intro. + rewrite H9; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; left; assumption. elim H3; intros; left; apply H11. repeat split. @@ -2690,16 +2690,16 @@ Proof. 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. + unfold del; apply Rmin_l. apply Rge_minus; apply Rle_ge; left; elim H8; intros; assumption. - unfold fct_cte in |- *; ring. + unfold fct_cte; 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; + rewrite Rmult_1_r; unfold Rdiv; 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 Rmult_1_l; pattern eps at 1; rewrite <- Rplus_0_r; rewrite double; apply Rplus_lt_compat_l; assumption | discrR ] ]. rewrite Rabs_right. @@ -2709,7 +2709,7 @@ Proof. 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; + elim H5; symmetry ; apply Rplus_eq_reg_l with x; rewrite Rplus_0_r; assumption. apply Rle_lt_trans with (RiemannInt @@ -2733,7 +2733,7 @@ Proof. (RiemannInt_P1 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))))); auto with real. - symmetry in |- *; apply RiemannInt_P8. + symmetry ; 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. @@ -2741,8 +2741,8 @@ Proof. 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; + unfold fct_cte; case (Req_dec x x1); intro. + rewrite H9; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; left; assumption. elim H3; intros; left; apply H11. repeat split. @@ -2752,22 +2752,22 @@ Proof. [ 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. + unfold Rminus; 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 ]. + [ left; assumption | unfold del; 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. + unfold fct_cte; 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; + rewrite Rmult_1_r; unfold Rdiv; 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 Rmult_1_l; pattern eps at 1; rewrite <- Rplus_0_r; rewrite double; apply Rplus_lt_compat_l; assumption | discrR ] ]. rewrite Rabs_left. @@ -2784,14 +2784,14 @@ Proof. (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))) . ring. - unfold Rdiv, Rminus in |- *; rewrite Rmult_plus_distr_r; ring. + unfold Rdiv, Rminus; 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; + [ unfold Rdiv; 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 |- *. + intros; unfold primitive. 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. @@ -2801,7 +2801,7 @@ Proof. apply RRle_abs. apply Rle_trans with del; [ left; assumption - | unfold del in |- *; apply Rle_trans with (Rmin (b - x) (x - a)); + | unfold del; 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 ]. @@ -2809,7 +2809,7 @@ Proof. [ 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)); + | unfold del; apply Rle_trans with (Rmin (b - x) (x - a)); apply Rmin_r ] ]. Qed. @@ -2826,14 +2826,14 @@ Proof. (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). + unfold f_b; pattern (f b) at 2; 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 |- *. + f b + 0)). apply derivable_pt_lim_plus. - pattern (f b) at 2 in |- *; + pattern (f b) at 2; 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. @@ -2841,26 +2841,26 @@ Proof. apply derivable_pt_lim_minus. apply derivable_pt_lim_id. apply derivable_pt_lim_const. - unfold fct_cte in |- *; ring. + unfold fct_cte; ring. apply derivable_pt_lim_const. ring. - unfold derivable_pt_lim in |- *; intros; elim (H4 _ H5); intros; + unfold derivable_pt_lim; 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; + unfold Rdiv; 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))); + elim (H7 _ H8); unfold D_x, no_cond, dist; simpl; + unfold R_dist; 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. + unfold del; unfold Rmin; 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; + pattern b at 2; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; assumption. assert (H13 : Riemann_integrable f (b + h0) b). apply continuity_implies_RiemannInt. @@ -2874,11 +2874,11 @@ Proof. 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. + unfold del; 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 <- Rabs_Ropp; unfold Rminus; unfold Rdiv; rewrite Ropp_mult_distr_l_reverse; rewrite Ropp_plus_distr; repeat rewrite Ropp_involutive; replace @@ -2887,7 +2887,7 @@ Proof. ((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; + unfold Rdiv; rewrite Rabs_mult; apply Rle_lt_trans with (RiemannInt (RiemannInt_P16 @@ -2907,8 +2907,8 @@ Proof. 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; + unfold fct_cte; case (Req_dec b x2); intro. + rewrite H16; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; left; assumption. elim H9; intros; left; apply H18. repeat split. @@ -2919,22 +2919,22 @@ Proof. 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; + unfold Rminus; 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)); + | unfold del; 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. + unfold fct_cte; 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; + rewrite Rmult_1_r; unfold Rdiv; 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 Rmult_1_l; pattern eps at 1; rewrite <- Rplus_0_r; rewrite double; apply Rplus_lt_compat_l; assumption | discrR ] ]. rewrite Rabs_left. @@ -2948,16 +2948,16 @@ Proof. (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. + unfold Rdiv, Rminus; 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_comm h0); unfold Rdiv; 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)); + intros; unfold primitive; 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. @@ -2970,26 +2970,26 @@ Proof. 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. + unfold del; 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 ]. + [ assumption | unfold del; apply Rmin_l ]. assert (H14 : b < b + h0). - pattern b at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l. + pattern b at 1; 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)); + elim H11; symmetry ; assumption. + unfold primitive; 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 + | unfold f_b; 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 |- *; + unfold f_b; unfold Rminus; rewrite Rplus_opp_r; + rewrite Rmult_0_r; rewrite Rplus_0_l; unfold primitive; case (Rle_dec a b); case (Rle_dec b b); intros; [ apply RiemannInt_P5 | elim n; right; reflexivity @@ -2998,9 +2998,9 @@ Proof. (*****) 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 |- *; + unfold f_a; change (derivable_pt_lim (fct_cte (f a) * (id - fct_cte a)%F) a (f a)) - in |- *; pattern (f a) at 2 in |- *; + ; pattern (f a) at 2; 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. @@ -3008,18 +3008,18 @@ Proof. 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. + unfold fct_cte; ring. + unfold derivable_pt_lim; 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; + unfold Rdiv; 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. + elim (H6 _ H7); unfold D_x, no_cond, dist; simpl; + unfold R_dist; intros. set (del := Rmin x0 (Rmin x1 (b - a))). assert (H9 : 0 < del). - unfold del in |- *; unfold Rmin in |- *. + unfold del; unfold Rmin. case (Rle_dec x1 (b - a)); intros. case (Rle_dec x0 x1); intro. apply (cond_pos x0). @@ -3030,9 +3030,9 @@ Proof. 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; + pattern a at 2; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; assumption. - unfold primitive in |- *. + unfold primitive. 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). @@ -3042,15 +3042,15 @@ Proof. 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. + [ assumption | unfold del; apply Rmin_l ]. + unfold f_a; ring. + unfold f_a; 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. + pattern a at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l. assert (H12 := Rge_le _ _ r); elim H12; intro. assumption. - elim H10; symmetry in |- *; assumption. + elim H10; symmetry ; assumption. assert (H13 : Riemann_integrable f a (a + h0)). apply continuity_implies_RiemannInt. left; assumption. @@ -3062,7 +3062,7 @@ Proof. 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. + unfold del; 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). @@ -3071,7 +3071,7 @@ Proof. 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; + unfold Rdiv; rewrite Rabs_mult; apply Rle_lt_trans with (RiemannInt (RiemannInt_P16 @@ -3091,8 +3091,8 @@ Proof. 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; + unfold fct_cte; case (Req_dec a x2); intro. + rewrite H15; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; left; assumption. elim H8; intros; left; apply H17; repeat split. assumption. @@ -3104,42 +3104,42 @@ Proof. apply RRle_abs. apply Rlt_le_trans with del; [ assumption - | unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); + | unfold del; 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. + unfold fct_cte; 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; + rewrite Rmult_1_r; unfold Rdiv; 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 Rmult_1_l; pattern eps at 1; 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_comm; unfold Rminus; 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. + elim H10; symmetry ; 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. + unfold Rdiv, Rminus; 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 Rplus_comm; unfold Rminus; rewrite Rplus_assoc; + rewrite Rplus_opp_r; rewrite Rplus_0_r; unfold Rdiv; 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)); + intros; unfold primitive; 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 RiemannInt_P9; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; apply RiemannInt_P5. elim n; assumption. elim n; assumption. @@ -3148,15 +3148,15 @@ Proof. [ 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 ]. + | unfold del; 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 |- *; + unfold f_a; change (derivable_pt_lim (fct_cte (f a) * (id - fct_cte a)%F) a (f a)) - in |- *; pattern (f a) at 2 in |- *; + ; pattern (f a) at 2; 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. @@ -3164,18 +3164,18 @@ Proof. apply derivable_pt_lim_minus. apply derivable_pt_lim_id. apply derivable_pt_lim_const. - unfold fct_cte in |- *; ring. + unfold fct_cte; 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). + unfold f_b; pattern (f b) at 2; 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 |- *. + f b + 0)). apply derivable_pt_lim_plus. - pattern (f b) at 2 in |- *; + pattern (f b) at 2; 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. @@ -3183,20 +3183,20 @@ Proof. apply derivable_pt_lim_minus. apply derivable_pt_lim_id. apply derivable_pt_lim_const. - unfold fct_cte in |- *; ring. + unfold fct_cte; ring. apply derivable_pt_lim_const. ring. - unfold derivable_pt_lim in |- *; intros; elim (H2 _ H4); intros; + unfold derivable_pt_lim; 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. + unfold del; unfold Rmin; 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; + pattern a at 2; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; assumption. - rewrite H1; unfold primitive in |- *; case (Rle_dec a (a + h0)); + rewrite H1; unfold primitive; 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)). @@ -3205,27 +3205,27 @@ Proof. 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. + unfold del; apply Rmin_l. + unfold f_a; ring. + unfold f_a; 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. + pattern a at 1; 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 |- *; + elim H8; symmetry ; assumption. + rewrite H0 in H1; rewrite H1; unfold primitive; 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 |- *. + fold (f_b (b + h0)). 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; + unfold del; apply Rmin_r. + unfold f_b; unfold Rminus; 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. @@ -3236,11 +3236,11 @@ Lemma RiemannInt_P29 : (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; + intro f; intros; unfold antiderivative; 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 ]. + [ unfold derivable_pt; split with (f x); apply H0 + | split with H1; symmetry ; apply derive_pt_eq_0; apply H0 ]. Qed. Lemma RiemannInt_P30 : @@ -3259,7 +3259,7 @@ Lemma RiemannInt_P31 : 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; + intro f; intros; unfold antiderivative; split; try assumption; intros; split with (diff0 f x); reflexivity. Qed. diff --git a/theories/Reals/RiemannInt_SF.v b/theories/Reals/RiemannInt_SF.v index d16e7f2c..d523a1f4 100644 --- a/theories/Reals/RiemannInt_SF.v +++ b/theories/Reals/RiemannInt_SF.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,9 +8,9 @@ Require Import Rbase. Require Import Rfunctions. -Require Import Ranalysis. +Require Import Ranalysis_reg. Require Import Classical_Prop. -Open Local Scope R_scope. +Local Open Scope R_scope. Set Implicit Arguments. @@ -21,7 +21,7 @@ Set Implicit Arguments. Definition Nbound (I:nat -> Prop) : Prop := 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}. +Lemma IZN_var : forall z:Z, (0 <= z)%Z -> {n : nat | z = Z.of_nat n}. Proof. intros; apply Z_of_nat_complete_inf; assumption. Qed. @@ -33,19 +33,19 @@ Lemma Nzorn : 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 Nbound in H0; elim H0; intros N H1; unfold bound; + exists (INR N); unfold is_upper_bound; 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; + elim H; intros; exists (INR x); unfold E; 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; + [ rewrite <- H9; change (INR 0 <= INR x1); apply le_INR; apply le_O_n | apply H4; assumption ]. assert (H7 := archimed x); elim H7; clear H7; intros; @@ -88,7 +88,7 @@ Proof. [ idtac | reflexivity ]; rewrite <- minus_INR. replace (x0 - 1)%nat with (pred x0); [ reflexivity - | case x0; [ reflexivity | intro; simpl in |- *; apply minus_n_O ] ]. + | case x0; [ reflexivity | intro; simpl; 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)) @@ -99,10 +99,10 @@ Proof. 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. + simpl; split. assumption. intros; apply INR_le; rewrite H15; rewrite <- H15; elim H12; intros; - rewrite H20; apply H4; unfold E in |- *; exists i; + rewrite H20; apply H4; unfold E; exists i; split; [ assumption | reflexivity ]. Qed. @@ -173,7 +173,7 @@ Lemma StepFun_P1 : 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; + intros a b f; unfold subdivision_val; case (projT2 (pre f)); intros; apply a0. Qed. @@ -181,13 +181,13 @@ 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. Proof. - unfold adapted_couple in |- *; intros; decompose [and] H; clear H; + unfold adapted_couple; intros; decompose [and] H; clear H; repeat split; try assumption. - rewrite H2; unfold Rmin in |- *; case (Rle_dec a b); intro; + rewrite H2; unfold Rmin; 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; + rewrite H1; unfold Rmax; case (Rle_dec a b); intro; case (Rle_dec b a); intro; try reflexivity. apply Rle_antisym; assumption. apply Rle_antisym; auto with real. @@ -198,23 +198,23 @@ Lemma StepFun_P3 : 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; + intros; unfold adapted_couple; repeat split. + unfold ordered_Rlist; intros; simpl in H0; inversion H0; + [ simpl; assumption | elim (le_Sn_O _ H2) ]. + simpl; unfold Rmin; case (Rle_dec a b); intro; [ reflexivity | elim n; assumption ]. - simpl in |- *; unfold Rmax in |- *; case (Rle_dec a b); intro; + simpl; unfold Rmax; case (Rle_dec a b); intro; [ reflexivity | elim n; assumption ]. - unfold constant_D_eq, open_interval in |- *; intros; simpl in H0; + unfold constant_D_eq, open_interval; 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. Proof. - intros; unfold IsStepFun in |- *; case (Rle_dec a b); intro. - apply existT with (cons a (cons b nil)); unfold is_subdivision in |- *; + intros; unfold IsStepFun; case (Rle_dec a b); intro. + apply existT with (cons a (cons b nil)); unfold is_subdivision; 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 b (cons a nil)); unfold is_subdivision; apply existT with (cons c nil); apply StepFun_P2; apply StepFun_P3; auto with real. Qed. @@ -232,7 +232,7 @@ Qed. Lemma StepFun_P6 : 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; + unfold IsStepFun; intros; elim X; intros; apply existT with x; apply StepFun_P5; assumption. Qed. @@ -242,26 +242,26 @@ Lemma StepFun_P7 : 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; + unfold adapted_couple; intros; decompose [and] H0; clear H0; assert (H5 : Rmax a b = b). - unfold Rmax in |- *; case (Rle_dec a b); intro; + unfold Rmax; 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 ]. + [ assumption | simpl; right; left; reflexivity ]. repeat split. apply RList_P4 with r1; assumption. - rewrite H5 in H2; unfold Rmin in |- *; case (Rle_dec r2 b); intro; + rewrite H5 in H2; unfold Rmin; case (Rle_dec r2 b); intro; [ reflexivity | elim n; assumption ]. - unfold Rmax in |- *; case (Rle_dec r2 b); intro; + unfold Rmax; 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; + simpl in H4; simpl; 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; + intros; unfold constant_D_eq, open_interval; 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. + simpl; simpl in H0; apply lt_n_S; assumption. assert (H10 := H6 _ H9); apply H10; assumption. Qed. @@ -278,19 +278,19 @@ Proof. discriminate. intros; induction lf1 as [| r3 lf1 Hreclf1]. reflexivity. - simpl in |- *; cut (r = r1). + simpl; 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 |- *; + intros; simpl in H4; rewrite H4; unfold Rmin; 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. + apply (H3 0%nat); simpl; 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; + [ assumption | simpl; right; left; reflexivity ] + | unfold Rmin, Rmax; case (Rle_dec b b); case (Rle_dec a b); intros; try assumption || reflexivity ]. Qed. @@ -303,10 +303,10 @@ Proof. [ 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); + unfold Rmin, Rmax; 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 ] ]. + | simpl; do 2 apply le_n_S; apply le_O_n ] ]. Qed. Lemma StepFun_P10 : @@ -320,12 +320,12 @@ Proof. 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 |- *; + exists (cons a nil); exists nil; unfold adapted_couple_opt; + unfold adapted_couple; unfold ordered_Rlist; 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; + simpl; rewrite <- H2; unfold Rmin; case (Rle_dec a a); intro; reflexivity. - simpl in |- *; rewrite <- H2; unfold Rmax in |- *; case (Rle_dec a a); intro; + simpl; rewrite <- H2; unfold Rmax; 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]. @@ -340,32 +340,32 @@ Proof. 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; + unfold Rmin; 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 |- *; + unfold adapted_couple_opt; unfold adapted_couple; 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; + unfold ordered_Rlist; intros; simpl in H8; inversion H8; + [ simpl; assumption | elim (le_Sn_O _ H10) ]. + simpl; unfold Rmin; case (Rle_dec a b); intro; [ reflexivity | elim n; assumption ]. - simpl in |- *; unfold Rmax in |- *; case (Rle_dec a b); intro; + simpl; unfold Rmax; 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 |- *; + unfold constant_D_eq, open_interval; intros; simpl; 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); + simpl; apply lt_O_Sn. + unfold open_interval; simpl; rewrite H7; simpl in H13; + rewrite H13; unfold Rmin; 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) ]. + [ simpl; assumption | elim (le_Sn_O _ H10) ]. assert (Hyp_min : Rmin t2 b = t2). - unfold Rmin in |- *; case (Rle_dec t2 b); intro; + unfold Rmin; 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]]; @@ -377,141 +377,141 @@ Proof. 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 |- *; + unfold adapted_couple_opt; unfold adapted_couple; repeat split. - unfold ordered_Rlist in |- *; intros; simpl in H1; + unfold ordered_Rlist; intros; simpl in H1; induction i as [| i Hreci]. - simpl in |- *; apply Rle_trans with s1. + simpl; 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 |- *; + simpl; apply lt_O_Sn. + simpl in H19; rewrite H19; symmetry ; apply Hyp_min. + apply (H16 0%nat); simpl; apply lt_O_Sn. + change (pos_Rl (cons s2 s3) i <= pos_Rl (cons s2 s3) (S i)); + apply (H16 (S i)); simpl; assumption. + simpl; simpl in H14; rewrite H14; reflexivity. + simpl; simpl in H18; rewrite H18; unfold Rmax; 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; + simpl; simpl in H20; apply H20. + intros; simpl in H1; unfold constant_D_eq, open_interval; intros; induction i as [| i Hreci]. - simpl in |- *; simpl in H6; case (total_order_T x t2); intro. + simpl; 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; + [ simpl; apply lt_O_Sn + | unfold open_interval; simpl; 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; + [ simpl; apply lt_O_Sn + | unfold open_interval; simpl; 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 ]. + simpl; simpl in H6; apply (H22 (S i)); + [ simpl; assumption + | unfold open_interval; simpl; 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. + ; rewrite <- H9; elim H8; intros; apply H6; + simpl; 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. + simpl; red; intro; elim Hyp_eq; apply Rle_antisym. + apply (H12 0%nat); simpl; 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 |- *; + apply (H16 0%nat); simpl; apply lt_O_Sn. + elim H8; intros; rewrite H9 in H21; apply (H21 (S i)); simpl; 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 |- *; + unfold adapted_couple_opt; unfold adapted_couple; repeat split. - rewrite H9; unfold ordered_Rlist in |- *; intros; simpl in H1; + rewrite H9; unfold ordered_Rlist; 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; replace s1 with t2. + apply (H16 0%nat); simpl; 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; + ; apply (H12 i); simpl; apply lt_S_n; assumption. - simpl in |- *; simpl in H19; apply H19. - rewrite H9; simpl in |- *; simpl in H13; rewrite H13; unfold Rmax in |- *; + simpl; simpl in H19; apply H19. + rewrite H9; simpl; simpl in H13; rewrite H13; unfold Rmax; 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; + rewrite H9; simpl; simpl in H15; rewrite H15; reflexivity. + intros; simpl in H1; unfold constant_D_eq, open_interval; 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 |- *. + simpl; rewrite H9 in H6; simpl in H6; apply (H22 0%nat). + simpl; apply lt_O_Sn. + unfold open_interval; simpl. 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. + change (f x = pos_Rl (cons r2 lf') i); clear Hreci; apply (H17 i). + simpl; rewrite H9 in H1; simpl in H1; apply lt_S_n; apply H1. + rewrite H9 in H6; unfold open_interval; apply H6. intros; simpl in H1; induction i as [| i Hreci]. - simpl in |- *; rewrite H9; right; simpl in |- *; replace s1 with t2. + simpl; rewrite H9; right; simpl; 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. + simpl; 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. + simpl; red; intro; elim Hyp_eq; apply Rle_antisym. + apply (H16 0%nat); simpl; 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. + simpl; 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 |- *; + unfold adapted_couple_opt; unfold adapted_couple; repeat split. - rewrite H9; unfold ordered_Rlist in |- *; intros; simpl in H1; + rewrite H9; unfold ordered_Rlist; 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; replace s1 with t2. + apply (H15 0%nat); simpl; 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; + ; apply (H11 i); simpl; apply lt_S_n; assumption. - simpl in |- *; simpl in H18; apply H18. - rewrite H9; simpl in |- *; simpl in H12; rewrite H12; unfold Rmax in |- *; + simpl; simpl in H18; apply H18. + rewrite H9; simpl; simpl in H12; rewrite H12; unfold Rmax; 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; + rewrite H9; simpl; simpl in H14; rewrite H14; reflexivity. + intros; simpl in H1; unfold constant_D_eq, open_interval; 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. + simpl; rewrite H9 in H6; simpl in H6; apply (H21 0%nat). + simpl; apply lt_O_Sn. + unfold open_interval; simpl; 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. + change (f x = pos_Rl (cons r2 lf') i); clear Hreci; apply (H16 i). + simpl; rewrite H9 in H1; simpl in H1; apply lt_S_n; apply H1. + rewrite H9 in H6; unfold open_interval; apply H6. intros; simpl in H1; induction i as [| i Hreci]. - simpl in |- *; left; assumption. + simpl; left; assumption. elim H8; intros; apply (H6 i). - simpl in |- *; apply lt_S_n; apply H1. + simpl; 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. + simpl; red; intro; elim Hyp_eq; apply Rle_antisym. + apply (H15 0%nat); simpl; 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. + simpl; 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; + [ assumption | simpl; right; left; reflexivity ] + | unfold Rmax; case (Rle_dec a b); intro; [ reflexivity | elim n; assumption ] ]. Qed. @@ -534,7 +534,7 @@ Proof. 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 ]. + [ assumption | simpl; right; left; reflexivity ]. clear Hrecs3; induction lf2 as [| r5 lf2 Hreclf2]. simpl in H11; discriminate. clear Hreclf2; assert (H17 : r3 = r4). @@ -544,31 +544,31 @@ Proof. simpl in H18; rewrite <- (H17 x). rewrite <- (H18 x). reflexivity. - rewrite <- H12; unfold x in |- *; split. + rewrite <- H12; unfold x; split. apply Rmult_lt_reg_l with 2; [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + | unfold Rdiv; 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; + | unfold Rdiv; 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. + unfold x; split. apply Rmult_lt_reg_l with 2; [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + | unfold Rdiv; 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)); + | unfold Rdiv; 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 @@ -576,8 +576,8 @@ Proof. | assumption ]. assert (H18 : f s2 = r3). apply (H8 0%nat); - [ simpl in |- *; apply lt_O_Sn - | unfold open_interval in |- *; simpl in |- *; split; assumption ]. + [ simpl; apply lt_O_Sn + | unfold open_interval; simpl; 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; @@ -587,18 +587,18 @@ Proof. 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. + unfold open_interval; simpl; unfold x; split. apply Rmult_lt_reg_l with 2; [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + | unfold Rdiv; 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; + unfold Rmin; 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; + | unfold Rdiv; 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); @@ -606,20 +606,20 @@ Proof. assumption | apply Rplus_le_compat_l; apply Rmin_r ] | discrR ] ]. - unfold open_interval in |- *; simpl in |- *; unfold x in |- *; split. + unfold open_interval; simpl; unfold x; split. apply Rlt_trans with s2; [ assumption | apply Rmult_lt_reg_l with 2; [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); + | unfold Rdiv; 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); + unfold Rmin; 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; + | unfold Rdiv; 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); @@ -636,20 +636,20 @@ Proof. | 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. + rewrite <- H0; rewrite H12; apply (H7 0%nat); simpl; 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. Proof. - unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; intros; + unfold adapted_couple_opt; unfold adapted_couple; intros; decompose [and] H; clear H; repeat split; try assumption. - rewrite H0; unfold Rmin in |- *; case (Rle_dec a b); intro; + rewrite H0; unfold Rmin; 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; + rewrite H3; unfold Rmax; case (Rle_dec a b); intro; case (Rle_dec b a); intro; try reflexivity. apply Rle_antisym; assumption. apply Rle_antisym; auto with real. @@ -689,10 +689,10 @@ Proof. 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; + unfold Rmin; 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; + unfold Rmax; 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]. @@ -716,34 +716,34 @@ Proof. 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 |- *; + [ idtac | elim H7; assumption ]; unfold x; split. apply Rmult_lt_reg_l with 2; [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + | unfold Rdiv; 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; + | unfold Rdiv; 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 |- *; + intro; [ idtac | elim H7; assumption ]; unfold x; split. apply Rmult_lt_reg_l with 2; [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + | unfold Rdiv; 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)); + | unfold Rdiv; 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 @@ -752,64 +752,64 @@ Proof. eapply StepFun_P13. apply H4. apply H2. - unfold adapted_couple_opt in |- *; split. + unfold adapted_couple_opt; 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. + unfold adapted_couple_opt; split. apply H. rewrite H5 in H3; apply H3. elim H7; intro. - simpl in |- *; elim H8; intro. + simpl; 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. + ; 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 ]. + [ assumption | simpl; right; left; reflexivity ]. eapply StepFun_P7. apply H1. apply H2. - unfold adapted_couple_opt in |- *; split. + unfold adapted_couple_opt; 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. + unfold adapted_couple; repeat split. + unfold ordered_Rlist; intros; simpl in H; induction i as [| i Hreci]. + simpl; rewrite <- H20; apply (H11 0%nat). + simpl; 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. + simpl; assumption. + change (pos_Rl (cons s2 s3) i <= pos_Rl (cons s2 s3) (S i)); + apply (H15 (S i)); simpl; apply lt_S_n; assumption. + simpl; symmetry ; 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; + simpl in H19; simpl; rewrite H19; reflexivity. + intros; simpl in H; unfold constant_D_eq, open_interval; 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. + simpl; apply (H16 0%nat). + simpl; apply lt_O_Sn. + simpl in H2; rewrite <- H20 in H2; unfold open_interval; + simpl; 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. + simpl; simpl in H2; rewrite H9; apply (H21 0%nat). + simpl; apply lt_O_Sn. + unfold open_interval; simpl; elim H2; intros; split. apply Rle_lt_trans with r1; try assumption; rewrite <- H6; apply (H11 0%nat); - simpl in |- *; apply lt_O_Sn. + simpl; 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. + clear Hreci; simpl; apply (H21 (S i)). + simpl; apply lt_S_n; assumption. + unfold open_interval; apply H2. elim H3; clear H3; intros; split. rewrite H9; change @@ -817,64 +817,64 @@ Proof. (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; apply H3. rewrite H5 in H11; intros; simpl in H12; induction i as [| i Hreci]. - simpl in |- *; red in |- *; intro; rewrite H13 in H10; + simpl; red; intro; rewrite H13 in H10; elim (Rlt_irrefl _ H10). - clear Hreci; apply (H11 (S i)); simpl in |- *; apply H12. + clear Hreci; apply (H11 (S i)); simpl; 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 ]. + [ assumption | simpl; right; left; reflexivity ]. eapply StepFun_P7. apply H1. apply H2. - unfold adapted_couple_opt in |- *; split. + unfold adapted_couple_opt; 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 |- *; + unfold adapted_couple; repeat split. + unfold ordered_Rlist; intros; simpl in H; induction i as [| i Hreci]. + simpl; rewrite <- H20; apply (H11 0%nat); simpl; apply lt_O_Sn. - rewrite H10; apply (H15 (S i)); simpl in |- *; assumption. - simpl in |- *; symmetry in |- *; apply Hyp_min. + rewrite H10; apply (H15 (S i)); simpl; assumption. + simpl; symmetry ; 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; + simpl in H19; simpl; apply H19. + intros; simpl in H; unfold constant_D_eq, open_interval; 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. + simpl; apply (H16 0%nat). + simpl; apply lt_O_Sn. + simpl in H2; rewrite <- H20 in H2; unfold open_interval; + simpl; apply H2. + clear Hreci; simpl; apply (H21 (S i)). + simpl; assumption. + rewrite <- H10; unfold open_interval; 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))). + simpl; 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 |- *; + symmetry ; apply S_pred with 0%nat; apply neq_O_lt; red; 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; + simpl; apply lt_n_S; apply H12. + simpl; rewrite H9; unfold Rminus; 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. + ; eapply H0. apply H1. - 2: rewrite H5 in H3; unfold adapted_couple_opt in |- *; split; assumption. + 2: rewrite H5 in H3; unfold adapted_couple_opt; 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; + | pattern a at 2; rewrite <- H10; pattern r at 2; rewrite H9; apply H2 ]. Qed. @@ -918,12 +918,12 @@ Qed. Lemma StepFun_P18 : 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. + intros; unfold RiemannInt_SF; 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 + [ simpl; ring | apply StepFun_P17 with (fct_cte c) a b; [ apply StepFun_P3; assumption | apply (StepFun_P1 (mkStepFun (StepFun_P4 a b c))) ] ]. @@ -931,7 +931,7 @@ Proof. (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 + [ simpl; 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))) ] ]. @@ -943,8 +943,8 @@ Lemma StepFun_P19 : 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 |- *; + [ simpl; ring + | induction l1 as [| r0 l1 Hrecl0]; simpl; [ ring | simpl in Hrecl1; rewrite Hrecl1; ring ] ]. Qed. @@ -954,38 +954,38 @@ Lemma StepFun_P20 : Proof. intros l f H; induction l; [ elim (lt_irrefl _ H) - | simpl in |- *; rewrite RList_P18; rewrite RList_P14; reflexivity ]. + | simpl; 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). Proof. - intros; unfold adapted_couple in |- *; unfold is_subdivision in X; + intros; unfold adapted_couple; 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; + unfold constant_D_eq, open_interval; 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 |- *; + unfold FF; rewrite RList_P12. + simpl; + change (f x0 = f (pos_Rl (mid_Rlist (cons r l) r) (S i))); 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; + | unfold Rdiv; 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; + | unfold Rdiv; 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)); @@ -1001,22 +1001,22 @@ Lemma StepFun_P22 : 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; + unfold is_subdivision; 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; + unfold Rmin; 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; + unfold Rmax; 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 |- *; + rewrite Hyp_max in H5; unfold adapted_couple; repeat split. apply RList_P2; assumption. - rewrite Hyp_min; symmetry in |- *; apply Rle_antisym. + rewrite Hyp_min; symmetry ; apply Rle_antisym. induction lf as [| r lf Hreclf]. - simpl in |- *; right; symmetry in |- *; assumption. + simpl; right; symmetry ; assumption. assert (H10 : In (pos_Rl (cons_ORlist (cons r lf) lg) 0) (cons_ORlist (cons r lf) lg)). @@ -1024,7 +1024,7 @@ Proof. (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 ]. + [ reflexivity | rewrite RList_P11; simpl; 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)); @@ -1037,16 +1037,16 @@ Proof. 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. + simpl; 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 ]. + [ symmetry ; assumption | simpl; 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. + simpl; right; assumption. assert (H8 : In @@ -1059,7 +1059,7 @@ Proof. (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 ]. + split; [ reflexivity | rewrite RList_P11; simpl; apply lt_n_Sn ]. elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) @@ -1074,8 +1074,8 @@ Proof. 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 ]. + | simpl; simpl in H14; apply lt_n_Sm_le; assumption + | simpl; apply lt_n_Sn ]. elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) @@ -1083,23 +1083,23 @@ Proof. 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; + apply S_pred with 0%nat; apply neq_O_lt; red; 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. + simpl; right; symmetry ; 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 ]. + [ symmetry ; assumption | simpl; 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 StepFun_P20; rewrite RList_P11; rewrite H2; rewrite H7; simpl; apply lt_O_Sn. - intros; unfold constant_D_eq, open_interval in |- *; intros; + intros; unfold constant_D_eq, open_interval; intros; cut (exists l : R, constant_D_eq f @@ -1109,10 +1109,10 @@ Proof. 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). + apply RList_P19; red; 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 |- *; + unfold FF; rewrite RList_P12. + change (f x = f (pos_Rl (mid_Rlist (cons r r0) r) (S i))); 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); @@ -1124,13 +1124,13 @@ Proof. split. apply Rmult_lt_reg_l with 2; [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + | unfold Rdiv; 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; + | unfold Rdiv; 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)); @@ -1149,7 +1149,7 @@ Proof. 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; + | apply lt_pred_n_n; apply neq_O_lt; red; intro; rewrite <- H13 in H8; elim (lt_n_O _ H8) ]. assumption. assumption. @@ -1160,7 +1160,7 @@ Proof. 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; + apply lt_pred_n_n; apply neq_O_lt; red; intro; rewrite <- H13 in H8; elim (lt_n_O _ H8). rewrite H0; assumption. set @@ -1168,24 +1168,24 @@ Proof. 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; + unfold Nbound; 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. + exists 0%nat; unfold I; split. apply Rle_trans with (pos_Rl (cons_ORlist lf lg) 0). - right; symmetry in |- *. + right; symmetry . 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; + apply lt_pred_n_n; apply neq_O_lt; red; intro; rewrite <- H15 in H8; elim (lt_n_O _ H8). - apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H5; + apply neq_O_lt; red; 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 |- *; + exists (pos_Rl lf0 x0); unfold constant_D_eq, open_interval; 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). @@ -1203,11 +1203,11 @@ Proof. 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; + apply lt_pred_n_n; apply neq_O_lt; red; 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; + apply S_pred with 0%nat; apply neq_O_lt; red; 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). @@ -1219,11 +1219,11 @@ Proof. 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 |- *; + | symmetry ; apply S_pred with 0%nat; apply neq_O_lt; red; 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. + apply H20; unfold I; split; assumption. elim (le_Sn_n _ H23). assert (H23 : pos_Rl (cons_ORlist lf lg) i < pos_Rl lf (S x0)). auto with real. @@ -1253,22 +1253,22 @@ Lemma StepFun_P24 : 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; + unfold is_subdivision; 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; + unfold Rmin; 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; + unfold Rmax; 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 |- *; + rewrite Hyp_max in H5; unfold adapted_couple; repeat split. apply RList_P2; assumption. - rewrite Hyp_min; symmetry in |- *; apply Rle_antisym. + rewrite Hyp_min; symmetry ; apply Rle_antisym. induction lf as [| r lf Hreclf]. - simpl in |- *; right; symmetry in |- *; assumption. + simpl; right; symmetry ; assumption. assert (H10 : In (pos_Rl (cons_ORlist (cons r lf) lg) 0) (cons_ORlist (cons r lf) lg)). @@ -1276,7 +1276,7 @@ Proof. (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 ]. + [ reflexivity | rewrite RList_P11; simpl; 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)); @@ -1289,16 +1289,16 @@ Proof. 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. + simpl; 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 ]. + [ symmetry ; assumption | simpl; 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. + simpl; right; assumption. assert (H8 : In @@ -1311,7 +1311,7 @@ Proof. (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 ]. + split; [ reflexivity | rewrite RList_P11; simpl; apply lt_n_Sn ]. elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) @@ -1325,8 +1325,8 @@ Proof. 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 ]. + | simpl; simpl in H14; apply lt_n_Sm_le; assumption + | simpl; apply lt_n_Sn ]. elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) @@ -1334,23 +1334,23 @@ Proof. 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; + apply S_pred with 0%nat; apply neq_O_lt; red; 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. + simpl; right; symmetry ; 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 ]. + [ symmetry ; assumption | simpl; 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 StepFun_P20; rewrite RList_P11; rewrite H7; rewrite H2; simpl; apply lt_O_Sn. - unfold constant_D_eq, open_interval in |- *; intros; + unfold constant_D_eq, open_interval; intros; cut (exists l : R, constant_D_eq g @@ -1360,10 +1360,10 @@ Proof. 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). + apply RList_P19; red; 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 |- *; + unfold FF; rewrite RList_P12. + change (g x = g (pos_Rl (mid_Rlist (cons r r0) r) (S i))); 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); @@ -1375,13 +1375,13 @@ Proof. split. apply Rmult_lt_reg_l with 2; [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + | unfold Rdiv; 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; + | unfold Rdiv; 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)); @@ -1400,7 +1400,7 @@ Proof. 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; + | apply lt_pred_n_n; apply neq_O_lt; red; 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)). @@ -1409,7 +1409,7 @@ Proof. 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; + apply lt_pred_n_n; apply neq_O_lt; red; intro; rewrite <- H13 in H8; elim (lt_n_O _ H8). rewrite H0; assumption. set @@ -1417,24 +1417,24 @@ Proof. 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; + unfold Nbound; 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. + exists 0%nat; unfold I; split. apply Rle_trans with (pos_Rl (cons_ORlist lf lg) 0). - right; symmetry in |- *; rewrite H1; rewrite <- H6; apply RList_P15; + right; symmetry ; 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; + | apply lt_pred_n_n; apply neq_O_lt; red; intro; rewrite <- H15 in H8; elim (lt_n_O _ H8) ] ]. - apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H0; + apply neq_O_lt; red; 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 |- *; + exists (pos_Rl lg0 x0); unfold constant_D_eq, open_interval; 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). @@ -1452,12 +1452,12 @@ Proof. 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; + apply lt_pred_n_n; apply neq_O_lt; red; 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; + apply S_pred with 0%nat; apply neq_O_lt; red; 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). @@ -1469,11 +1469,11 @@ Proof. 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 |- *; + symmetry ; apply S_pred with 0%nat; apply neq_O_lt; red; 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) ]. + [ apply H20; unfold I; 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; @@ -1509,35 +1509,35 @@ Proof. 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). + red; intro H11; rewrite H11 in H8; elim (lt_n_O _ H8). destruct (RList_P19 _ H11) as (r,(r0,H12)); - rewrite H12; unfold FF in |- *; + rewrite H12; unfold FF; 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. + (S i)); 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)); + | unfold Rdiv; 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)); + | unfold Rdiv; 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; + rewrite RList_P14; simpl; rewrite H12 in H8; simpl in H8; apply lt_n_S; apply H8. Qed. @@ -1556,7 +1556,7 @@ Qed. Lemma StepFun_P28 : 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); + intros a b l f g; unfold IsStepFun; 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. @@ -1565,7 +1565,7 @@ Qed. Lemma StepFun_P29 : forall (a b:R) (f:StepFun a b), is_subdivision f a b (subdivision f). Proof. - intros a b f; unfold is_subdivision in |- *; + intros a b f; unfold is_subdivision; apply existT with (subdivision_val f); apply StepFun_P1. Qed. @@ -1574,7 +1574,7 @@ Lemma StepFun_P30 : 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); + intros a b l f g; unfold RiemannInt_SF; case (Rle_dec a b); (intro; replace (Int_SF (subdivision_val (mkStepFun (StepFun_P28 l f g))) @@ -1611,10 +1611,10 @@ Lemma StepFun_P31 : 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; + unfold adapted_couple; 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 |- *; + symmetry ; rewrite H3; rewrite RList_P18; reflexivity. + intros; unfold constant_D_eq, open_interval; 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 ]. @@ -1623,8 +1623,8 @@ Qed. Lemma StepFun_P32 : 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 |- *; + intros a b f; unfold IsStepFun; apply existT with (subdivision f); + unfold is_subdivision; apply existT with (app_Rlist (subdivision_val f) Rabs); apply StepFun_P31; apply StepFun_P1. Qed. @@ -1634,8 +1634,8 @@ Lemma StepFun_P33 : 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]. + simpl; rewrite Rabs_R0; right; reflexivity. + simpl; induction l1 as [| r1 l1 Hrecl1]. rewrite Rabs_R0; right; reflexivity. induction l1 as [| r2 l1 Hrecl0]. rewrite Rabs_R0; right; reflexivity. @@ -1643,7 +1643,7 @@ Proof. 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 Rge_minus; apply Rle_ge; apply (H0 0%nat); simpl; apply lt_O_Sn ]. Qed. @@ -1652,7 +1652,7 @@ Lemma StepFun_P34 : a <= b -> Rabs (RiemannInt_SF f) <= RiemannInt_SF (mkStepFun (StepFun_P32 f)). Proof. - intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro. + intros; unfold RiemannInt_SF; case (Rle_dec a b); intro. replace (Int_SF (subdivision_val (mkStepFun (StepFun_P32 f))) (subdivision (mkStepFun (StepFun_P32 f)))) with @@ -1676,18 +1676,18 @@ Lemma StepFun_P35 : Proof. simple induction l; intros. right; reflexivity. - simpl in |- *; induction r0 as [| r0 r1 Hrecr0]. + simpl; induction r0 as [| r0 r1 Hrecr0]. right; reflexivity. - simpl in |- *; apply Rplus_le_compat. + simpl; 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 Rge_le; apply Rge_minus; apply Rle_ge; apply (H0 0%nat); simpl; 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; + unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. assert (H5 : r = a). apply H1. @@ -1700,7 +1700,7 @@ Proof. discrR. apply Rmult_lt_reg_l with 2. prove_sup0. - unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. rewrite Rmult_1_l; rewrite double; assert (H5 : r0 <= b). replace b with @@ -1708,9 +1708,9 @@ Proof. 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. + simpl; apply le_n_S. apply le_O_n. - simpl in |- *; apply lt_n_Sn. + simpl; apply lt_n_Sn. reflexivity. apply Rle_lt_trans with (r + b). apply Rplus_le_compat_l; assumption. @@ -1730,7 +1730,7 @@ Proof. 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. + simpl; apply (H0 0%nat); simpl; apply lt_O_Sn. Qed. Lemma StepFun_P36 : @@ -1741,16 +1741,16 @@ Lemma StepFun_P36 : (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. + intros; unfold RiemannInt_SF; 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; + [ unfold Rmin; 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; + [ unfold Rmax; 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 ] ]. @@ -1809,27 +1809,27 @@ Proof. 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; + unfold IsStepFun; 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 is_subdivision; 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; + unfold adapted_couple; repeat split. + unfold ordered_Rlist; 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; + simpl; rewrite H12; replace (Rmin r1 b) with r1. + simpl in H0; rewrite <- H0; apply (H 0%nat); simpl; apply lt_O_Sn. + unfold Rmin; 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). + simpl; 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; + unfold Rmin; case (Rle_dec a b); intro; [ reflexivity | elim n; assumption ]. assert (H14 : a <= b). rewrite <- H1; simpl in H0; rewrite <- H0; apply RList_P7; @@ -1838,30 +1838,30 @@ Proof. 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; + unfold Rmax; case (Rle_dec a b); case (Rle_dec r1 b); intros; reflexivity || elim n; assumption. - simpl in |- *; rewrite H13; reflexivity. + simpl; rewrite H13; reflexivity. intros; simpl in H9; induction i as [| i Hreci]. - unfold constant_D_eq, open_interval in |- *; simpl in |- *; intros; + unfold constant_D_eq, open_interval; simpl; intros; assert (H16 : Rmin r1 b = r1). - unfold Rmin in |- *; case (Rle_dec r1 b); intro; + unfold Rmin; 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. + unfold g'; 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); + (pos_Rl lg2 i)); 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; + apply S_pred with 0%nat; apply neq_O_lt; red; 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 |- *; + unfold constant_D_eq, open_interval; intros; + assert (H19 := H18 _ H14); rewrite <- H19; unfold g'; case (Rle_dec r1 x); intro. reflexivity. elim n; replace r1 with (Rmin r1 b). @@ -1872,17 +1872,17 @@ Proof. 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; + apply lt_pred_n_n; apply neq_O_lt; red; intro; rewrite <- H22 in H17; elim (lt_n_O _ H17). - unfold Rmin in |- *; case (Rle_dec r1 b); intro; + unfold Rmin; 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. + simpl; unfold g'; 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 |- *; + unfold constant_D_eq, co_interval; simpl; intros; simpl in H0; + rewrite H0; elim H10; clear H10; intros; unfold g'; case (Rle_dec r1 x); intro r3. elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H11)). reflexivity. @@ -1890,21 +1890,21 @@ Proof. 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); + (f (pos_Rl (cons r1 l) i))); assert (H10 := H6 i); assert (H11 : (i < pred (Rlength (cons r1 l)))%nat). - simpl in |- *; apply lt_S_n; assumption. + simpl; 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 |- *; + unfold constant_D_eq, co_interval; intros; + rewrite <- (H12 _ H13); simpl; unfold g'; 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 |- *; + change (pos_Rl (cons r1 l) 0 <= pos_Rl (cons r1 l) i); elim (RList_P6 (cons r1 l)); intros; apply H15; [ assumption | apply le_O_n - | simpl in |- *; apply lt_trans with (Rlength l); + | simpl; apply lt_trans with (Rlength l); [ apply lt_S_n; assumption | apply lt_n_Sn ] ]. Qed. @@ -1912,7 +1912,7 @@ Lemma StepFun_P39 : 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; unfold RiemannInt_SF; 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 @@ -1925,16 +1925,16 @@ Proof. | 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 ] ] ] ]. + [ symmetry ; 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 H; intros; unfold is_subdivision; 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 H; intros; unfold is_subdivision; elim p; intros; apply p0 ]. assert (H : a < b); [ auto with real @@ -1951,34 +1951,34 @@ Lemma StepFun_P40 : 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; + unfold adapted_couple; 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); + rewrite H10; rewrite H4; unfold Rmin, Rmax; 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); + rewrite H5; unfold Rmin, Rmax; 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. + red; 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); + rewrite H9; unfold Rmin, Rmax; 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. + red; intro; rewrite H1 in H11; discriminate. apply StepFun_P20. - rewrite RList_P23; apply neq_O_lt; red in |- *; intro. + rewrite RList_P23; apply neq_O_lt; red; intro. assert (H2 : (Rlength l1 + Rlength l2)%nat = 0%nat). - symmetry in |- *; apply H1. + symmetry ; apply H1. elim (plus_is_O _ _ H2); intros; rewrite H12 in H6; discriminate. - unfold constant_D_eq, open_interval in |- *; intros; + unfold constant_D_eq, open_interval; 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; @@ -1991,28 +1991,28 @@ Proof. 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. + ; rewrite RList_P12. induction i as [| i Hreci]. - simpl in |- *; assert (H18 := H8 0%nat); + simpl; 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. + rewrite H17; simpl; 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. + simpl; apply lt_O_Sn. elim H21; intro. split. - rewrite H17; simpl in |- *; apply Rmult_lt_reg_l with 2; + rewrite H17; simpl; apply Rmult_lt_reg_l with 2; [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + | unfold Rdiv; 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; + rewrite H17; simpl; apply Rmult_lt_reg_l with 2; [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + | unfold Rdiv; 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 @@ -2041,13 +2041,13 @@ Proof. split. apply Rmult_lt_reg_l with 2; [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + | unfold Rdiv; 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; + | unfold Rdiv; 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 @@ -2055,21 +2055,21 @@ Proof. 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. + simpl; 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 |- *; + rewrite H15; rewrite <- minus_n_n; rewrite H10; unfold Rmin; 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. + clear Hrecl1; simpl in H1; simpl; 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; + [ rewrite H4; unfold Rmax; case (Rle_dec a b); intro; [ reflexivity | elim n; left; assumption ] | rewrite H15; reflexivity ]. rewrite H15; apply lt_n_Sn. @@ -2087,22 +2087,22 @@ Proof. 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. + clear Hrecl1; simpl in H1; simpl; apply lt_n_S; assumption. + symmetry ; 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; + unfold Rmin, Rmax; 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. + clear Hrecl1; simpl; 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. + ; 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). @@ -2120,7 +2120,7 @@ Proof. 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 H19 in H1; simpl in H1; rewrite H19; simpl; 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. @@ -2132,7 +2132,7 @@ Proof. 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 H19 in H1; simpl in H1; rewrite H19; simpl; 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. @@ -2140,13 +2140,13 @@ Proof. split. apply Rmult_lt_reg_l with 2; [ prove_sup0 - | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; + | unfold Rdiv; 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; + | unfold Rdiv; 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 @@ -2157,14 +2157,14 @@ Proof. 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. + rewrite H19; simpl; 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 H19; simpl; 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. + simpl; rewrite H19 in H1; simpl in H1; apply lt_S_n; assumption. + rewrite RList_P14; rewrite H19 in H1; simpl in H1; simpl; apply H1. Qed. Lemma StepFun_P41 : @@ -2189,11 +2189,11 @@ Lemma StepFun_P42 : 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 + [ simpl; 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; + [ simpl in H; simpl; destruct l2 as [| r0 r1]; + [ simpl; ring | simpl; simpl in H; rewrite H; ring ] + | simpl; rewrite Rplus_assoc; apply Rplus_eq_compat_l; apply IHl1; rewrite <- H; reflexivity ] ]. Qed. @@ -2229,27 +2229,27 @@ Proof. (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. + symmetry ; 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 |- *; + clear H1 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin; 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; + [ apply StepFun_P21; unfold is_subdivision; split with lf2; apply H2; assumption | assumption ]. eapply StepFun_P17; - [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1 + [ apply StepFun_P21; unfold is_subdivision; 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 ]. + symmetry ; 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 ]. + symmetry ; 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 @@ -2264,24 +2264,24 @@ Proof. 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 |- *; + clear H3 H2; rewrite H10; rewrite H6; unfold Rmax, Rmin; 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 + [ apply StepFun_P21; unfold is_subdivision; split with lf2; apply H2 | assumption ]. eapply StepFun_P17; - [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3 + [ apply StepFun_P21; unfold is_subdivision; 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 ]. + symmetry ; eapply StepFun_P8; [ apply H3 | assumption ]. replace (Int_SF lf2 l2) with (Int_SF lf3 l3 + Int_SF lf1 l1). ring. elim r; intro. @@ -2289,19 +2289,19 @@ Proof. (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. + symmetry ; 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 |- *; + clear H3 H1; rewrite H9; rewrite H5; unfold Rmax, Rmin; 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 + [ apply StepFun_P21; unfold is_subdivision; split with lf1; apply H1 | assumption ]. eapply StepFun_P17; - [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3 + [ apply StepFun_P21; unfold is_subdivision; split with lf3; apply H3 | assumption ]. eapply StepFun_P17. assert (H0 : c < a). @@ -2311,7 +2311,7 @@ Proof. 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 ]. + symmetry ; 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). @@ -2321,19 +2321,19 @@ Proof. (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. + symmetry ; 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 |- *; + clear H3 H1; rewrite H11; rewrite H5; unfold Rmax, Rmin; 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 + [ apply StepFun_P21; unfold is_subdivision; split with lf1; apply H1 | assumption ]. eapply StepFun_P17; - [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3 + [ apply StepFun_P21; unfold is_subdivision; split with lf3; apply H3 | assumption ]. eapply StepFun_P17. apply (StepFun_P40 H H0 (StepFun_P2 H1) H3). @@ -2341,7 +2341,7 @@ Proof. 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 ]. + symmetry ; 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). @@ -2351,19 +2351,19 @@ Proof. (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. + symmetry ; 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 |- *; + clear H3 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin; 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 + [ apply StepFun_P21; unfold is_subdivision; split with lf2; apply H2 | assumption ]. eapply StepFun_P17; - [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3 + [ apply StepFun_P21; unfold is_subdivision; split with lf3; apply H3 | assumption ]. eapply StepFun_P17. apply (StepFun_P40 H0 H H2 (StepFun_P2 H3)). @@ -2371,7 +2371,7 @@ Proof. 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 ]. + symmetry ; eapply StepFun_P8; [ apply H2 | assumption ]. elim n; apply Rle_trans with a; try assumption. auto with real. assert (H : c < b). @@ -2384,56 +2384,56 @@ Proof. (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. + symmetry ; 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 |- *; + clear H1 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin; 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 + [ apply StepFun_P21; unfold is_subdivision; split with lf2; apply H2 | assumption ]. eapply StepFun_P17; - [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1 + [ apply StepFun_P21; unfold is_subdivision; 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. + unfold RiemannInt_SF; 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. + (subdivision_val (mkStepFun pr3))); 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. + (subdivision_val (mkStepFun pr3))); apply StepFun_P1. + unfold RiemannInt_SF; 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. + (subdivision_val (mkStepFun pr2))); 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. + (subdivision_val (mkStepFun pr2))); apply StepFun_P1. + unfold RiemannInt_SF; 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. + (subdivision_val (mkStepFun pr1))); 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. + (subdivision_val (mkStepFun pr1))); apply StepFun_P1. Qed. Lemma StepFun_P44 : @@ -2449,7 +2449,7 @@ Proof. adapted_couple f a b l1 lf1 -> a <= c <= b -> { l:Rlist & { l0:Rlist & adapted_couple f a c l l0 } }). - intro X; unfold IsStepFun in |- *; unfold is_subdivision in |- *; eapply X. + intro X; unfold IsStepFun; unfold is_subdivision; eapply X. apply H2. split; assumption. clear f a b c H0 H H1 H2 l1 lf1; simple induction l1. @@ -2461,11 +2461,11 @@ Proof. 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). + pattern b at 2; replace b with (Rmax a b). rewrite <- H2; rewrite H3; reflexivity. - unfold Rmax in |- *; case (Rle_dec a b); intro; + unfold Rmax; case (Rle_dec a b); intro; [ reflexivity | elim n; assumption ]. - unfold Rmin in |- *; case (Rle_dec a b); intro; + unfold Rmin; 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. @@ -2479,22 +2479,22 @@ Proof. 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; + simpl in H4; rewrite H4; unfold Rmin; 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; + elim H0; clear H0; intros; unfold adapted_couple; repeat split. + rewrite H6; unfold ordered_Rlist; intros; simpl in H8; inversion H8; + [ simpl; assumption | elim (le_Sn_O _ H10) ]. + simpl; unfold Rmin; case (Rle_dec a c); intro; [ assumption | elim n; assumption ]. - simpl in |- *; unfold Rmax in |- *; case (Rle_dec a c); intro; + simpl; unfold Rmax; case (Rle_dec a c); intro; [ reflexivity | elim n; assumption ]. - unfold constant_D_eq, open_interval in |- *; intros; simpl in H8; + unfold constant_D_eq, open_interval; intros; simpl in H8; inversion H8. - simpl in |- *; assert (H10 := H7 0%nat); + simpl; 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 |- *; + simpl; apply lt_O_Sn. + apply (H10 H12); unfold open_interval; simpl; rewrite H11 in H9; simpl in H9; elim H9; clear H9; intros; split; try assumption. apply Rlt_le_trans with c; assumption. @@ -2508,42 +2508,42 @@ Proof. 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; + simpl in H7; rewrite H7; unfold Rmin; 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. + clear Hrecl1'; unfold adapted_couple; repeat split. + unfold ordered_Rlist; intros; simpl in H; induction i as [| i Hreci]. + simpl; 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; + simpl; apply lt_O_Sn. + simpl in H12; rewrite H12; unfold Rmin; 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; + apply (H9 i); simpl; apply lt_S_n; assumption. + simpl; unfold Rmin; 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; + unfold Rmax; 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; + simpl; simpl in H13; rewrite H13; reflexivity. + intros; simpl in H; unfold constant_D_eq, open_interval; intros; induction i as [| i Hreci]. - simpl in |- *; assert (H17 := H10 0%nat); + simpl; 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; + simpl; apply lt_O_Sn. + apply (H17 H18); unfold open_interval; simpl; 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; + simpl in H12; rewrite H12; unfold Rmin; 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. + clear Hreci; simpl; apply H15. + simpl; apply lt_S_n; assumption. + unfold open_interval; apply H4. split. left; assumption. elim H0; intros; assumption. @@ -2565,7 +2565,7 @@ Proof. adapted_couple f a b l1 lf1 -> a <= c <= b -> { l:Rlist & { l0:Rlist & adapted_couple f c b l l0 } }). - intro X; unfold IsStepFun in |- *; unfold is_subdivision in |- *; eapply X; + intro X; unfold IsStepFun; unfold is_subdivision; 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; @@ -2576,11 +2576,11 @@ Proof. 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). + pattern b at 2; replace b with (Rmax a b). rewrite <- H2; rewrite H3; reflexivity. - unfold Rmax in |- *; case (Rle_dec a b); intro; + unfold Rmax; case (Rle_dec a b); intro; [ reflexivity | elim n; assumption ]. - unfold Rmin in |- *; case (Rle_dec a b); intro; + unfold Rmin; 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. @@ -2593,32 +2593,32 @@ Proof. 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; + unfold adapted_couple; repeat split. + unfold ordered_Rlist; intros; simpl in H; induction i as [| i Hreci]. + simpl; assumption. + clear Hreci; apply (H2 (S i)); simpl; assumption. + simpl; unfold Rmin; 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; + unfold Rmax; 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. + simpl; simpl in H5; apply H5. intros; simpl in H; induction i as [| i Hreci]. - unfold constant_D_eq, open_interval in |- *; intros; simpl in |- *; + unfold constant_D_eq, open_interval; intros; simpl; apply (H7 0%nat). - simpl in |- *; apply lt_O_Sn. - unfold open_interval in |- *; simpl in |- *; simpl in H6; elim H6; clear H6; + simpl; apply lt_O_Sn. + unfold open_interval; simpl; 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; + simpl in H4; rewrite H4; unfold Rmin; 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. + clear Hreci; apply (H7 (S i)); simpl; 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'; diff --git a/theories/Reals/Rlimit.v b/theories/Reals/Rlimit.v index 5c864de3..c5ee828a 100644 --- a/theories/Reals/Rlimit.v +++ b/theories/Reals/Rlimit.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -14,7 +14,7 @@ Require Import Rbase. Require Import Rfunctions. Require Import Fourier. -Open Local Scope R_scope. +Local Open Scope R_scope. (*******************************) (** * Calculus *) @@ -31,7 +31,7 @@ Proof. intro esp. assert (H := double_var esp). unfold Rdiv in H. - symmetry in |- *; exact H. + symmetry ; exact H. Qed. (*********) @@ -39,9 +39,9 @@ Lemma eps4 : forall eps:R, eps * / (2 + 2) + eps * / (2 + 2) = eps * / 2. Proof. intro eps. replace (2 + 2) with 4. - pattern eps at 3 in |- *; rewrite double_var. + pattern eps at 3; rewrite double_var. rewrite (Rmult_plus_distr_r (eps / 2) (eps / 2) (/ 2)). - unfold Rdiv in |- *. + unfold Rdiv. repeat rewrite Rmult_assoc. rewrite <- Rinv_mult_distr. reflexivity. @@ -54,7 +54,7 @@ Qed. Lemma Rlt_eps2_eps : forall eps:R, eps > 0 -> eps * / 2 < eps. Proof. intros. - pattern eps at 2 in |- *; rewrite <- Rmult_1_r. + pattern eps at 2; rewrite <- Rmult_1_r. repeat rewrite (Rmult_comm eps). apply Rmult_lt_compat_r. exact H. @@ -70,7 +70,7 @@ Lemma Rlt_eps4_eps : forall eps:R, eps > 0 -> eps * / (2 + 2) < eps. Proof. intros. replace (2 + 2) with 4. - pattern eps at 2 in |- *; rewrite <- Rmult_1_r. + pattern eps at 2; rewrite <- Rmult_1_r. repeat rewrite (Rmult_comm eps). apply Rmult_lt_compat_r. exact H. @@ -113,10 +113,10 @@ Qed. (*********) Lemma mul_factor_gt : forall eps l l':R, eps > 0 -> eps * mul_factor l l' > 0. Proof. - intros; unfold Rgt in |- *; rewrite <- (Rmult_0_r eps); + intros; unfold Rgt; rewrite <- (Rmult_0_r eps); apply Rmult_lt_compat_l. assumption. - unfold mul_factor in |- *; apply Rinv_0_lt_compat; + unfold mul_factor; apply Rinv_0_lt_compat; cut (1 <= 1 + (Rabs l + Rabs l')). cut (0 < 1). exact (Rlt_le_trans _ _ _). @@ -196,7 +196,7 @@ Proof. 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. + case (dist_refl R_met (f x0) l); intros Hr1 Hr2; symmetry; auto. Qed. (*********) @@ -210,7 +210,7 @@ Qed. (*********) Lemma lim_x : forall (D:R -> Prop) (x0:R), limit1_in (fun x:R => x) D x0 x0. Proof. - unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros; + unfold limit1_in; unfold limit_in; simpl; intros; split with eps; split; auto; intros; elim H0; intros; auto. Qed. @@ -221,9 +221,9 @@ Lemma limit_plus : 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; unfold limit1_in; unfold limit_in; simpl; intros; elim (H (eps * / 2) (eps2_Rgt_R0 eps H1)); - elim (H0 (eps * / 2) (eps2_Rgt_R0 eps H1)); simpl in |- *; + elim (H0 (eps * / 2) (eps2_Rgt_R0 eps H1)); simpl; 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)). @@ -244,12 +244,12 @@ 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. Proof. - unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros; + unfold limit1_in; unfold limit_in; simpl; 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 |- *; + clear H1; intro; unfold R_dist; unfold Rminus; rewrite (Ropp_involutive l); rewrite (Rplus_comm (- f x1) l); - fold (l - f x1) in |- *; fold (R_dist l (f x1)) in |- *; + fold (l - f x1); fold (R_dist l (f x1)); rewrite R_dist_sym; assumption. Qed. @@ -259,7 +259,7 @@ Lemma limit_minus : 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; + intros; unfold Rminus; 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. @@ -268,9 +268,9 @@ Lemma limit_free : 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; + unfold limit1_in; unfold limit_in; simpl; 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; + intros a b; rewrite (b (eq_refl (f x))); unfold Rgt in H; assumption. Qed. @@ -280,14 +280,14 @@ Lemma limit_mul : 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; unfold limit1_in; unfold limit_in; simpl; 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; simpl; 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 |- *; + intros; elim H4; clear H4; intros; unfold R_dist; 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 @@ -309,7 +309,7 @@ Proof. 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; + rewrite (Rplus_comm 1 (Rabs l)); unfold Rgt; 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)). @@ -323,13 +323,13 @@ Proof. generalize (H3 x2 (conj H4 H6)); trivial. apply Rmult_le_compat_l. exact (Rabs_pos l'). - unfold Rle in |- *; left; assumption. + unfold Rle; 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 (Rplus_assoc 1 (Rabs l) (Rabs l')); unfold mul_factor; rewrite (Rinv_l (1 + (Rabs l + Rabs l')) (mul_factor_wd l l')); rewrite (proj1 (Rmult_ne eps)); apply Req_le; trivial. ring. @@ -344,10 +344,10 @@ 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'. Proof. - unfold limit1_in in |- *; unfold limit_in in |- *; intros. + unfold limit1_in; unfold limit_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. + clear H0 H1; unfold dist; unfold R_met; unfold R_dist; + unfold Rabs; 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; @@ -358,10 +358,10 @@ Proof. 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); + unfold Rgt; 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)); + unfold Rgt; 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). @@ -380,10 +380,10 @@ Proof. 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); + unfold Rgt; 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)); + unfold Rgt; 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). @@ -393,7 +393,7 @@ Proof. (**) 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); + simpl; 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; @@ -403,10 +403,10 @@ Proof. 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; + unfold R_dist; 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 |- *; + generalize (R_dist_tri l l' (f x2)); unfold R_dist; intros; apply (Rle_lt_trans (Rabs (l - l')) (Rabs (l - f x2) + Rabs (f x2 - l')) @@ -419,7 +419,7 @@ Lemma limit_comp : 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 |- *. + unfold limit1_in, limit_in, Dgf; simpl. intros f g Df Dg l l' x0 Hf Hg eps eps_pos. elim (Hg eps eps_pos). intros alpg lg. @@ -436,12 +436,12 @@ 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. Proof. - unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; - unfold R_dist in |- *; intros; elim (H (Rabs l / 2)). + unfold limit1_in; unfold limit_in; simpl; + unfold R_dist; 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. + unfold Rmin; 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). @@ -455,7 +455,7 @@ Proof. (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; + unfold Rminus; 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. @@ -467,7 +467,7 @@ Proof. (/ 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. + unfold Rdiv; unfold Rsqr; rewrite Rinv_mult_distr. repeat rewrite Rmult_assoc. rewrite (Rmult_comm l). repeat rewrite Rmult_assoc. @@ -487,7 +487,7 @@ Proof. 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 (Rsqr_abs l); unfold Rsqr; unfold Rdiv; rewrite Rinv_mult_distr. repeat rewrite <- Rmult_assoc; apply Rmult_lt_compat_r. apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. @@ -496,7 +496,7 @@ Proof. 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 H17; generalize (lt_INR_0 2 (neq_O_lt 2 H17)); unfold INR; intro H18; assumption | discriminate ]. replace (Rabs (f x) * Rabs l * / 2 * / Rabs (f x)) with (Rabs l / 2). @@ -512,7 +512,7 @@ Proof. discrR. apply Rabs_no_R0. assumption. - unfold Rdiv in |- *. + unfold Rdiv. repeat rewrite Rmult_assoc. rewrite (Rmult_comm (Rabs (f x))). repeat rewrite Rmult_assoc. @@ -526,7 +526,7 @@ Proof. apply Rabs_no_R0; assumption. apply prod_neq_R0; assumption. rewrite (Rinv_mult_distr _ _ H0 H16). - unfold Rminus in |- *; rewrite Rmult_plus_distr_r. + unfold Rminus; rewrite Rmult_plus_distr_r. rewrite <- Rmult_assoc. rewrite <- Rinv_r_sym. rewrite Rmult_1_l. @@ -538,16 +538,16 @@ Proof. reflexivity. assumption. assumption. - red in |- *; intro; rewrite H16 in H15; rewrite Rabs_R0 in H15; + red; 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. + unfold Rdiv; 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 H17; generalize (lt_INR_0 2 (neq_O_lt 2 H17)); unfold INR; intro; assumption | discriminate ]. - pattern (Rabs l) at 3 in |- *; rewrite double_var. + pattern (Rabs l) at 3; rewrite double_var. ring. split; [ assumption @@ -557,18 +557,18 @@ Proof. [ assumption | apply Rlt_le_trans with (Rmin delta1 delta2); [ assumption | apply Rmin_l ] ]. - change (0 < eps * (Rsqr l / 2)) in |- *; unfold Rdiv in |- *; + change (0 < eps * (Rsqr l / 2)); unfold Rdiv; repeat rewrite Rmult_assoc; apply Rmult_lt_0_compat. assumption. apply Rmult_lt_0_compat. 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 H3; generalize (lt_INR_0 2 (neq_O_lt 2 H3)); unfold INR; intro; assumption | discriminate ]. - change (0 < Rabs l / 2) in |- *; unfold Rdiv in |- *; apply Rmult_lt_0_compat; + change (0 < Rabs l / 2); unfold Rdiv; 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 H3; generalize (lt_INR_0 2 (neq_O_lt 2 H3)); unfold INR; intro; assumption | discriminate ] ]. Qed. diff --git a/theories/Reals/Rlogic.v b/theories/Reals/Rlogic.v index 2237ea6e..0b892a76 100644 --- a/theories/Reals/Rlogic.v +++ b/theories/Reals/Rlogic.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -271,10 +271,10 @@ assert (H2 : ~ is_upper_bound E M'). intro H5. assert (M <= M')%R by (apply H4; exact H5). apply (Rlt_not_le M M'). - unfold M' in |- *. - pattern M at 2 in |- *. + unfold M'. + pattern M at 2. rewrite <- Rplus_0_l. - pattern (0 + M)%R in |- *. + pattern (0 + M)%R. rewrite Rplus_comm. rewrite <- (Rplus_opp_r 1). apply Rplus_lt_compat_l. @@ -284,7 +284,7 @@ assert (H2 : ~ is_upper_bound E M'). apply H2. intros N (n,H7). rewrite H7. -unfold M' in |- *. +unfold M'. assert (H5 : (INR (S n) <= M)%R) by (apply H3; exists (S n); reflexivity). rewrite S_INR in H5. assert (H6 : (INR n + 1 + -1 <= M + -1)%R). diff --git a/theories/Reals/Rminmax.v b/theories/Reals/Rminmax.v index 8f8207d7..da3c6ddd 100644 --- a/theories/Reals/Rminmax.v +++ b/theories/Reals/Rminmax.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Rpow_def.v b/theories/Reals/Rpow_def.v index 026153b7..cd94169f 100644 --- a/theories/Reals/Rpow_def.v +++ b/theories/Reals/Rpow_def.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Rpower.v b/theories/Reals/Rpower.v index 593e54c6..43f326a0 100644 --- a/theories/Reals/Rpower.v +++ b/theories/Reals/Rpower.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -15,25 +15,25 @@ Require Import Rbase. Require Import Rfunctions. Require Import SeqSeries. -Require Import Rtrigo. +Require Import Rtrigo1. Require Import Ranalysis1. Require Import Exp_prop. Require Import Rsqrt_def. Require Import R_sqrt. Require Import MVT. Require Import Ranalysis4. -Open Local Scope R_scope. +Local Open Scope R_scope. Lemma P_Rmin : forall (P:R -> Prop) (x y:R), P x -> P y -> P (Rmin x y). Proof. - intros P x y H1 H2; unfold Rmin in |- *; case (Rle_dec x y); intro; + intros P x y H1 H2; unfold Rmin; case (Rle_dec x y); intro; assumption. Qed. Lemma exp_le_3 : exp 1 <= 3. Proof. assert (exp_1 : exp 1 <> 0). - assert (H0 := exp_pos 1); red in |- *; intro; rewrite H in H0; + assert (H0 := exp_pos 1); red; 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. @@ -43,7 +43,7 @@ Proof. 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; case (exist_exp (-1)); intros; simpl; unfold exp_in in e; assert (H := alternated_series_ineq (fun i:nat => / INR (fact i)) x 1). cut @@ -73,7 +73,7 @@ Proof. ring. discrR. apply H. - unfold Un_decreasing in |- *; intros; + unfold Un_decreasing; 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))). @@ -84,13 +84,13 @@ Proof. 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; + assert (H0 := cv_speed_pow_fact 1); unfold Un_cv; unfold Un_cv in H0; intros; elim (H0 _ H1); intros; exists x0; intros; - unfold R_dist in H2; unfold R_dist in |- *; + unfold R_dist in H2; unfold R_dist; replace (/ INR (fact n)) with (1 ^ n / INR (fact n)). apply (H2 _ H3). - unfold Rdiv in |- *; rewrite pow1; rewrite Rmult_1_l; reflexivity. - unfold infinite_sum in e; unfold Un_cv, tg_alt in |- *; intros; elim (e _ H0); + unfold Rdiv; rewrite pow1; rewrite Rmult_1_l; reflexivity. + unfold infinite_sum in e; unfold Un_cv, tg_alt; 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). @@ -121,7 +121,7 @@ Proof. intro. replace (derive_pt exp x0 (H0 x0)) with (exp x0). apply exp_pos. - symmetry in |- *; apply derive_pt_eq_0. + symmetry ; apply derive_pt_eq_0. apply (derivable_pt_lim_exp x0). apply H. Qed. @@ -143,11 +143,11 @@ Proof. 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)); + pattern x at 1; 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. + symmetry ; apply derive_pt_eq_0; apply derivable_pt_lim_exp. Qed. Lemma ln_exists1 : forall y:R, 1 <= y -> { z:R | y = exp z }. @@ -160,18 +160,18 @@ Proof. cut (f 0 * f y <= 0); [intro H4|]. pose proof (IVT_cor f 0 y H2 (Rlt_le _ _ H0) H4) as (t,(_,H7)); exists t; unfold f in H7; apply Rminus_diag_uniq_sym; exact H7. - pattern 0 at 2 in |- *; rewrite <- (Rmult_0_r (f y)); + pattern 0 at 2; 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; + unfold f; 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 H0) | ring ]. - unfold f in |- *; change (continuity (exp - fct_cte y)) in |- *; + unfold f; change (continuity (exp - fct_cte y)); 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; + unfold f; rewrite exp_0; apply Rplus_le_reg_l with y; rewrite Rplus_0_r; replace (y + (1 - y)) with 1; [ apply H | ring ]. Qed. @@ -185,18 +185,18 @@ Proof. 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). + red; intro; rewrite H0 in H; elim (Rlt_irrefl _ H). destruct (ln_exists1 _ H0) as (x,p); exists (- x); apply Rmult_eq_reg_l with (exp x / y). - unfold Rdiv in |- *; rewrite Rmult_assoc; rewrite <- Rinv_l_sym. + unfold Rdiv; 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 H3; rewrite H3 in H; elim (Rlt_irrefl _ H). - unfold Rdiv in |- *; apply prod_neq_R0. - assert (H3 := exp_pos x); red in |- *; intro H4; rewrite H4 in H3; + rewrite Rmult_1_r; symmetry ; apply p. + red; intro H3; rewrite H3 in H; elim (Rlt_irrefl _ H). + unfold Rdiv; apply prod_neq_R0. + assert (H3 := exp_pos x); red; intro H4; rewrite H4 in H3; elim (Rlt_irrefl _ H3). - apply Rinv_neq_0_compat; red in |- *; intro H3; rewrite H3 in H; + apply Rinv_neq_0_compat; red; intro H3; rewrite H3 in H; elim (Rlt_irrefl _ H). Qed. @@ -213,11 +213,11 @@ Definition ln (x:R) : R := Lemma exp_ln : forall x:R, 0 < x -> exp (ln x) = x. Proof. - intros; unfold ln in |- *; case (Rlt_dec 0 x); intro. - unfold Rln in |- *; + intros; unfold ln; case (Rlt_dec 0 x); intro. + unfold Rln; case (ln_exists (mkposreal x r) (cond_pos (mkposreal x r))); intros. - simpl in e; symmetry in |- *; apply e. + simpl in e; symmetry ; apply e. elim n; apply H. Qed. @@ -231,7 +231,7 @@ Qed. Theorem exp_Ropp : forall x:R, exp (- x) = / exp x. Proof. intros x; assert (H : exp x <> 0). - assert (H := exp_pos x); red in |- *; intro; rewrite H0 in H; + assert (H := exp_pos x); red; 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. @@ -306,11 +306,11 @@ Theorem ln_continue : 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. + unfold continue_in, limit1_in, limit_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. + red; apply P_Rmin. apply Rmult_lt_0_compat. assumption. apply Rplus_lt_reg_r with 1. @@ -321,7 +321,7 @@ Proof. 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 |- *. + unfold dist, R_met, R_dist; simpl. intros x [[H3 H4] H5]. cut (y * (x * / y) = x). intro Hxyy. @@ -351,7 +351,7 @@ Proof. 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). + red; intro; rewrite H0 in H; elim (Rlt_irrefl _ H). rewrite Rabs_right. apply exp_lt_inv. rewrite exp_ln. @@ -366,7 +366,7 @@ Proof. 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 Rgt_ge; red; apply ln_increasing. apply Rlt_0_1. apply Rmult_lt_reg_l with (r := y). apply H. @@ -379,7 +379,7 @@ Proof. 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). + red; 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; @@ -394,7 +394,7 @@ Qed. Definition Rpower (x y:R) := exp (y * ln x). -Infix Local "^R" := Rpower (at level 30, right associativity) : R_scope. +Local Infix "^R" := Rpower (at level 30, right associativity) : R_scope. (******************************************************************) (** * Properties of Rpower *) @@ -412,13 +412,13 @@ Infix Local "^R" := Rpower (at level 30, right associativity) : R_scope. Theorem Rpower_plus : forall x y z:R, z ^R (x + y) = z ^R x * z ^R y. Proof. - intros x y z; unfold Rpower in |- *. + intros x y z; unfold Rpower. 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). Proof. - intros x y z; unfold Rpower in |- *. + intros x y z; unfold Rpower. rewrite ln_exp. replace (z * (y * ln x)) with (y * z * ln x). reflexivity. @@ -427,22 +427,22 @@ Qed. Theorem Rpower_O : forall x:R, 0 < x -> x ^R 0 = 1. Proof. - intros x _; unfold Rpower in |- *. + intros x _; unfold Rpower. rewrite Rmult_0_l; apply exp_0. Qed. Theorem Rpower_1 : forall x:R, 0 < x -> x ^R 1 = x. Proof. - intros x H; unfold Rpower in |- *. + intros x H; unfold Rpower. 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. Proof. - intros n; elim n; simpl in |- *; auto; fold INR in |- *. + intros n; elim n; simpl; auto; fold INR. 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 H x H0; simpl; 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. @@ -451,7 +451,7 @@ Theorem Rpower_lt : 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 |- *. + unfold Rpower. apply exp_increasing. apply Rmult_lt_compat_r. rewrite <- ln_1; apply ln_increasing. @@ -464,18 +464,18 @@ Theorem Rpower_sqrt : forall x:R, 0 < x -> x ^R (/ 2) = sqrt x. Proof. intros x H. apply ln_inv. - unfold Rpower in |- *; apply exp_pos. + unfold Rpower; apply exp_pos. apply sqrt_lt_R0; apply H. apply Rmult_eq_reg_l with (INR 2). apply exp_inv. - fold Rpower in |- *. + fold Rpower. cut ((x ^R (/ INR 2)) ^R INR 2 = sqrt x ^R INR 2). - unfold Rpower in |- *; auto. + unfold Rpower; 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)). + repeat rewrite Rpower_pow; simpl. + pattern x at 1; rewrite <- (sqrt_sqrt x (Rlt_le _ _ H)). ring. apply sqrt_lt_R0; apply H. apply H. @@ -485,7 +485,7 @@ Qed. Theorem Rpower_Ropp : forall x y:R, x ^R (- y) = / x ^R y. Proof. - unfold Rpower in |- *. + unfold Rpower. intros x y; rewrite Ropp_mult_distr_l_reverse. apply exp_Ropp. Qed. @@ -505,11 +505,11 @@ Proof. rewrite Rinv_r. apply exp_lt_inv. apply Rle_lt_trans with (1 := exp_le_3). - change (3 < 2 ^R 2) in |- *. + change (3 < 2 ^R 2). 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); + pattern 3 at 1; rewrite <- Rplus_0_r; replace (2 + 2) with (3 + 1); [ apply Rplus_lt_compat_l; apply Rlt_0_1 | ring ]. prove_sup0. discrR. @@ -523,7 +523,7 @@ 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. Proof. - intros f g D l x H; unfold limit1_in, limit_in in |- *. + intros f g D l x H; unfold limit1_in, limit_in. intros H0 eps H1; case (H0 eps); auto. intros x0 [H2 H3]; exists x0; split; auto. intros x1 [H4 H5]; rewrite <- H; auto. @@ -533,7 +533,7 @@ 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. Proof. - intros f D D1 l x H; unfold limit1_in, limit_in in |- *. + intros f D D1 l x H; unfold limit1_in, limit_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. @@ -541,7 +541,7 @@ Qed. Theorem Rinv_Rdiv : forall x y:R, x <> 0 -> y <> 0 -> / (x / y) = y / x. Proof. - intros x y H1 H2; unfold Rdiv in |- *; rewrite Rinv_mult_distr. + intros x y H1 H2; unfold Rdiv; rewrite Rinv_mult_distr. rewrite Rinv_involutive. apply Rmult_comm. assumption. @@ -551,18 +551,18 @@ Qed. Theorem Dln : forall y:R, 0 < y -> D_in ln Rinv (fun x:R => 0 < x) y. Proof. - intros y Hy; unfold D_in in |- *. + intros y Hy; unfold D_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. + unfold Rdiv; 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; + red; intros H2; case HD2. + symmetry ; apply (ln_inv _ _ HD1 Hy H2). + apply Rminus_eq_contra; apply (not_eq_sym HD2). + apply Rinv_neq_0_compat; apply Rminus_eq_contra; red; intros H2; case HD2; apply ln_inv; auto. assumption. assumption. @@ -574,62 +574,62 @@ Proof. intros x [H1 H2]; split. split; auto. split; auto. - red in |- *; intros H3; case H2; apply ln_inv; auto. + red; 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); + unfold limit1_in; unfold limit_in; + simpl; unfold R_dist; 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)); + intros; pattern y at 3; rewrite <- exp_ln. + pattern x0 at 1; 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 Rminus_eq_contra; apply (not_eq_sym (A:=R)); apply H3. elim H2; clear H2; intros _ H2; apply H2. assumption. - red in |- *; intro; rewrite H in Hy; elim (Rlt_irrefl _ Hy). + red; 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). 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); + unfold derivable_pt_lim; 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. + unfold alp; unfold Rmin; case (Rle_dec x0 (x / 2)); intro. apply H2. - unfold Rdiv in |- *; apply Rmult_lt_0_compat; + unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. - exists (mkposreal _ H4); intros; pattern h at 2 in |- *; + exists (mkposreal _ H4); intros; pattern h at 2; replace h with (x + h - x); [ idtac | ring ]. apply H3; split. - unfold D_x in |- *; split. + unfold D_x; 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. + unfold alp; apply Rmin_r. apply Rlt_trans with (x / 2). - unfold Rdiv in |- *; apply Rmult_lt_0_compat; + unfold Rdiv; 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. + pattern x at 2; 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 (not_eq_sym (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 ] + [ apply H6 | unfold alp; apply Rmin_l ] | ring ]. Qed. @@ -637,7 +637,7 @@ 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. Proof. - intros f g D D1 x H; unfold D_in in |- *. + intros f g D D1 x H; unfold D_in. intros H0; apply limit1_imp with (D := D_x D x); auto. intros x1 [H1 H2]; split; auto. Qed. @@ -646,7 +646,7 @@ 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. Proof. - intros f g h D x H; unfold D_in in |- *. + intros f g h D x H; unfold D_in. rewrite H; auto. Qed. @@ -661,7 +661,7 @@ Proof. 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; + unfold Rminus; rewrite Rpower_plus; rewrite Rpower_Ropp; rewrite (Rpower_1 _ H); unfold Rpower; ring. apply Dcomp with (f := ln) @@ -674,7 +674,7 @@ Proof. 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 |- *. + (fun x:R => z * x) exp); simpl. 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. @@ -687,16 +687,16 @@ Theorem derivable_pt_lim_power : 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. + unfold Rminus; rewrite Rpower_plus. rewrite Rpower_Ropp. rewrite Rpower_1; auto. rewrite <- Rmult_assoc. - unfold Rpower in |- *. + unfold Rpower. 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). + pattern y at 2; 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. diff --git a/theories/Reals/Rprod.v b/theories/Reals/Rprod.v index 12258d6b..88c4de23 100644 --- a/theories/Reals/Rprod.v +++ b/theories/Reals/Rprod.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -12,7 +12,7 @@ Require Import Rfunctions. Require Import Rseries. Require Import PartSum. Require Import Binomial. -Open Local Scope R_scope. +Local Open Scope R_scope. (** TT Ak; 0<=k<=N *) Fixpoint prod_f_R0 (f:nat -> R) (N:nat) : R := @@ -36,7 +36,7 @@ Proof. replace (S n - k - 1)%nat with O; [rewrite H1; simpl|omega]. replace (n+1+0)%nat with (S n); ring. replace (S n - k-1)%nat with (S (n - k-1));[idtac|omega]. - simpl in |- *; replace (k + S (n - k))%nat with (S n). + simpl; replace (k + S (n - k))%nat with (S n). replace (k + 1 + S (n - k - 1))%nat with (S n). rewrite Hrecn; [ ring | assumption ]. omega. @@ -49,8 +49,8 @@ Lemma prod_SO_pos : (forall n:nat, (n <= N)%nat -> 0 <= An n) -> 0 <= prod_f_R0 An N. Proof. intros; induction N as [| N HrecN]. - simpl in |- *; apply H; trivial. - simpl in |- *; apply Rmult_le_pos. + simpl; apply H; trivial. + simpl; apply Rmult_le_pos. apply HrecN; intros; apply H; apply le_trans with N; [ assumption | apply le_n_Sn ]. apply H; apply le_n. @@ -64,7 +64,7 @@ Lemma prod_SO_Rle : Proof. intros; induction N as [| N HrecN]. elim H with O; trivial. - simpl in |- *; apply Rle_trans with (prod_f_R0 An N * Bn (S N)). + simpl; apply Rle_trans with (prod_f_R0 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. @@ -114,7 +114,7 @@ Proof. (if eq_nat_dec n 0 then 1 else INR n) = INR n). intros n; case (eq_nat_dec n 0); auto with real. intros; absurd (0 < n)%nat; omega. - intros; unfold Rsqr in |- *; repeat rewrite fact_prodSO. + intros; unfold Rsqr; repeat rewrite fact_prodSO. cut ((k=N)%nat \/ (k < N)%nat \/ (N < k)%nat). intro H2; elim H2; intro H3. rewrite H3; replace (2*N-N)%nat with N;[right; ring|omega]. @@ -164,14 +164,14 @@ Qed. (**********) Lemma INR_fact_lt_0 : forall n:nat, 0 < INR (fact n). Proof. - intro; apply lt_INR_0; apply neq_O_lt; red in |- *; intro; - elim (fact_neq_0 n); symmetry in |- *; assumption. + intro; apply lt_INR_0; apply neq_O_lt; red; intro; + elim (fact_neq_0 n); symmetry ; assumption. Qed. (** 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. Proof. - intros; unfold C in |- *; unfold Rdiv in |- *; apply Rmult_le_compat_l. + intros; unfold C; unfold Rdiv; 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)). diff --git a/theories/Reals/Rseries.v b/theories/Reals/Rseries.v index 479d381d..3c10725b 100644 --- a/theories/Reals/Rseries.v +++ b/theories/Reals/Rseries.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -9,7 +9,7 @@ Require Import Rbase. Require Import Rfunctions. Require Import Compare. -Open Local Scope R_scope. +Local Open Scope R_scope. Implicit Type r : R. @@ -54,20 +54,20 @@ Section sequence. (*********) Lemma EUn_noempty : exists r : R, EUn r. Proof. - unfold EUn in |- *; split with (Un 0); split with 0%nat; trivial. + unfold EUn; split with (Un 0); split with 0%nat; trivial. Qed. (*********) Lemma Un_in_EUn : forall n:nat, EUn (Un n). Proof. - intro; unfold EUn in |- *; split with n; trivial. + intro; unfold EUn; split with n; 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; + intros; unfold is_upper_bound; intros; unfold EUn in H0; elim H0; clear H0; intros; generalize (H x1); intro; rewrite <- H0 in H1; trivial. Qed. @@ -77,7 +77,7 @@ Section sequence. forall n m:nat, Un_growing -> (n >= m)%nat -> Un n >= Un m. Proof. double induction n m; intros. - unfold Rge in |- *; right; trivial. + unfold Rge; right; trivial. exfalso; unfold ge in H1; generalize (le_Sn_O n0); intro; auto. cut (n0 >= 0)%nat. generalize H0; intros; unfold Un_growing in H0; @@ -89,7 +89,7 @@ Section sequence. elim y; clear y; intro y. unfold ge in H2; generalize (le_not_lt n0 n1 (le_S_n n0 n1 H2)); intro; exfalso; auto. - rewrite y; unfold Rge in |- *; right; trivial. + rewrite y; unfold Rge; right; trivial. unfold ge in H0; generalize (H0 (S n0) H1 (lt_le_S n0 n1 y)); intro; unfold Un_growing in H1; apply @@ -182,13 +182,13 @@ Section sequence. assert (Hs0: forall n, sum n = 0). intros n. - specialize (Hm1 (sum n) (ex_intro _ _ (refl_equal _))). + specialize (Hm1 (sum n) (ex_intro _ _ (eq_refl _))). apply Rle_antisym with (2 := proj1 (Hsum n)). now rewrite <- Hm. assert (Hub: forall n, Un n <= l - eps). intros n. - generalize (refl_equal (sum (S n))). + generalize (eq_refl (sum (S n))). simpl sum at 1. rewrite 2!Hs0, Rplus_0_l. unfold test. @@ -238,7 +238,7 @@ Section sequence. rewrite (IHN H6), Rplus_0_l. unfold test. destruct Rle_lt_dec. - apply refl_equal. + apply eq_refl. now elim Rlt_not_le with (1 := r). destruct (le_or_lt N n) as [Hn|Hn]. @@ -272,20 +272,20 @@ Section sequence. 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))). + apply (Req_le (Un n) (Un n) (eq_refl (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))))). + (H2 (or_introl (Un n <= x) (Req_le (Un n) (Un n) (eq_refl (Un n))))). apply (H2 (or_intror (Un n <= Un (S N)) (H n H3))). Qed. (*********) Lemma cauchy_bound : Cauchy_crit -> bound EUn. Proof. - unfold Cauchy_crit, bound in |- *; intros; unfold is_upper_bound in |- *; + unfold Cauchy_crit, bound; intros; unfold is_upper_bound; 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)); @@ -324,12 +324,12 @@ End Isequence. Lemma GP_infinite : forall x:R, Rabs x < 1 -> Pser (fun n:nat => 1) x (/ (1 - x)). Proof. - intros; unfold Pser in |- *; unfold infinite_sum in |- *; intros; + intros; unfold Pser; unfold infinite_sum; 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 |- *. + elim n; simpl. ring. intros; rewrite H3; ring. intro; cut (0 < eps * (Rabs (1 - x) * Rabs (/ x))). @@ -344,11 +344,11 @@ Proof. apply Rabs_pos_lt. apply Rminus_eq_contra. apply Rlt_dichotomy_converse. - right; unfold Rgt in |- *. + right; unfold Rgt. apply (Rle_lt_trans x (Rabs x) 1). apply RRle_abs. assumption. - unfold R_dist in |- *; rewrite <- Rabs_mult. + unfold R_dist; rewrite <- Rabs_mult. rewrite Rmult_minus_distr_l. cut ((1 - x) * sum_f_R0 (fun n0:nat => x ^ n0) n = @@ -359,7 +359,7 @@ Proof. 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; + intro H8; rewrite H8; simpl; rewrite Rabs_mult; apply (Rlt_le_trans (Rabs x * Rabs (x ^ n)) (Rabs x * (eps * (Rabs (1 - x) * Rabs (/ x)))) ( @@ -373,7 +373,7 @@ Proof. 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. + intros; rewrite H9; unfold Rle; right; reflexivity. ring. assumption. ring. @@ -381,12 +381,12 @@ Proof. ring. apply Rminus_eq_contra. apply Rlt_dichotomy_converse. - right; unfold Rgt in |- *. + right; unfold Rgt. apply (Rle_lt_trans x (Rabs x) 1). apply RRle_abs. assumption. ring; ring. - elim n; simpl in |- *. + elim n; simpl. ring. intros; rewrite H5. ring. @@ -396,7 +396,7 @@ Proof. apply Rabs_pos_lt. apply Rminus_eq_contra. apply Rlt_dichotomy_converse. - right; unfold Rgt in |- *. + right; unfold Rgt. apply (Rle_lt_trans x (Rabs x) 1). apply RRle_abs. assumption. diff --git a/theories/Reals/Rsigma.v b/theories/Reals/Rsigma.v index 0027c274..76b44d96 100644 --- a/theories/Reals/Rsigma.v +++ b/theories/Reals/Rsigma.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -10,7 +10,7 @@ Require Import Rbase. Require Import Rfunctions. Require Import Rseries. Require Import PartSum. -Open Local Scope R_scope. +Local Open Scope R_scope. Set Implicit Arguments. @@ -28,8 +28,8 @@ Section Sigma. 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). + intro; rewrite H1; unfold sigma; rewrite <- minus_n_n; + rewrite <- minus_n_O; simpl; replace (high - 1)%nat with (pred high). apply (decomp_sum (fun k:nat => f k)). assumption. apply pred_of_minus. @@ -42,8 +42,8 @@ Section Sigma. 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; + unfold sigma; replace (high - S (S k))%nat with (pred (high - S k)). + pattern (S k) at 3; 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))). @@ -55,12 +55,12 @@ Section Sigma. 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))). + unfold sigma; replace (S k - low)%nat with (S (k - low)). + pattern (S k) at 1; replace (S k) with (low + S (k - low))%nat. + symmetry ; apply (tech5 (fun i:nat => f (low + i))). omega. omega. - rewrite <- H2; unfold sigma in |- *; rewrite <- minus_n_n; simpl in |- *; + rewrite <- H2; unfold sigma; rewrite <- minus_n_n; simpl; 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))). @@ -79,7 +79,7 @@ Section Sigma. (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. + intros low high k H1 H2; symmetry ; rewrite (sigma_split H1 H2); ring. Qed. Theorem sigma_diff_neg : @@ -100,8 +100,8 @@ Section Sigma. apply sigma_split. apply le_n. assumption. - unfold sigma in |- *; rewrite <- minus_n_n. - simpl in |- *. + unfold sigma; rewrite <- minus_n_n. + simpl. replace (low + 0)%nat with low; [ reflexivity | ring ]. Qed. @@ -113,20 +113,20 @@ Section Sigma. 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. + intro; pattern high at 3; 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 |- *; + unfold sigma; rewrite <- minus_n_n; simpl; replace (high + 0)%nat with high; [ 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 ]. + intro; unfold sigma; rewrite <- minus_n_n. + simpl; replace (low + 0)%nat with low; [ reflexivity | ring ]. Qed. End Sigma. diff --git a/theories/Reals/Rsqrt_def.v b/theories/Reals/Rsqrt_def.v index 7c3b4699..a6e48f83 100644 --- a/theories/Reals/Rsqrt_def.v +++ b/theories/Reals/Rsqrt_def.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -11,7 +11,7 @@ Require Import Rbase. Require Import Rfunctions. Require Import SeqSeries. Require Import Ranalysis1. -Open Local Scope R_scope. +Local Open Scope R_scope. Fixpoint Dichotomy_lb (x y:R) (P:R -> bool) (N:nat) {struct N} : R := match N with @@ -41,18 +41,18 @@ Lemma dicho_comp : Proof. intros. induction n as [| n Hrecn]. - simpl in |- *; assumption. - simpl in |- *. + simpl; assumption. + simpl. 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. + unfold Rdiv; apply Rmult_le_reg_l with 2. prove_sup0. - pattern 2 at 1 in |- *; rewrite Rmult_comm. + pattern 2 at 1; 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. + unfold Rdiv; apply Rmult_le_reg_l with 2. prove_sup0. rewrite Rmult_comm. rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]. @@ -67,14 +67,14 @@ Lemma dicho_lb_growing : forall (x y:R) (P:R -> bool), x <= y -> Un_growing (dicho_lb x y P). Proof. intros. - unfold Un_growing in |- *. + unfold Un_growing. intro. - simpl in |- *. + simpl. 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. + unfold Rdiv; apply Rmult_le_reg_l with 2. prove_sup0. - pattern 2 at 1 in |- *; rewrite Rmult_comm. + pattern 2 at 1; rewrite Rmult_comm. rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]. rewrite Rmult_1_r. rewrite double. @@ -87,11 +87,11 @@ Lemma dicho_up_decreasing : forall (x y:R) (P:R -> bool), x <= y -> Un_decreasing (dicho_up x y P). Proof. intros. - unfold Un_decreasing in |- *. + unfold Un_decreasing. intro. - simpl in |- *. + simpl. 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. + unfold Rdiv; apply Rmult_le_reg_l with 2. prove_sup0. rewrite Rmult_comm. rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ]. @@ -112,17 +112,17 @@ Lemma dicho_lb_maj_y : Proof. intros. induction n as [| n Hrecn]. - simpl in |- *; assumption. - simpl in |- *. + simpl; assumption. + simpl. 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. + unfold Rdiv; apply Rmult_le_reg_l with 2. prove_sup0. 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); + pattern y at 2; replace y with (Dichotomy_ub x y P 0); [ idtac | reflexivity ]. apply decreasing_prop. assert (H0 := dicho_up_decreasing x y P H). @@ -136,10 +136,10 @@ Proof. intros. cut (forall n:nat, dicho_lb x y P n <= y). intro. - unfold has_ub in |- *. - unfold bound in |- *. + unfold has_ub. + unfold bound. exists y. - unfold is_upper_bound in |- *. + unfold is_upper_bound. intros. elim H1; intros. rewrite H2; apply H0. @@ -151,15 +151,15 @@ Lemma dicho_up_min_x : Proof. intros. induction n as [| n Hrecn]. - simpl in |- *; assumption. - simpl in |- *. + simpl; assumption. + simpl. 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. + unfold Rdiv; apply Rmult_le_reg_l with 2. prove_sup0. - pattern 2 at 1 in |- *; rewrite Rmult_comm. + pattern 2 at 1; 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); + pattern x at 1; replace x with (Dichotomy_lb x y P 0); [ idtac | reflexivity ]. apply tech9. assert (H0 := dicho_lb_growing x y P H). @@ -175,14 +175,14 @@ Proof. intros. cut (forall n:nat, x <= dicho_up x y P n). intro. - unfold has_lb in |- *. - unfold bound in |- *. + unfold has_lb. + unfold bound. exists (- x). - unfold is_upper_bound in |- *. + unfold is_upper_bound. intros. elim H1; intros. rewrite H2. - unfold opp_seq in |- *. + unfold opp_seq. apply Ropp_le_contravar. apply H0. apply dicho_up_min_x; assumption. @@ -214,35 +214,35 @@ Lemma dicho_lb_dicho_up : Proof. intros. induction n as [| n Hrecn]. - simpl in |- *. - unfold Rdiv in |- *; rewrite Rinv_1; ring. - simpl in |- *. + simpl. + unfold Rdiv; rewrite Rinv_1; ring. + simpl. case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). - unfold Rdiv in |- *. + unfold Rdiv. 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 |- *. + unfold Rdiv; rewrite Hrecn. + unfold Rdiv. rewrite Rinv_mult_distr. ring. discrR. apply pow_nonzero; discrR. - pattern (Dichotomy_lb x y P n) at 2 in |- *; + pattern (Dichotomy_lb x y P n) at 2; rewrite (double_var (Dichotomy_lb x y P n)); - unfold dicho_up, dicho_lb, Rminus, Rdiv in |- *; ring. + unfold dicho_up, dicho_lb, Rminus, Rdiv; 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 |- *. + unfold Rdiv; rewrite Hrecn. + unfold Rdiv. rewrite Rinv_mult_distr. ring. discrR. apply pow_nonzero; discrR. - pattern (Dichotomy_ub x y P n) at 1 in |- *; + pattern (Dichotomy_ub x y P n) at 1; rewrite (double_var (Dichotomy_ub x y P n)); - unfold dicho_up, dicho_lb, Rminus, Rdiv in |- *; ring. + unfold dicho_up, dicho_lb, Rminus, Rdiv; ring. Qed. Definition pow_2_n (n:nat) := 2 ^ n. @@ -250,23 +250,23 @@ Definition pow_2_n (n:nat) := 2 ^ n. Lemma pow_2_n_neq_R0 : forall n:nat, pow_2_n n <> 0. Proof. intro. - unfold pow_2_n in |- *. + unfold pow_2_n. apply pow_nonzero. discrR. Qed. Lemma pow_2_n_growing : Un_growing pow_2_n. Proof. - unfold Un_growing in |- *. + unfold Un_growing. 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. + [ unfold pow_2_n; rewrite pow_add | ring ]. + pattern (2 ^ n) at 1; rewrite <- Rmult_1_r. apply Rmult_le_compat_l. left; apply pow_lt; prove_sup0. - simpl in |- *. + simpl. rewrite Rmult_1_r. - pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; + pattern 1 at 1; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; apply Rlt_0_1. Qed. @@ -274,7 +274,7 @@ Lemma pow_2_n_infty : cv_infty pow_2_n. Proof. cut (forall N:nat, INR N <= 2 ^ N). intros. - unfold cv_infty in |- *. + unfold cv_infty. intro. case (total_order_T 0 M); intro. elim s; intro. @@ -287,41 +287,41 @@ Proof. apply Rlt_le_trans with (INR N0). rewrite INR_IZR_INZ. rewrite <- H1. - unfold N in |- *. + unfold N. assert (H3 := archimed M). elim H3; intros; assumption. apply Rle_trans with (pow_2_n N0). - unfold pow_2_n in |- *; apply H. + unfold pow_2_n; apply H. apply Rge_le. apply growing_prop. apply pow_2_n_growing. assumption. apply le_IZR. - unfold N in |- *. - simpl in |- *. + unfold N. + simpl. 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. + unfold pow_2_n; 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. + unfold pow_2_n; apply pow_lt; prove_sup0. simple induction N. - simpl in |- *. + simpl. left; apply Rlt_0_1. intros. - pattern (S n) at 2 in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ]. + pattern (S n) at 2; replace (S n) with (n + 1)%nat; [ idtac | ring ]. rewrite S_INR; rewrite pow_add. - simpl in |- *. + simpl. 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. + pattern (2 ^ n) at 1; rewrite <- Rplus_0_r. rewrite <- (Rmult_comm 2). rewrite double. apply Rplus_le_compat_l. @@ -338,8 +338,8 @@ Proof. 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 |- *. + symmetry ; apply Rminus_diag_uniq_sym; assumption. + unfold Un_cv; unfold R_dist. 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. @@ -356,7 +356,7 @@ Proof. rewrite <- Rabs_Ropp. rewrite Ropp_minus_distr'. rewrite dicho_lb_dicho_up. - unfold Rdiv in |- *; rewrite Rabs_mult. + unfold Rdiv; rewrite Rabs_mult. rewrite (Rabs_right (y - x)). apply Rmult_lt_reg_l with (/ (y - x)). apply Rinv_0_lt_compat; assumption. @@ -366,12 +366,12 @@ Proof. [ 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). + red; 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; + unfold Rdiv; 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 ]. @@ -382,7 +382,7 @@ Proof. rewrite Ropp_minus_distr'. rewrite dicho_lb_dicho_up. rewrite b. - unfold Rminus, Rdiv in |- *; rewrite Rplus_opp_r; rewrite Rmult_0_l; + unfold Rminus, Rdiv; rewrite Rplus_opp_r; rewrite Rmult_0_l; rewrite Rabs_R0; assumption. assumption. elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)). @@ -399,26 +399,26 @@ 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). 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 |- *. + unfold continuity_pt, Un_cv; unfold continue_in. + unfold limit1_in. + unfold limit_in. + unfold dist. + simpl. + unfold R_dist. 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; + rewrite H7; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. apply H4. split. - unfold D_x, no_cond in |- *. + unfold D_x, no_cond. split. trivial. - apply (sym_not_eq (A:=R)); assumption. + apply (not_eq_sym (A:=R)); assumption. apply H5; assumption. Qed. @@ -428,9 +428,9 @@ Lemma dicho_lb_car : Proof. intros. induction n as [| n Hrecn]. - simpl in |- *. + simpl. assumption. - simpl in |- *. + simpl. assert (X := sumbool_of_bool (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2))). @@ -447,9 +447,9 @@ Lemma dicho_up_car : Proof. intros. induction n as [| n Hrecn]. - simpl in |- *. + simpl. assumption. - simpl in |- *. + simpl. assert (X := sumbool_of_bool (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2))). @@ -480,7 +480,7 @@ Proof. split. split. apply Rle_trans with (dicho_lb x y (fun z:R => cond_positivity (f z)) 0). - simpl in |- *. + simpl. right; reflexivity. apply growing_ineq. apply dicho_lb_growing; assumption. @@ -503,7 +503,7 @@ Proof. assert (H10 := H5 H7). apply Rle_antisym; assumption. intro. - unfold Wn in |- *. + unfold Wn. 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). @@ -514,7 +514,7 @@ Proof. apply H12. left; assumption. intro. - unfold cond_positivity in |- *. + unfold cond_positivity. case (Rle_dec 0 z); intro. split. intro; assumption. @@ -523,7 +523,7 @@ Proof. intro feqt;discriminate feqt. intro. elim n0; assumption. - unfold Vn in |- *. + unfold Vn. 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). @@ -535,7 +535,7 @@ Proof. apply H12. assumption. intro. - unfold cond_positivity in |- *. + unfold cond_positivity. case (Rle_dec 0 z); intro. split. intro feqt; discriminate feqt. @@ -554,7 +554,7 @@ Proof. cut (0 < - f x0). intro. elim (H7 (- f x0) H8); intros. - cut (x2 >= x2)%nat; [ intro | unfold ge in |- *; apply le_n ]. + cut (x2 >= x2)%nat; [ intro | unfold ge; 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. @@ -562,11 +562,11 @@ Proof. 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 Rle_ge; left; unfold Rminus; apply Rplus_le_lt_0_compat. apply H6. exact H8. apply Ropp_0_gt_lt_contravar; assumption. - unfold Wn in |- *; assumption. + unfold Wn; assumption. cut (Un_cv Vn x0). intros. assert (H7 := continuity_seq f Vn x0 (H x0) H5). @@ -574,7 +574,7 @@ Proof. 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 ]. + cut (x2 >= x2)%nat; [ intro | unfold ge; 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. @@ -589,12 +589,12 @@ Proof. 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 ]. + [ unfold Rminus; 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. + unfold Vn; assumption. Qed. Lemma IVT_cor : @@ -613,11 +613,11 @@ Proof. exists y. split. split; [ assumption | right; reflexivity ]. - symmetry in |- *; exact b. + symmetry ; exact b. exists x. split. split; [ right; reflexivity | assumption ]. - symmetry in |- *; exact b. + symmetry ; exact b. elim s; intro. cut (x < y). intro. @@ -633,8 +633,8 @@ Proof. 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 |- *. + unfold opp_fct; apply Ropp_0_gt_lt_contravar; assumption. + unfold opp_fct. apply Rplus_lt_reg_r with (f x); rewrite Rplus_opp_r; rewrite Rplus_0_r; assumption. inversion H0. @@ -644,7 +644,7 @@ Proof. exists x. split. split; [ right; reflexivity | assumption ]. - symmetry in |- *; assumption. + symmetry ; assumption. case (total_order_T 0 (f y)); intro. elim s; intro. cut (x < y). @@ -657,7 +657,7 @@ Proof. exists y. split. split; [ assumption | right; reflexivity ]. - symmetry in |- *; assumption. + symmetry ; assumption. cut (0 < f x * f y). intro. elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H2 H1)). @@ -690,18 +690,18 @@ Proof. 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)). + rewrite Rmult_comm; pattern 0 at 2; rewrite <- (Rmult_0_r (f 1)). apply Rmult_le_compat_l; assumption. - unfold f in |- *. + unfold f. rewrite Rsqr_1. apply Rplus_le_reg_l with y. - rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *; + rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; left; assumption. exists 1. split. left; apply Rlt_0_1. - rewrite b; symmetry in |- *; apply Rsqr_1. + rewrite b; symmetry ; apply Rsqr_1. cut (0 <= f y). intro. cut (f 0 * f y <= 0). @@ -714,14 +714,14 @@ Proof. 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)). + rewrite Rmult_comm; pattern 0 at 2; rewrite <- (Rmult_0_r (f y)). apply Rmult_le_compat_l; assumption. - unfold f in |- *. + unfold f. apply Rplus_le_reg_l with y. - rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *; + rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus; 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. + pattern y at 1; rewrite <- Rmult_1_r. + unfold Rsqr; apply Rmult_le_compat_l. assumption. left; exact r. replace f with (Rsqr - fct_cte y)%F. @@ -729,8 +729,8 @@ Proof. 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. + unfold f; rewrite Rsqr_0. + unfold Rminus; rewrite Rplus_0_l. apply Rge_le. apply Ropp_0_le_ge_contravar; assumption. Qed. @@ -749,7 +749,7 @@ Proof. intros. elim p; intros. rewrite H in H0; assumption. - unfold Rsqrt in |- *. + unfold Rsqrt. case (Rsqrt_exists x (cond_nonneg x)). intros. elim p; elim a; intros. @@ -770,7 +770,7 @@ Proof. rewrite <- H. elim p; intros. rewrite H1; reflexivity. - unfold Rsqrt in |- *. + unfold Rsqrt. case (Rsqrt_exists x (cond_nonneg x)). intros. elim p; elim a; intros. diff --git a/theories/Reals/Rtopology.v b/theories/Reals/Rtopology.v index f1142d24..51d0b99e 100644 --- a/theories/Reals/Rtopology.v +++ b/theories/Reals/Rtopology.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -12,7 +12,7 @@ Require Import Ranalysis1. Require Import RList. Require Import Classical_Prop. Require Import Classical_Pred_Type. -Open Local Scope R_scope. +Local Open Scope R_scope. (** * General definitions and propositions *) @@ -30,16 +30,16 @@ Definition interior (D:R -> Prop) (x:R) : Prop := neighbourhood D x. Lemma interior_P1 : forall D:R -> Prop, included (interior D) D. Proof. - intros; unfold included in |- *; unfold interior in |- *; intros; + intros; unfold included; unfold interior; intros; unfold neighbourhood in H; elim H; intros; unfold included in H0; - apply H0; unfold disc in |- *; unfold Rminus in |- *; + apply H0; unfold disc; unfold Rminus; 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). Proof. - intros; unfold open_set in H; unfold included in |- *; intros; - assert (H1 := H _ H0); unfold interior in |- *; apply H1. + intros; unfold open_set in H; unfold included; intros; + assert (H1 := H _ H0); unfold interior; apply H1. Qed. Definition point_adherent (D:R -> Prop) (x:R) : Prop := @@ -49,11 +49,11 @@ Definition adherence (D:R -> Prop) (x:R) : Prop := point_adherent D x. Lemma adherence_P1 : forall D:R -> Prop, included D (adherence D). Proof. - intro; unfold included in |- *; intros; unfold adherence in |- *; - unfold point_adherent in |- *; intros; exists x; - unfold intersection_domain in |- *; split. + intro; unfold included; intros; unfold adherence; + unfold point_adherent; intros; exists x; + unfold intersection_domain; split. unfold neighbourhood in H0; elim H0; intros; unfold included in H1; apply H1; - unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r; + unfold disc; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply (cond_pos x0). apply H. Qed. @@ -62,29 +62,29 @@ Lemma included_trans : 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. + unfold included; intros; apply H0; apply H; apply H1. Qed. Lemma interior_P3 : forall D:R -> Prop, open_set (interior D). Proof. - intro; unfold open_set, interior in |- *; unfold neighbourhood in |- *; + intro; unfold open_set, interior; unfold neighbourhood; intros; elim H; intros. - exists x0; unfold included in |- *; intros. + exists x0; unfold included; 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. + unfold included; unfold disc; 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; + unfold del; rewrite <- (Rabs_Ropp (x - x1)); rewrite Ropp_minus_distr; ring. - unfold del in |- *; apply Rplus_lt_reg_r with (Rabs (x - x1)); + unfold del; 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 ]. @@ -95,7 +95,7 @@ Lemma complementary_P1 : forall D:R -> Prop, ~ (exists y : R, intersection_domain D (complementary D) y). Proof. - intro; red in |- *; intro; elim H; intros; + intro; red; intro; elim H; intros; unfold intersection_domain, complementary in H0; elim H0; intros; elim H2; assumption. Qed. @@ -103,8 +103,8 @@ Qed. Lemma adherence_P2 : 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)); + unfold closed_set; unfold open_set, complementary; intros; + unfold included, adherence; intros; assert (H1 := classic (D x)); elim H1; intro. assumption. assert (H3 := H _ H2); assert (H4 := H0 _ H3); elim H4; intros; @@ -114,8 +114,8 @@ Qed. Lemma adherence_P3 : forall D:R -> Prop, closed_set (adherence D). Proof. - intro; unfold closed_set, adherence in |- *; - unfold open_set, complementary, point_adherent in |- *; + intro; unfold closed_set, adherence; + unfold open_set, complementary, point_adherent; intros; set (P := @@ -123,21 +123,21 @@ Proof. 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. + unfold neighbourhood; elim H2; intros; unfold neighbourhood in H3; + elim H3; intros; exists x0; unfold included; + intros; red; 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 |- *; + unfold included in H5; apply H5; unfold disc; 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)); + unfold del; simpl; 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); @@ -152,10 +152,10 @@ Infix "=_D" := eq_Dom (at level 70, no associativity). Lemma open_set_P1 : forall D:R -> Prop, open_set D <-> D =_D interior D. Proof. intro; split. - intro; unfold eq_Dom in |- *; split. + intro; unfold eq_Dom; split. apply interior_P2; assumption. apply interior_P1. - intro; unfold eq_Dom in H; elim H; clear H; intros; unfold open_set in |- *; + intro; unfold eq_Dom in H; elim H; clear H; intros; unfold open_set; intros; unfold included, interior in H; unfold included in H0; apply (H _ H1). Qed. @@ -163,20 +163,20 @@ Qed. Lemma closed_set_P1 : forall D:R -> Prop, closed_set D <-> D =_D adherence D. Proof. intro; split. - intro; unfold eq_Dom in |- *; split. + intro; unfold eq_Dom; split. apply adherence_P1. apply adherence_P2; assumption. - unfold eq_Dom in |- *; unfold included in |- *; intros; + unfold eq_Dom; unfold included; intros; assert (H0 := adherence_P3 D); unfold closed_set in H0; - unfold closed_set in |- *; unfold open_set in |- *; + unfold closed_set; unfold open_set; unfold open_set in H0; intros; assert (H2 : complementary (adherence D) x). - unfold complementary in |- *; unfold complementary in H1; red in |- *; intro; + unfold complementary; unfold complementary in H1; red; intro; elim H; clear H; intros _ H; elim H1; apply (H _ H2). - assert (H3 := H0 _ H2); unfold neighbourhood in |- *; + assert (H3 := H0 _ H2); unfold neighbourhood; unfold neighbourhood in H3; elim H3; intros; exists x0; - unfold included in |- *; unfold included in H4; intros; + unfold included; unfold included in H4; intros; assert (H6 := H4 _ H5); unfold complementary in H6; - unfold complementary in |- *; red in |- *; intro; + unfold complementary; red; intro; elim H; clear H; intros H _; elim H6; apply (H _ H7). Qed. @@ -184,8 +184,8 @@ Lemma neighbourhood_P1 : 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; + unfold included, neighbourhood; intros; elim H0; intros; exists x0; + intros; unfold included; unfold included in H1; intros; apply (H _ (H1 _ H2)). Qed. @@ -193,12 +193,12 @@ Lemma open_set_P2 : 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. + unfold open_set; intros; unfold union_domain in H1; elim H1; intro. apply neighbourhood_P1 with D1. - unfold included, union_domain in |- *; tauto. + unfold included, union_domain; tauto. apply H; assumption. apply neighbourhood_P1 with D2. - unfold included, union_domain in |- *; tauto. + unfold included, union_domain; tauto. apply H0; assumption. Qed. @@ -206,53 +206,53 @@ Lemma open_set_P3 : 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; + unfold open_set; 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; + unfold intersection_domain; 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; + exists del; unfold included; 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. + unfold del; simpl; 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. + unfold del; simpl; apply Rmin_r. + unfold Rmin; 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). Proof. - unfold open_set in |- *; intros; elim H. + unfold open_set; intros; elim H. Qed. Lemma open_set_P5 : open_set (fun x:R => True). Proof. - unfold open_set in |- *; intros; unfold neighbourhood in |- *. - exists (mkposreal 1 Rlt_0_1); unfold included in |- *; intros; trivial. + unfold open_set; intros; unfold neighbourhood. + exists (mkposreal 1 Rlt_0_1); unfold included; intros; trivial. Qed. Lemma disc_P1 : forall (x:R) (del:posreal), open_set (disc x del). 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; + unfold eq_Dom; split. + unfold included, interior, disc; intros; cut (0 < del - Rabs (x - x0)). intro; set (del2 := mkposreal _ H3). - exists del2; unfold included in |- *; intros. + exists del2; unfold included; 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)); + unfold del2; simpl; 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); @@ -278,19 +278,19 @@ Proof. elim H3; intros. exists (disc x (mkposreal del2 H4)). intros; unfold included in H1; split. - unfold neighbourhood, disc in |- *. + unfold neighbourhood, disc. 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; + unfold included; intros; assumption. + intros; apply H1; unfold disc; case (Req_dec y x); intro. + rewrite H7; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply (cond_pos del1). apply H5; split. - unfold D_x, no_cond in |- *; split. + unfold D_x, no_cond; split. trivial. - apply (sym_not_eq (A:=R)); apply H7. + apply (not_eq_sym (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; unfold continuity_pt; unfold continue_in; + unfold limit1_in; unfold limit_in; intros. assert (H1 := H (disc (f x) (mkposreal eps H0))). cut (neighbourhood (disc (f x) (mkposreal eps H0)) (f x)). @@ -299,10 +299,10 @@ Proof. 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. + intros; elim H8; intros; simpl in H10; unfold R_dist in H10; simpl; + unfold R_dist; apply (H6 _ (H7 _ H10)). + unfold neighbourhood, disc; exists (mkposreal eps H0); + unfold included; intros; assumption. Qed. Definition image_rec (f:R -> R) (D:R -> Prop) (x:R) : Prop := D (f x). @@ -312,13 +312,13 @@ Lemma continuity_P2 : 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; + intros; unfold open_set in H0; unfold open_set; intros; assert (H2 := continuity_P1 f x); elim H2; intros H3 _; - assert (H4 := H3 (H x)); unfold neighbourhood, image_rec in |- *; + assert (H4 := H3 (H x)); unfold neighbourhood, image_rec; 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)). + unfold included; intros; apply (H8 _ (H9 _ H10)). Qed. (**********) @@ -329,9 +329,9 @@ Lemma continuity_P3 : 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; unfold continuity; unfold continuity_pt; + unfold continue_in; unfold limit1_in; + unfold limit_in; simpl; unfold R_dist; 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)). @@ -340,7 +340,7 @@ Proof. 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; + unfold disc; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply H0. apply disc_P1. Qed. @@ -358,23 +358,23 @@ Proof. 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 |- *; + unfold neighbourhood; exists (mkposreal _ H); unfold included; tauto. split. - unfold neighbourhood in |- *; exists (mkposreal _ H); unfold included in |- *; + unfold neighbourhood; exists (mkposreal _ H); unfold included; tauto. - red in |- *; intro; elim H0; intros; unfold intersection_domain in H1; + red; 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 |- *; + change (Rabs (x - y) < D); 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). + unfold Rdiv; apply Rmult_lt_0_compat. + unfold D; apply Rabs_pos_lt; apply (Rminus_eq_contra _ _ Hsep). apply Rinv_0_lt_compat; prove_sup0. Qed. @@ -404,7 +404,7 @@ Lemma restriction_family : (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; + intros; elim H; intros; unfold intersection_domain; elim H0; intros; split. apply (cond_fam f0); exists x0; assumption. assumption. @@ -424,19 +424,19 @@ Lemma family_P1 : 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)). + unfold family_open_set; intros; unfold subfamily; + simpl; 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; + unfold open_set; unfold neighbourhood; intros; elim H3; intros; assert (H6 := H2 _ H4); elim H6; intros; exists x1; - unfold included in |- *; intros; split. + unfold included; 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; + unfold open_set; unfold neighbourhood; intros; elim H3; intros; elim H1; assumption. Qed. @@ -446,7 +446,7 @@ Definition bounded (D:R -> Prop) : Prop := Lemma open_set_P6 : forall D1 D2:R -> Prop, open_set D1 -> D1 =_D D2 -> open_set D2. Proof. - unfold open_set in |- *; unfold neighbourhood in |- *; intros. + unfold open_set; unfold neighbourhood; intros. unfold eq_Dom in H0; elim H0; intros. assert (H4 := H _ (H3 _ H1)). elim H4; intros. @@ -465,7 +465,7 @@ Proof. 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). + unfold bounded; 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; @@ -484,25 +484,25 @@ Proof. 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; + unfold intersection_domain, D; tauto. + unfold covering_open_set; split. + unfold covering; intros; simpl; exists (Rabs x + 1); + unfold g; pattern (Rabs x) at 1; 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. + unfold family_open_set; 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; + unfold eq_Dom; unfold f0; simpl; + unfold g, disc; split. + unfold included; 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; + unfold included; intros; unfold Rminus; 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; + unfold eq_Dom; split. + unfold included; intros; elim H3. + unfold included, f0; simpl; unfold g; intros; elim H2; intro; [ rewrite <- H4 in H3; assert (H5 := Rabs_pos x0); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H3)) @@ -515,10 +515,10 @@ Lemma compact_P2 : forall X:R -> Prop, compact X -> closed_set X. Proof. intros; assert (H0 := closed_set_P1 X); elim H0; clear H0; intros _ H0; apply H0; clear H0. - unfold eq_Dom in |- *; split. + unfold eq_Dom; split. apply adherence_P1. - unfold included in |- *; unfold adherence in |- *; - unfold point_adherent in |- *; intros; unfold compact in H; + unfold included; unfold adherence; + unfold point_adherent; 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). @@ -548,44 +548,44 @@ Proof. 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 |- *; + elim (H8 y0); clear H8; intros; apply H8; unfold intersection_domain; 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; + unfold disc; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply H9. - unfold alp in |- *; apply MinRlist_P2; intros; + unfold alp; 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 |- *; + unfold covering_open_set; split. + unfold covering; intros; exists x0; simpl; unfold g; split. - unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + unfold Rminus; 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 |- *; + unfold family_open_set; intro; simpl; unfold g; 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. + unfold eq_Dom; split. + unfold included, disc; simpl; 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; + unfold included, disc; simpl; 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. + unfold eq_Dom; split. + unfold included; intros; elim H6. + unfold included; 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; + intros; unfold Rdiv; apply Rmult_lt_0_compat. + apply Rabs_pos_lt; apply Rminus_eq_contra; red; intro; rewrite H3 in H2; elim H1; apply H2. apply Rinv_0_lt_compat; prove_sup0. Qed. @@ -593,29 +593,29 @@ Qed. (**********) Lemma compact_EMP : compact (fun _:R => False). 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. + unfold compact; intros; exists (fun x:R => False); + unfold covering_finite; split. + unfold covering; intros; elim H0. + unfold family_finite; unfold domain_finite; exists nil; intro. split. - simpl in |- *; unfold intersection_domain in |- *; intros; elim H0. + simpl; unfold intersection_domain; intros; elim H0. elim H0; clear H0; intros _ H0; elim H0. - simpl in |- *; intro; elim H0. + simpl; intro; elim H0. Qed. Lemma compact_eqDom : 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; + unfold compact; intros; unfold eq_Dom in H0; elim H0; clear H0; + unfold included; intros; assert (H3 : covering_open_set X1 f0). + unfold covering_open_set; unfold covering_open_set in H1; elim H1; clear H1; intros; split. - unfold covering in H1; unfold covering in |- *; intros; + unfold covering in H1; unfold covering; intros; apply (H1 _ (H0 _ H4)). apply H3. - elim (H _ H3); intros D H4; exists D; unfold covering_finite in |- *; + elim (H _ H3); intros D H4; exists D; unfold covering_finite; unfold covering_finite in H4; elim H4; intros; split. - unfold covering in H5; unfold covering in |- *; intros; + unfold covering in H5; unfold covering; intros; apply (H5 _ (H2 _ H7)). apply H6. Qed. @@ -624,7 +624,7 @@ Qed. Lemma compact_P3 : forall a b:R, compact (fun c:R => a <= c <= b). Proof. intros; case (Rle_dec a b); intro. - unfold compact in |- *; intros; + unfold compact; intros; set (A := fun x:R => @@ -647,92 +647,92 @@ Proof. 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; + unfold covering_finite; split. + unfold covering; 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; + simpl in H16; simpl; unfold Db; 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; + exists y0; simpl; split. + apply H8; unfold disc; 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; + unfold Rminus; 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 Db; right; reflexivity. + unfold family_finite; unfold domain_finite; 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; + simpl; left; apply H16. + simpl; right; apply H13. + simpl; unfold intersection_domain; 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 |- *. + intro; simpl in H14; elim H14; intro; simpl; + unfold intersection_domain. 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). + unfold Db; right; assumption. + simpl; unfold intersection_domain; 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. + unfold Db; 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; + unfold m'; unfold Rmin; case (Rle_dec (m + eps / 2) b); intro. + pattern m at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; + unfold Rdiv; 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. + unfold A; 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; + unfold m'; unfold Rmin; case (Rle_dec (m + eps / 2) b); intro. + pattern m at 1; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; + unfold Rdiv; 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 m'; 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; + unfold covering_finite; split. + unfold covering; 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 |- *. + simpl in H16; simpl; unfold Db. 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)); + exists y0; simpl; split. + apply H8; unfold disc; unfold Rabs; 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; + unfold Rminus; 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). @@ -741,56 +741,56 @@ Proof. ring. ring. apply Rle_lt_trans with (m' - m). - unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- m)); + unfold Rminus; 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. + unfold m'; 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; + unfold Rdiv; 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 Rmult_1_l; pattern (pos eps) at 1; 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 Db; right; reflexivity. + unfold family_finite; unfold domain_finite; 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; + simpl; left; apply H16. + simpl; right; apply H13; simpl; + unfold intersection_domain; 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 |- *. + intro; simpl in H14; elim H14; intro; simpl; + unfold intersection_domain. split. apply (cond_fam f0); rewrite H15; exists m; apply H6. - unfold Db in |- *; right; assumption. + unfold Db; 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. + unfold Db; 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 |- *; + pattern m at 2; rewrite <- Rplus_0_r; unfold Rminus; 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; + unfold is_upper_bound; intros; assert (H14 := not_and_or _ _ (H12 x)); elim H14; intro. elim H15; apply H13. @@ -803,44 +803,44 @@ Proof. 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; + apply (H4 b); unfold is_upper_bound; 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 bound; exists b; unfold is_upper_bound; intros; unfold A in H1; elim H1; clear H1; intros H1 _; elim H1; clear H1; intros _ H1; apply H1. - unfold A in |- *; split. + unfold A; 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). + unfold covering_finite; split. + unfold covering; simpl; intros; cut (x = a). intro; exists y0; split. rewrite H4; apply H2. - unfold D' in |- *; reflexivity. + unfold D'; reflexivity. elim H3; intros; apply Rle_antisym; assumption. - unfold family_finite in |- *; unfold domain_finite in |- *; + unfold family_finite; unfold domain_finite; exists (cons y0 nil); intro; split. - simpl in |- *; unfold intersection_domain in |- *; intro; elim H3; clear H3; + simpl; unfold intersection_domain; intro; elim H3; clear H3; intros; unfold D' in H4; left; apply H4. - simpl in |- *; unfold intersection_domain in |- *; intro; elim H3; intro. + simpl; unfold intersection_domain; 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; + unfold eq_Dom; split. + unfold included; intros; elim H. + unfold included; 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. Proof. - unfold compact in |- *; intros; elim (classic (exists z : R, F z)); + unfold compact; 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). @@ -848,61 +848,61 @@ Proof. 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; + unfold covering_finite; 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 |- *; + unfold covering; unfold covering in H5; intros. + elim (H5 _ (H1 _ H7)); intros y0 H8; exists y0; simpl in H8; simpl; 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; unfold domain_finite; 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 |- *; + intro; apply H7; simpl; unfold intersection_domain; + simpl in H9; unfold intersection_domain in H9; unfold D'; apply H9. intro; assert (H10 := H8 H9); simpl in H10; unfold intersection_domain in H10; - simpl in |- *; unfold intersection_domain in |- *; + simpl; unfold intersection_domain; unfold D' in H10; apply H10. - unfold covering_open_set in |- *; unfold covering_open_set in H2; elim H2; + unfold covering_open_set; unfold covering_open_set in H2; elim H2; clear H2; intros. split. - unfold covering in |- *; unfold covering in H2; intros. + unfold covering; unfold covering in H2; intros. elim (classic (F x)); intro. - elim (H2 _ H6); intros y0 H7; exists y0; simpl in |- *; unfold g' in |- *; + elim (H2 _ H6); intros y0 H7; exists y0; simpl; unfold g'; left; assumption. cut (exists z : R, D z). - intro; elim H7; clear H7; intros x0 H7; exists x0; simpl in |- *; - unfold g' in |- *; right. + intro; elim H7; clear H7; intros x0 H7; exists x0; simpl; + unfold g'; right. split. - unfold complementary in |- *; apply H6. + unfold complementary; 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 |- *; + unfold family_open_set; intro; simpl; unfold g'; 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. + unfold eq_Dom; split. + unfold included, union_domain, complementary; intros. elim H6; intro; [ left; apply H7 | right; split; assumption ]. - unfold included, union_domain, complementary in |- *; intros. + unfold included, union_domain, complementary; 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. + unfold eq_Dom; split. + unfold included, complementary; intros; left; apply H6. + unfold included, complementary; intros. elim H6; intro. apply H7. elim H7; intros _ H8; elim H5; apply H8. @@ -914,9 +914,9 @@ Proof. 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; + unfold eq_Dom; split. + unfold included; intros; elim H3. + assert (H3 := not_ex_all_not _ _ Hyp_F_NE); unfold included; intros; elim (H3 x); apply H4. Qed. @@ -947,7 +947,7 @@ Lemma continuity_compact : 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. + unfold compact; 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). @@ -956,24 +956,24 @@ Proof. 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; + unfold covering_finite; split. + unfold covering, image_dir; simpl; 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 |- *; + unfold family_finite; unfold domain_finite; elim H6; intros l H7; exists l; intro; elim (H7 x); intros; split; intro. - apply H8; simpl in H10; simpl in |- *; apply H10. + apply H8; simpl in H10; simpl; 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 |- *; + unfold covering_open_set; split. + unfold covering; intros; simpl; unfold covering in H1; + unfold image_dir in H1; unfold g; unfold image_rec; 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 |- *; + unfold family_open_set; unfold family_open_set in H2; intro; + simpl; unfold g; 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)). @@ -1010,16 +1010,16 @@ Proof. 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); + unfold continuity; intro; case (Rtotal_order x a); intro. + unfold continuity_pt; unfold continue_in; + unfold limit1_in; unfold limit_in; + simpl; unfold R_dist; intros; exists (a - x); split. - change (0 < a - x) in |- *; apply Rlt_Rminus; assumption. - intros; elim H5; clear H5; intros _ H5; unfold h in |- *. + change (0 < a - x); apply Rlt_Rminus; assumption. + intros; elim H5; clear H5; intros _ H5; unfold h. case (Rle_dec x a); intro. case (Rle_dec x0 a); intro. - unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. + unfold Rminus; 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. @@ -1030,23 +1030,23 @@ Proof. 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 |- *; + unfold R_dist in H6; unfold continuity_pt; + unfold continue_in; unfold limit1_in; + unfold limit_in; simpl; unfold R_dist; intros; elim (H6 _ H7); intros; exists (Rmin x0 (b - a)); split. - unfold Rmin in |- *; case (Rle_dec x0 (b - a)); intro. + unfold Rmin; case (Rle_dec x0 (b - a)); intro. elim H8; intros; assumption. - change (0 < b - a) in |- *; apply Rlt_Rminus; assumption. + change (0 < b - a); apply Rlt_Rminus; assumption. intros; elim H9; clear H9; intros _ H9; cut (x1 < b). - intro; unfold h in |- *; case (Rle_dec x a); intro. + intro; unfold h; case (Rle_dec x a); intro. case (Rle_dec x1 a); intro. - unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. + unfold Rminus; 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. + unfold D_x, no_cond; split. trivial. - red in |- *; intro; elim n; right; symmetry in |- *; assumption. + red; intro; elim n; right; symmetry ; assumption. apply Rlt_le_trans with (Rmin x0 (b - a)). rewrite H4 in H9; apply H9. apply Rmin_l. @@ -1063,9 +1063,9 @@ Proof. 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 |- *; + unfold R_dist in H7; unfold continuity_pt; + unfold continue_in; unfold limit1_in; + unfold limit_in; simpl; unfold R_dist; intros; elim (H7 _ H8); intros; elim H9; clear H9; intros. assert (H11 : 0 < x - a). @@ -1073,7 +1073,7 @@ Proof. 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. + unfold Rmin; case (Rle_dec (x - a) (b - x)); intro. case (Rle_dec x0 (x - a)); intro. assumption. assumption. @@ -1081,7 +1081,7 @@ Proof. 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 H15; clear H15; intros; unfold h; case (Rle_dec x a); intro. elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H4)). case (Rle_dec x b); intro. @@ -1115,16 +1115,16 @@ Proof. 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 |- *; + unfold R_dist in H8; unfold continuity_pt; + unfold continue_in; unfold limit1_in; + unfold limit_in; simpl; unfold R_dist; intros; elim (H8 _ H9); intros; exists (Rmin x0 (b - a)); split. - unfold Rmin in |- *; case (Rle_dec x0 (b - a)); intro. + unfold Rmin; case (Rle_dec x0 (b - a)); intro. elim H10; intros; assumption. - change (0 < b - a) in |- *; apply Rlt_Rminus; assumption. + change (0 < b - a); apply Rlt_Rminus; assumption. intros; elim H11; clear H11; intros _ H11; cut (a < x1). - intro; unfold h in |- *; case (Rle_dec x a); intro. + intro; unfold h; 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)). @@ -1132,15 +1132,15 @@ Proof. case (Rle_dec x1 b); intro. rewrite H6; elim H10; intros; elim r0; intro. apply H14; split. - unfold D_x, no_cond in |- *; split. + unfold D_x, no_cond; split. trivial. - red in |- *; intro; rewrite <- H16 in H15; elim (Rlt_irrefl _ H15). + red; 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; + rewrite H15; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. - rewrite H6; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; + rewrite H6; unfold Rminus; 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; @@ -1149,18 +1149,18 @@ Proof. 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); + unfold continuity_pt; unfold continue_in; + unfold limit1_in; unfold limit_in; + simpl; unfold R_dist; intros; exists (x - b); split. - change (0 < x - b) in |- *; apply Rlt_Rminus; assumption. + change (0 < x - b); 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. + unfold h; 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)). @@ -1168,8 +1168,8 @@ Proof. 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. + unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. + intros; elim H3; intros; unfold h; case (Rle_dec c a); intro. elim r; intro. elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 H6)). rewrite H6; reflexivity. @@ -1210,7 +1210,7 @@ Proof. 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 ]. + unfold image_dir; exists c; split; [ reflexivity | apply H10 ]. apply H9. elim (classic (image_dir g (fun c:R => a <= c <= b) M)); intro. assumption. @@ -1225,13 +1225,13 @@ Proof. 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 |- *; + pattern M at 2; rewrite <- Rplus_0_r; unfold Rminus; 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). + unfold is_upper_bound, image_dir; 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. + elim (H9 x); unfold intersection_domain, disc, image_dir; 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). @@ -1249,8 +1249,8 @@ Proof. ~ 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; + red; intro; elim (H11 y). + unfold intersection_domain; unfold intersection_domain in H13; elim H13; clear H13; intros; split. apply (H12 _ H13). apply H14. @@ -1268,18 +1268,18 @@ Proof. split. apply H12. apply (not_ex_all_not _ _ H13). - red in |- *; intro; cut (adherence (image_dir g (fun c:R => a <= c <= b)) M). + red; 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. + exists (g a); unfold image_dir; 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 |- *; + unfold bound; unfold bounded in H4; elim H4; clear H4; intros m H4; + elim H4; clear H4; intros M H4; exists M; unfold is_upper_bound; intros; elim (H4 _ H5); intros _ H6; apply H6. apply prolongement_C0; assumption. Qed. @@ -1327,8 +1327,8 @@ 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. + unfold neighbourhood, disc; exists (mkposreal _ Rlt_0_1); + unfold included; trivial. elim (H0 _ H1); intros; unfold intersection_domain in H2; elim H2; intros; elim H4; intros; apply H6. Qed. @@ -1345,17 +1345,17 @@ Lemma ValAdh_un_prop : 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 |- *; + unfold ValAdh in H; unfold ValAdh_un; + unfold intersection_family; simpl; + intros; elim H0; intros N H1; unfold adherence; + unfold point_adherent; intros; elim (H V N H2); + intros; exists (un x0); unfold intersection_domain; 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 ValAdh; intros; unfold ValAdh_un in H; unfold intersection_family in H; simpl in H; assert (H1 : @@ -1376,8 +1376,8 @@ Qed. Lemma adherence_P4 : 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 |- *; + unfold adherence, included; unfold point_adherent; intros; + elim (H0 _ H1); unfold intersection_domain; intros; elim H2; clear H2; intros; exists x0; split; [ assumption | apply (H _ H3) ]. Qed. @@ -1410,36 +1410,36 @@ Proof. 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; + unfold covering_open_set; split. + unfold covering; 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 |- *; + intros; unfold f0; simpl; unfold f'; split; [ apply H10 | apply H9 ]. - unfold family_open_set in |- *; intro; elim (classic (D' x)); intro. + unfold family_open_set; 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 |- *; + unfold f0; simpl; unfold f'; unfold eq_Dom; split. - unfold included in |- *; intros; split; [ apply H4 | apply H3 ]. - unfold included in |- *; intros; elim H4; intros; assumption. + unfold included; intros; split; [ apply H4 | apply H3 ]. + unfold included; 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; + unfold eq_Dom; unfold included; 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; + unfold intersection_vide_finite_in; split. + unfold intersection_vide_in; simpl; intros; split. + intros; unfold included; 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; + red; 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 _; @@ -1462,16 +1462,16 @@ Proof. 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. + intros; unfold intersection_domain; 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 |- *; + unfold family_finite; unfold domain_finite; 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) ]. + [ apply H6; simpl; simpl in H8; apply H8 | apply (H7 H8) ]. Qed. Theorem Bolzano_Weierstrass : @@ -1492,8 +1492,8 @@ Proof. 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. + unfold neighbourhood; exists (mkposreal _ Rlt_0_1); + unfold included; trivial. elim (H3 _ H4); intros; unfold intersection_domain in H5; decompose [and] H5; assumption. set (f0 := mkfamily D g H2). @@ -1509,19 +1509,19 @@ Proof. 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. + unfold intersection_family; simpl; + unfold intersection_domain; intros; split. + unfold g; 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 ]. + | rewrite <- H12; unfold r; apply MaxRlist_P1; elim (H9 y); intros; + apply H14; simpl; 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; + unfold r; 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. @@ -1541,16 +1541,16 @@ Proof. 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 |- *; + unfold intersection_vide_in; intros; split. + intro; simpl in H6; unfold f0; simpl; unfold g; apply included_trans with (adherence X). apply adherence_P4. - unfold included in |- *; intros; elim H7; intros; elim H8; intros; elim H10; + unfold included; 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. + unfold family_closed_set; unfold f0; simpl; + unfold g; intro; apply adherence_P3. Qed. (********************************************************) @@ -1566,7 +1566,7 @@ Definition uniform_continuity (f:R -> R) (X:R -> Prop) : Prop := Lemma is_lub_u : 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; + unfold is_lub; intros; elim H; elim H0; intros; apply Rle_antisym; [ apply (H4 _ H1) | apply (H2 _ H3) ]. Qed. @@ -1581,7 +1581,7 @@ Proof. right; elim H1; intros; elim H2; intros; exists x; exists x0; intros. split; [ assumption - | split; [ assumption | apply (sym_not_eq (A:=R)); assumption ] ]. + | split; [ assumption | apply (not_eq_sym (A:=R)); assumption ] ]. left; exists x; split. assumption. intros; case (Req_dec x0 x); intro. @@ -1597,14 +1597,14 @@ Theorem Heine : Proof. intros f0 X H0 H; elim (domain_P1 X); intro Hyp. (* X is empty *) - unfold uniform_continuity in |- *; intros; exists (mkposreal _ Rlt_0_1); + unfold uniform_continuity; intros; exists (mkposreal _ Rlt_0_1); intros; elim Hyp; exists x; assumption. elim Hyp; clear Hyp; intro Hyp. (* X has only one element *) - unfold uniform_continuity in |- *; intros; exists (mkposreal _ Rlt_0_1); + unfold uniform_continuity; 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 H6; rewrite H7; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply (cond_pos eps). (* X has at least two distinct elements *) assert @@ -1624,9 +1624,9 @@ Proof. 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; + unfold uniform_continuity; intro; assert (H1 : forall t:posreal, 0 < t / 2). - intro; unfold Rdiv in |- *; apply Rmult_lt_0_compat; + intro; unfold Rdiv; apply Rmult_lt_0_compat; [ apply (cond_pos t) | apply Rinv_0_lt_compat; prove_sup0 ]. set (g := @@ -1644,8 +1644,8 @@ Proof. 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 |- *; + unfold covering_open_set; split. + unfold covering; intros; exists x; simpl; unfold g; split. assumption. assert (H4 := H _ H3); unfold continuity_pt in H4; unfold continue_in in H4; @@ -1658,22 +1658,22 @@ Proof. 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 _; + unfold bound; exists (M - m); unfold is_upper_bound; + unfold E; 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; + elim H5; clear H5; intros; exists (Rmin x0 (M - m)); unfold E; intros; split. split. - unfold Rmin in |- *; case (Rle_dec x0 (M - m)); intro. + unfold Rmin; 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; + rewrite H9; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply (H1 eps). apply H7; split. - unfold D_x, no_cond in |- *; split; [ trivial | assumption ]. + unfold D_x, no_cond; 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). @@ -1690,15 +1690,15 @@ Proof. 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; + unfold is_upper_bound; 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 |- *; + unfold disc; unfold Rminus; rewrite Rplus_opp_r; + rewrite Rabs_R0; simpl; unfold Rdiv; 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; @@ -1706,13 +1706,13 @@ Proof. 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)); + unfold family_open_set; intro; simpl; elim (classic (X x)); intro. - unfold g in |- *; unfold open_set in |- *; intros; elim H4; clear H4; + unfold g; unfold open_set; 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); + intros; unfold neighbourhood; case (Req_dec x x0); intro. - exists (mkposreal _ (H1 x1)); rewrite <- H6; unfold included in |- *; intros; + exists (mkposreal _ (H1 x1)); rewrite <- H6; unfold included; intros; split. assumption. exists x1; split. @@ -1721,24 +1721,24 @@ Proof. 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 d; apply Rlt_Rminus; elim H5; clear H5; intros; unfold disc in H7; apply H7. - exists (mkposreal _ H7); unfold included in |- *; intros; split. + exists (mkposreal _ H7); unfold included; 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 H8; simpl in H8; unfold disc; simpl; 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 ]. + replace (x1 / 2) with (d + Rabs (x0 - x)); [ idtac | unfold d; 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. + unfold eq_Dom; unfold included; 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; @@ -1776,10 +1776,10 @@ Proof. 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. + unfold Rdiv; 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 Rmult_1_r; pattern (pos_Rl l' i) at 1; 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; @@ -1791,15 +1791,15 @@ Proof. 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)); + unfold Rdiv; 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)); + unfold D; 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; + unfold Rdiv; apply Rmult_lt_0_compat; + [ unfold D; 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 @@ -1811,25 +1811,25 @@ Proof. 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 _; + unfold bound; exists (M - m); unfold is_upper_bound; + unfold E; 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; exists (Rmin x0 (M - m)); unfold E; intros; split. split; - [ unfold Rmin in |- *; case (Rle_dec x0 (M - m)); intro; + [ unfold Rmin; 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; + rewrite H16; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply (H1 eps). apply H14; split; - [ unfold D_x, no_cond in |- *; split; [ trivial | assumption ] + [ unfold D_x, no_cond; 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). @@ -1847,14 +1847,14 @@ Proof. 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; + unfold is_upper_bound; 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; + unfold included, g; 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. diff --git a/theories/Reals/Rtrigo.v b/theories/Reals/Rtrigo.v index e45353b5..32c4d7d3 100644 --- a/theories/Reals/Rtrigo.v +++ b/theories/Reals/Rtrigo.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -16,1789 +16,11 @@ Require Export Cos_rel. Require Export Cos_plus. Require Import ZArith_base. Require Import Zcomplements. -Local Open Scope nat_scope. -Local Open Scope R_scope. - -(** sin_PI2 is the only remaining axiom **) -Axiom sin_PI2 : sin (PI / 2) = 1. - -(**********) -Lemma PI_neq0 : PI <> 0. -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. -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. -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). -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. -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. -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. -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. -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). -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. -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. -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). -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 *) -(*******************************************************) - -Lemma sin2 : forall x:R, Rsqr (sin x) = 1 - Rsqr (cos x). -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. -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. -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. -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. -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). -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. -Proof. - apply sin_antisym. -Qed. - -Lemma cos_neg : forall x:R, cos (- x) = cos x. -Proof. - intro; symmetry in |- *; apply cos_sym. -Qed. - -Lemma tan_0 : tan 0 = 0. -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. -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). -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. -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. -Proof. - rewrite sin_2a; rewrite sin_PI; ring. -Qed. - -Lemma cos_2PI : cos (2 * PI) = 1. -Proof. - rewrite cos_2a; rewrite sin_PI; rewrite cos_PI; ring. -Qed. - -Lemma neg_sin : forall x:R, sin (x + PI) = - sin x. -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. -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. -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. -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. -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. -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). -Proof. - intro x; rewrite sin_plus; rewrite sin_PI2; rewrite cos_PI2; ring. -Qed. - -Lemma PI2_RGT_0 : 0 < PI / 2. -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. -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. -Proof. - intro; rewrite <- sin_shift; apply SIN_bound. -Qed. - -Lemma cos_sin_0 : forall x:R, ~ (cos x = 0 /\ sin x = 0). -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. -Proof. - intros x. - destruct (Req_dec (cos x) 0). 2: now left. - right. intros H'. - apply (cos_sin_0 x). - now split. -Qed. - -(*****************************************************************) -(** * Using series definitions of cos and sin *) -(*****************************************************************) - -Definition sin_lb (a:R) : R := sin_approx a 3. -Definition sin_ub (a:R) : R := sin_approx a 4. -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. -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. - ring. - apply INR_fact_neq_0. - apply INR_fact_neq_0. - ring. -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). -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). -Qed. - -(**********) -Lemma _PI2_RLT_0 : - (PI / 2) < 0. -Proof. - rewrite <- Ropp_0; apply Ropp_lt_contravar; apply PI2_RGT_0. -Qed. - -Lemma PI4_RLT_PI2 : PI / 4 < PI / 2. -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. -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. -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. -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. -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. -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. -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. -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. -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. -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. -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. -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. -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. -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). -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). -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). -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). -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. -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. -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. -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. -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. -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. -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. -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. -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). -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. -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. -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. -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. -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. -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. -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. -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. -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. -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. -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. -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. -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. -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. -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. -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. -unfold INR in H3. field_simplify [(sym_eq H3)]. field. -(** - 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. -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. -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. -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). -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. -Proof. - intros x H1 H2 H3; elim H3; intro H4; - [ rewrite H4; rewrite cos_PI2; reflexivity - | rewrite H4; rewrite cos_3PI2; reflexivity ]. -Qed. +Require Import Classical_Prop. +Require Import Fourier. +Require Import Ranalysis1. +Require Import Rsqrt_def. +Require Import PSeries_reg. +Require Export Rtrigo1. +Require Export Ratan. +Require Export Machin.
\ No newline at end of file diff --git a/theories/Reals/Rtrigo1.v b/theories/Reals/Rtrigo1.v new file mode 100644 index 00000000..6174ef32 --- /dev/null +++ b/theories/Reals/Rtrigo1.v @@ -0,0 +1,1933 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +Require Import Rbase. +Require Import Rfunctions. +Require Import SeqSeries. +Require Export Rtrigo_fun. +Require Export Rtrigo_def. +Require Export Rtrigo_alt. +Require Export Cos_rel. +Require Export Cos_plus. +Require Import ZArith_base. +Require Import Zcomplements. +Require Import Classical_Prop. +Require Import Fourier. +Require Import Ranalysis1. +Require Import Rsqrt_def. +Require Import PSeries_reg. + +Local Open Scope nat_scope. +Local Open 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. +Proof. + unfold CVN_R in |- *; intros. + cut ((r:R) <> 0). + intro hyp_r; unfold CVN_r in |- *. + exists (fun n:nat => / INR (fact (2 * n)) * r ^ (2 * n)). + cut + { 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. + exists 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. + 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. +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, { 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 infinite_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 sin_gt_cos_7_8 : sin (7 / 8) > cos (7 / 8). +Proof. +assert (lo1 : 0 <= 7/8) by fourier. +assert (up1 : 7/8 <= 4) by fourier. +assert (lo : -2 <= 7/8) by fourier. +assert (up : 7/8 <= 2) by fourier. +destruct (pre_sin_bound _ 0 lo1 up1) as [lower _ ]. +destruct (pre_cos_bound _ 0 lo up) as [_ upper]. +apply Rle_lt_trans with (1 := upper). +apply Rlt_le_trans with (2 := lower). +unfold cos_approx, sin_approx. +simpl sum_f_R0; replace 7 with (IZR 7) by (simpl; field). +replace 8 with (IZR 8) by (simpl; field). +unfold cos_term, sin_term; simpl fact; rewrite !INR_IZR_INZ. +simpl plus; simpl mult. +field_simplify; + try (repeat apply conj; apply not_eq_sym, Rlt_not_eq, (IZR_lt 0); reflexivity). +unfold Rminus; rewrite !pow_IZR, <- !mult_IZR, <- !opp_IZR, <- ?plus_IZR. +match goal with + |- IZR ?a / ?b < ?c / ?d => + apply Rmult_lt_reg_r with d;[apply (IZR_lt 0); reflexivity | + unfold Rdiv at 2; rewrite Rmult_assoc, Rinv_l, Rmult_1_r, Rmult_comm; + [ |apply not_eq_sym, Rlt_not_eq, (IZR_lt 0); reflexivity ]]; + apply Rmult_lt_reg_r with b;[apply (IZR_lt 0); reflexivity | ] +end. +unfold Rdiv; rewrite !Rmult_assoc, Rinv_l, Rmult_1_r; + [ | apply not_eq_sym, Rlt_not_eq, (IZR_lt 0); reflexivity]. +repeat (rewrite <- !plus_IZR || rewrite <- !mult_IZR). +apply IZR_lt; reflexivity. +Qed. + +Definition PI_2_aux : {z | 7/8 <= z <= 7/4 /\ -cos z = 0}. +assert (cc : continuity (fun r =>- cos r)). + apply continuity_opp, continuity_cos. +assert (cvp : 0 < cos (7/8)). + assert (int78 : -2 <= 7/8 <= 2) by (split; fourier). + destruct int78 as [lower upper]. + case (pre_cos_bound _ 0 lower upper). + unfold cos_approx; simpl sum_f_R0; unfold cos_term. + intros cl _; apply Rlt_le_trans with (2 := cl); simpl. + fourier. +assert (cun : cos (7/4) < 0). + replace (7/4) with (7/8 + 7/8) by field. + rewrite cos_plus. + apply Rlt_minus; apply Rsqr_incrst_1. + exact sin_gt_cos_7_8. + apply Rlt_le; assumption. + apply Rlt_le; apply Rlt_trans with (1 := cvp); exact sin_gt_cos_7_8. +apply IVT; auto; fourier. +Qed. + +Definition PI2 := proj1_sig PI_2_aux. + +Definition PI := 2 * PI2. + +Lemma cos_pi2 : cos PI2 = 0. +unfold PI2; case PI_2_aux; simpl. +intros x [_ q]; rewrite <- (Ropp_involutive (cos x)), q; apply Ropp_0. +Qed. + +Lemma pi2_int : 7/8 <= PI2 <= 7/4. +unfold PI2; case PI_2_aux; simpl; tauto. +Qed. + +(**********) +Lemma cos_minus : forall x y:R, cos (x - y) = cos x * cos y + sin x * sin y. +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. +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). +Proof. + intros x; rewrite <- (sin2_cos2 x); ring. +Qed. + +Lemma sin2 : forall x:R, Rsqr (sin x) = 1 - Rsqr (cos x). +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 cos_PI2 : cos (PI / 2) = 0. +Proof. + unfold PI; generalize cos_pi2; replace ((2 * PI2)/2) with PI2 by field; tauto. +Qed. + +Lemma sin_pos_tech : forall x, 0 < x < 2 -> 0 < sin x. +intros x [int1 int2]. +assert (lo : 0 <= x) by (apply Rlt_le; assumption). +assert (up : x <= 4) by (apply Rlt_le, Rlt_trans with (1:=int2); fourier). +destruct (pre_sin_bound _ 0 lo up) as [t _]; clear lo up. +apply Rlt_le_trans with (2:= t); clear t. +unfold sin_approx; simpl sum_f_R0; unfold sin_term; simpl. +match goal with |- _ < ?a => + replace a with (x * (1 - x^2/6)) by (simpl; field) +end. +assert (t' : x ^ 2 <= 4). + replace 4 with (2 ^ 2) by field. + apply (pow_incr x 2); split; apply Rlt_le; assumption. +apply Rmult_lt_0_compat;[assumption | fourier ]. +Qed. + +Lemma sin_PI2 : sin (PI / 2) = 1. +replace (PI / 2) with PI2 by (unfold PI; field). +assert (int' : 0 < PI2 < 2). + destruct pi2_int; split; fourier. +assert (lo2 := sin_pos_tech PI2 int'). +assert (t2 : Rabs (sin PI2) = 1). + rewrite <- Rabs_R1; apply Rsqr_eq_abs_0. + rewrite Rsqr_1, sin2, cos_pi2, Rsqr_0, Rminus_0_r; reflexivity. +revert t2; rewrite Rabs_pos_eq;[| apply Rlt_le]; tauto. +Qed. + +Lemma PI_RGT_0 : PI > 0. +Proof. unfold PI; destruct pi2_int; fourier. Qed. + +Lemma PI_4 : PI <= 4. +Proof. unfold PI; destruct pi2_int; fourier. Qed. + +(**********) +Lemma PI_neq0 : PI <> 0. +Proof. + red in |- *; intro; assert (H0 := PI_RGT_0); rewrite H in H0; + elim (Rlt_irrefl _ H0). +Qed. + + +(**********) +Lemma cos_PI : cos PI = -1. +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. +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 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)). +Proof. +intros a n a0 api; apply pre_sin_bound. + assumption. +apply Rle_trans with (1:= api) (2 := PI_4). +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)). +Proof. +intros a n lower upper; apply pre_cos_bound. + apply Rle_trans with (2 := lower). + apply Rmult_le_reg_r with 2; [fourier |]. + replace ((-PI/2) * 2) with (-PI) by field. + assert (t := PI_4); fourier. +apply Rle_trans with (1 := upper). +apply Rmult_le_reg_r with 2; [fourier | ]. +replace ((PI/2) * 2) with PI by field. +generalize PI_4; intros; fourier. +Qed. +(**********) +Lemma neg_cos : forall x:R, cos (x + PI) = - cos x. +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). +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. +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. +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). +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 *) +(*******************************************************) + +Lemma sin_2a : forall x:R, sin (2 * x) = 2 * sin x * cos x. +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. +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. +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. +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). +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. +Proof. + apply sin_antisym. +Qed. + +Lemma cos_neg : forall x:R, cos (- x) = cos x. +Proof. + intro; symmetry in |- *; apply cos_sym. +Qed. + +Lemma tan_0 : tan 0 = 0. +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. +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). +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. +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. +Proof. + rewrite sin_2a; rewrite sin_PI; ring. +Qed. + +Lemma cos_2PI : cos (2 * PI) = 1. +Proof. + rewrite cos_2a; rewrite sin_PI; rewrite cos_PI; ring. +Qed. + +Lemma neg_sin : forall x:R, sin (x + PI) = - sin x. +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. +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. +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. +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. +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. +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). +Proof. + intro x; rewrite sin_plus; rewrite sin_PI2; rewrite cos_PI2; ring. +Qed. + +Lemma PI2_RGT_0 : 0 < PI / 2. +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. +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. +Proof. + intro; rewrite <- sin_shift; apply SIN_bound. +Qed. + +Lemma cos_sin_0 : forall x:R, ~ (cos x = 0 /\ sin x = 0). +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. +Proof. + intros x. + destruct (Req_dec (cos x) 0). 2: now left. + right. intros H'. + apply (cos_sin_0 x). + now split. +Qed. + +(*****************************************************************) +(** * Using series definitions of cos and sin *) +(*****************************************************************) + +Definition sin_lb (a:R) : R := sin_approx a 3. +Definition sin_ub (a:R) : R := sin_approx a 4. +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. +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. + ring. + apply INR_fact_neq_0. + apply INR_fact_neq_0. + ring. +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). +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). +Qed. + +(**********) +Lemma _PI2_RLT_0 : - (PI / 2) < 0. +Proof. + rewrite <- Ropp_0; apply Ropp_lt_contravar; apply PI2_RGT_0. +Qed. + +Lemma PI4_RLT_PI2 : PI / 4 < PI / 2. +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. +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. +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. +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. +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. +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. +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. +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. +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. +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. +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. +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. +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. +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). +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). +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). +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). +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. +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. +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. +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. +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. +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. +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. +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. +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). +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. +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 + (not_eq_sym + (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 + (not_eq_sym + (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. +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 + (not_eq_sym + (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 + (not_eq_sym + (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. +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. +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. +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. +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. +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. +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. +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. +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. +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. +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. +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 := Z.gt_lt_iff). + 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 (x:R) : sin x = 0 -> exists k : Z, x = IZR k * PI. +Proof. + intros Hx. + destruct (euclidian_division x PI PI_neq0) as (q & r & EQ & Hr & Hr'). + exists q. + rewrite <- (Rplus_0_r (_*_)). subst. apply Rplus_eq_compat_l. + rewrite sin_plus in Hx. + assert (H : sin (IZR q * PI) = 0) by (apply sin_eq_0_1; now exists q). + rewrite H, Rmult_0_l, Rplus_0_l in Hx. + destruct (Rmult_integral _ _ Hx) as [H'|H']. + - exfalso. + generalize (sin2_cos2 (IZR q * PI)). + rewrite H, H', Rsqr_0, Rplus_0_l. + intros; now apply R1_neq_R0. + - rewrite Rabs_right in Hr'; [|left; apply PI_RGT_0]. + destruct Hr as [Hr | ->]; trivial. + exfalso. + generalize (sin_gt_0 r Hr Hr'). rewrite H'. apply Rlt_irrefl. +Qed. + +Lemma cos_eq_0_0 (x:R) : + cos x = 0 -> exists k : Z, x = IZR k * PI + PI / 2. +Proof. + rewrite cos_sin. intros Hx. + destruct (sin_eq_0_0 (PI/2 + x) Hx) as (k,Hk). clear Hx. + exists (k-1)%Z. rewrite <- Z_R_minus; simpl. + symmetry in Hk. field_simplify [Hk]. field. +Qed. + +Lemma cos_eq_0_1 (x:R) : + (exists k : Z, x = IZR k * PI + PI / 2) -> cos x = 0. +Proof. + rewrite cos_sin. intros (k,->). + replace (_ + _) with (IZR k * PI + PI) by field. + rewrite neg_sin, <- Ropp_0. apply Ropp_eq_compat. + apply sin_eq_0_1. now exists k. +Qed. + +Lemma sin_eq_O_2PI_0 (x:R) : + 0 <= x -> x <= 2 * PI -> sin x = 0 -> + x = 0 \/ x = PI \/ x = 2 * PI. +Proof. + intros Lo Hi Hx. destruct (sin_eq_0_0 x Hx) as (k,Hk). clear Hx. + destruct (Rtotal_order PI x) as [Hx|[Hx|Hx]]. + - right; right. + clear Lo. subst. + f_equal. change 2 with (IZR (- (-2))). f_equal. + apply Z.add_move_0_l. + apply one_IZR_lt1. + rewrite plus_IZR; simpl. + split. + + replace (-1) with (-2 + 1) by ring. + apply Rplus_lt_compat_l. + apply Rmult_lt_reg_r with PI; [apply PI_RGT_0|]. + now rewrite Rmult_1_l. + + apply Rle_lt_trans with 0; [|apply Rlt_0_1]. + replace 0 with (-2 + 2) by ring. + apply Rplus_le_compat_l. + apply Rmult_le_reg_r with PI; [apply PI_RGT_0|]. + trivial. + - right; left; auto. + - left. + clear Hi. subst. + replace 0 with (IZR 0 * PI) by (simpl; ring). f_equal. f_equal. + apply one_IZR_lt1. + split. + + apply Rlt_le_trans with 0; + [rewrite <- Ropp_0; apply Ropp_gt_lt_contravar, Rlt_0_1 | ]. + apply Rmult_le_reg_r with PI; [apply PI_RGT_0|]. + now rewrite Rmult_0_l. + + apply Rmult_lt_reg_r with PI; [apply PI_RGT_0|]. + now rewrite Rmult_1_l. +Qed. + +Lemma sin_eq_O_2PI_1 (x:R) : + 0 <= x -> x <= 2 * PI -> + x = 0 \/ x = PI \/ x = 2 * PI -> sin x = 0. +Proof. + intros _ _ [ -> |[ -> | -> ]]. + - now rewrite sin_0. + - now rewrite sin_PI. + - now rewrite sin_2PI. +Qed. + +Lemma cos_eq_0_2PI_0 (x:R) : + 0 <= x -> x <= 2 * PI -> cos x = 0 -> + x = PI / 2 \/ x = 3 * (PI / 2). +Proof. + intros Lo Hi Hx. + destruct (Rtotal_order x (3 * (PI / 2))) as [LT|[EQ|GT]]. + - rewrite cos_sin in Hx. + assert (Lo' : 0 <= PI / 2 + x). + { apply Rplus_le_le_0_compat. apply Rlt_le, PI2_RGT_0. trivial. } + assert (Hi' : PI / 2 + x <= 2 * PI). + { apply Rlt_le. + replace (2 * PI) with (PI / 2 + 3 * (PI / 2)) by field. + now apply Rplus_lt_compat_l. } + destruct (sin_eq_O_2PI_0 (PI / 2 + x) Lo' Hi' Hx) as [H|[H|H]]. + + exfalso. + apply (Rplus_le_compat_l (PI/2)) in Lo. + rewrite Rplus_0_r, H in Lo. + apply (Rlt_irrefl 0 (Rlt_le_trans 0 (PI / 2) 0 PI2_RGT_0 Lo)). + + left. + apply (Rplus_eq_compat_l (-(PI/2))) in H. + ring_simplify in H. rewrite H. field. + + right. + apply (Rplus_eq_compat_l (-(PI/2))) in H. + ring_simplify in H. rewrite H. field. + - now right. + - exfalso. + destruct (cos_eq_0_0 x Hx) as (k,Hk). clear Hx Lo. + subst. + assert (LT : (k < 2)%Z). + { apply lt_IZR. simpl. + apply (Rmult_lt_reg_r PI); [apply PI_RGT_0|]. + apply Rlt_le_trans with (IZR k * PI + PI/2); trivial. + rewrite <- (Rplus_0_r (IZR k * PI)) at 1. + apply Rplus_lt_compat_l. apply PI2_RGT_0. } + assert (GT' : (1 < k)%Z). + { apply lt_IZR. simpl. + apply (Rmult_lt_reg_r PI); [apply PI_RGT_0|rewrite Rmult_1_l]. + replace (3*(PI/2)) with (PI/2 + PI) in GT by field. + rewrite Rplus_comm in GT. + now apply Rplus_lt_reg_r in GT. } + omega. +Qed. + +Lemma cos_eq_0_2PI_1 (x:R) : + 0 <= x -> x <= 2 * PI -> + x = PI / 2 \/ x = 3 * (PI / 2) -> cos x = 0. +Proof. + intros Lo Hi [ -> | -> ]. + - now rewrite cos_PI2. + - now rewrite cos_3PI2. +Qed. diff --git a/theories/Reals/Rtrigo_alt.v b/theories/Reals/Rtrigo_alt.v index 3ab7d598..23b8e847 100644 --- a/theories/Reals/Rtrigo_alt.v +++ b/theories/Reals/Rtrigo_alt.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -10,7 +10,7 @@ Require Import Rbase. Require Import Rfunctions. Require Import SeqSeries. Require Import Rtrigo_def. -Open Local Scope R_scope. +Local Open Scope R_scope. (***************************************************************) (** Using series definitions of cos and sin *) @@ -27,7 +27,8 @@ Definition sin_approx (a:R) (n:nat) : R := sum_f_R0 (sin_term a) n. Definition cos_approx (a:R) (n:nat) : R := sum_f_R0 (cos_term a) n. (**********) -Lemma PI_4 : PI <= 4. +(* +Lemma Alt_PI_4 : Alt_PI <= 4. Proof. assert (H0 := PI_ineq 0). elim H0; clear H0; intros _ H0. @@ -37,20 +38,20 @@ Proof. apply Rinv_0_lt_compat; prove_sup0. rewrite <- Rinv_l_sym; [ rewrite Rmult_comm; assumption | discrR ]. Qed. - +*) (**********) -Theorem sin_bound : +Theorem pre_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)). + a <= 4 -> 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; + rewrite Hyp_a; rewrite sin_0; split; right; unfold sin_approx; + apply sum_eq_R0 || (symmetry ; apply sum_eq_R0); + intros; unfold sin_term; rewrite pow_add; + simpl; unfold Rdiv; rewrite Rmult_0_l; ring. - unfold sin_approx in |- *; cut (0 < a). + unfold sin_approx; 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))). @@ -75,22 +76,22 @@ Proof. - sum_f_R0 (tg_alt Un) (S (2 * n))). intro; apply H2. apply alternated_series_ineq. - unfold Un_decreasing, Un in |- *; intro; + unfold Un_decreasing, Un; 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. + unfold Rdiv; 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; apply lt_INR_0; apply neq_O_lt; red; intro; + assert (H5 := eq_sym 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 |- *; + simpl; replace (((0 + 1 + 1) * (INR n0 + 1) + (0 + 1) + 1 + 1) * ((0 + 1 + 1) * (INR n0 + 1) + (0 + 1) + 1)) with @@ -100,12 +101,12 @@ Proof. 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. 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; + rewrite <- (Rplus_comm 20); pattern 20 at 1; rewrite <- Rplus_0_r; apply Rplus_le_compat_l. apply Rplus_le_le_0_compat. repeat apply Rmult_le_pos. @@ -118,14 +119,14 @@ Proof. 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. + simpl; ring. 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 |- *; + assert (H3 := cv_speed_pow_fact a); unfold Un; unfold Un_cv in H3; + unfold R_dist in H3; unfold Un_cv; unfold R_dist; 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. + unfold ge; 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. @@ -136,49 +137,49 @@ Proof. 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 infinite_sum in p; - unfold R_dist in p; unfold Un_cv in |- *; unfold R_dist in |- *; + unfold R_dist in p; unfold Un_cv; unfold R_dist; 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; + unfold Rminus; 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). + pattern (/ Rabs a) at 1; 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 |- *; + unfold Rminus, Rdiv in H6; apply H6; unfold ge; 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 |- *; + simpl; rewrite Rmult_1_r; unfold Rminus; 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 |- *; + intros; unfold sin_n, Un, tg_alt; 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; + unfold Rdiv; ring. + rewrite pow_add; rewrite pow_Rsqr; simpl; ring. + simpl; ring. + unfold sin_n; unfold Rdiv; simpl; rewrite Rinv_1; rewrite Rmult_1_r; reflexivity. apply lt_O_Sn. - unfold Rdiv in |- *; apply Rmult_lt_0_compat. + unfold Rdiv; apply Rmult_lt_0_compat. assumption. apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. - unfold sin in |- *; case (exist_sin (Rsqr a)). + unfold sin; case (exist_sin (Rsqr a)). intros; cut (x = x0). - intro; rewrite H3; unfold Rdiv in |- *. - symmetry in |- *; apply Rinv_r_simpl_m; assumption. + intro; rewrite H3; unfold Rdiv. + symmetry ; apply Rinv_r_simpl_m; assumption. unfold sin_in in p; unfold sin_in in s; eapply uniqueness_sum. apply p. apply s. @@ -187,16 +188,16 @@ Proof. 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 |- *; + apply sum_eq; intros; unfold sin_term, Un, tg_alt; replace ((-1) ^ S i) with (-1 * (-1) ^ i). - unfold Rdiv in |- *; ring. + unfold Rdiv; 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 |- *; + unfold sin_term, Un, tg_alt; replace ((-1) ^ S i) with (-1 * (-1) ^ i). - unfold Rdiv in |- *; ring. + unfold Rdiv; ring. reflexivity. replace (2 * (n + 1))%nat with (S (S (2 * n))). reflexivity. @@ -212,7 +213,7 @@ Proof. 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; + unfold sin_term; simpl; unfold Rdiv; rewrite Rinv_1; ring. replace (2 * (n + 1))%nat with (S (S (2 * n))). apply lt_O_Sn. @@ -220,27 +221,26 @@ Proof. replace (2 * n + 1)%nat with (S (2 * n)). apply lt_O_Sn. ring. - inversion H; [ assumption | elim Hyp_a; symmetry in |- *; assumption ]. + inversion H; [ assumption | elim Hyp_a; symmetry ; assumption ]. Qed. (**********) -Lemma cos_bound : +Lemma pre_cos_bound : forall (a:R) (n:nat), - - PI / 2 <= a -> - a <= PI / 2 -> + - 2 <= a -> a <= 2 -> 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 -> + a <= 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 -> + - 2 <= a -> + a <= 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 |- *. + intros; unfold cos_approx. 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. @@ -266,21 +266,21 @@ Proof. - sum_f_R0 (tg_alt Un) (S (2 * n0))). intro; apply H3. apply alternated_series_ineq. - unfold Un_decreasing in |- *; intro; unfold Un in |- *. + unfold Un_decreasing; intro; unfold Un. 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. + unfold Rdiv; 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; apply lt_INR_0; apply neq_O_lt; red; intro; + assert (H6 := eq_sym 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 |- *; + simpl; 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 ]. @@ -289,18 +289,13 @@ Proof. 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); + pattern 4 at 1; 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; + rewrite <- (Rplus_comm 12); pattern 12 at 1; rewrite <- Rplus_0_r; apply Rplus_le_compat_l. apply Rplus_le_le_0_compat. repeat apply Rmult_le_pos. @@ -313,12 +308,12 @@ Proof. 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. + simpl; ring. 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 |- *; + assert (H4 := cv_speed_pow_fact a0); unfold Un; unfold Un_cv in H4; + unfold R_dist in H4; unfold Un_cv; unfold R_dist; 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 H6; unfold ge; 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. @@ -326,40 +321,40 @@ Proof. assert (X := exist_cos (Rsqr a0)); elim X; intros. cut (x = cos a0). intro; rewrite H4 in p; unfold cos_in in p; unfold infinite_sum in p; - unfold R_dist in p; unfold Un_cv in |- *; unfold R_dist in |- *; + unfold R_dist in p; unfold Un_cv; unfold R_dist; 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; + unfold Rminus; 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. + unfold ge; 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 |- *; + simpl; rewrite Rmult_1_r; unfold Rminus; 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 |- *. + intros; unfold cos_n, Un, tg_alt. replace ((-1) ^ S i) with (- (-1) ^ i). replace (a0 ^ (2 * S i)) with (Rsqr a0 * Rsqr a0 ^ i). - unfold Rdiv in |- *; ring. + unfold Rdiv; ring. rewrite pow_Rsqr; reflexivity. - simpl in |- *; ring. - unfold cos_n in |- *; unfold Rdiv in |- *; simpl in |- *; rewrite Rinv_1; + simpl; ring. + unfold cos_n; unfold Rdiv; simpl; 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; case (exist_cos (Rsqr a0)); intros; unfold cos_in in p; unfold cos_in in c; eapply uniqueness_sum. apply p. apply c. @@ -368,15 +363,15 @@ Proof. 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 |- *; + apply sum_eq; intros; unfold cos_term, Un, tg_alt; replace ((-1) ^ S i) with (-1 * (-1) ^ i). - unfold Rdiv in |- *; ring. + unfold Rdiv; 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 |- *; + apply sum_eq; intros; unfold cos_term, Un, tg_alt; replace ((-1) ^ S i) with (-1 * (-1) ^ i). - unfold Rdiv in |- *; ring. + unfold Rdiv; ring. reflexivity. replace (2 * (n0 + 1))%nat with (S (S (2 * n0))). reflexivity. @@ -391,7 +386,7 @@ Proof. 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; + unfold cos_term; simpl; unfold Rdiv; rewrite Rinv_1; ring. replace (2 * (n0 + 1))%nat with (S (S (2 * n0))). apply lt_O_Sn. @@ -407,11 +402,9 @@ Proof. 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. + rewrite <- (Ropp_involutive 2); apply Ropp_le_contravar; exact H0. + intros; unfold cos_approx; apply sum_eq; intros; + unfold cos_term; do 2 rewrite pow_Rsqr; rewrite Rsqr_neg; + unfold Rdiv; reflexivity. apply Ropp_0_gt_lt_contravar; assumption. Qed. diff --git a/theories/Reals/Rtrigo_calc.v b/theories/Reals/Rtrigo_calc.v index 587c2424..a1a3b007 100644 --- a/theories/Reals/Rtrigo_calc.v +++ b/theories/Reals/Rtrigo_calc.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -9,13 +9,13 @@ Require Import Rbase. Require Import Rfunctions. Require Import SeqSeries. -Require Import Rtrigo. +Require Import Rtrigo1. Require Import R_sqrt. -Open Local Scope R_scope. +Local Open Scope R_scope. Lemma tan_PI : tan PI = 0. Proof. - unfold tan in |- *; rewrite sin_PI; rewrite cos_PI; unfold Rdiv in |- *; + unfold tan; rewrite sin_PI; rewrite cos_PI; unfold Rdiv; apply Rmult_0_l. Qed. @@ -23,12 +23,12 @@ Lemma sin_3PI2 : sin (3 * (PI / 2)) = -1. 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. + pattern PI at 1; rewrite (double_var PI); ring. Qed. Lemma tan_2PI : tan (2 * PI) = 0. Proof. - unfold tan in |- *; rewrite sin_2PI; unfold Rdiv in |- *; apply Rmult_0_l. + unfold tan; rewrite sin_2PI; unfold Rdiv; apply Rmult_0_l. Qed. Lemma sin_cos_PI4 : sin (PI / 4) = cos (PI / 4). @@ -37,9 +37,9 @@ Proof with trivial. 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... + pattern PI at 2 3; rewrite H; pattern PI at 2 3; rewrite H... assert (H0 : 2 <> 0); - [ discrR | unfold Rdiv in |- *; rewrite Rinv_mult_distr; try ring ]... + [ discrR | unfold Rdiv; rewrite Rinv_mult_distr; try ring ]... Qed. Lemma sin_PI3_cos_PI6 : sin (PI / 3) = cos (PI / 6). @@ -51,7 +51,7 @@ Proof with trivial. 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... + unfold Rdiv; repeat rewrite Rmult_assoc... rewrite <- Rinv_l_sym... rewrite (Rmult_comm (/ 3)); repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym... rewrite (Rmult_comm PI); repeat rewrite Rmult_1_r; @@ -68,7 +68,7 @@ Proof with trivial. 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... + unfold Rdiv; repeat rewrite Rmult_assoc... rewrite <- Rinv_l_sym... rewrite (Rmult_comm (/ 3)); repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym... rewrite (Rmult_comm PI); repeat rewrite Rmult_1_r; @@ -78,13 +78,13 @@ Qed. Lemma PI6_RGT_0 : 0 < PI / 6. Proof. - unfold Rdiv in |- *; apply Rmult_lt_0_compat; + unfold Rdiv; 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. Proof. - unfold Rdiv in |- *; apply Rmult_lt_compat_l. + unfold Rdiv; apply Rmult_lt_compat_l. apply PI_RGT_0. apply Rinv_lt_contravar; prove_sup. Qed. @@ -97,11 +97,11 @@ Proof with trivial. (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; + unfold Rdiv; rewrite Rmult_1_l; rewrite Rmult_assoc; + pattern 2 at 2; rewrite (Rmult_comm 2); rewrite Rmult_assoc; rewrite <- Rinv_l_sym... rewrite Rmult_1_r... - unfold Rdiv in |- *; rewrite Rinv_mult_distr... + unfold Rdiv; rewrite Rinv_mult_distr... rewrite (Rmult_comm (/ 2)); rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym... rewrite Rmult_1_r... @@ -119,7 +119,7 @@ Lemma sqrt2_neq_0 : sqrt 2 <> 0. Proof. assert (Hyp : 0 < 2); [ prove_sup0 - | generalize (Rlt_le 0 2 Hyp); intro H1; red in |- *; intro H2; + | generalize (Rlt_le 0 2 Hyp); intro H1; red; intro H2; generalize (sqrt_eq_0 2 H1 H2); intro H; absurd (2 = 0); [ discrR | assumption ] ]. Qed. @@ -137,7 +137,7 @@ Proof. [ discrR | assert (Hyp : 0 < 3); [ prove_sup0 - | generalize (Rlt_le 0 3 Hyp); intro H1; red in |- *; intro H2; + | generalize (Rlt_le 0 3 Hyp); intro H1; red; intro H2; generalize (sqrt_eq_0 3 H1 H2); intro H; absurd (3 = 0); [ discrR | assumption ] ] ]. Qed. @@ -150,7 +150,7 @@ Proof. intro H2; [ assumption | absurd (0 = sqrt 2); - [ apply (sym_not_eq (A:=R)); apply sqrt2_neq_0 | assumption ] ] ]. + [ apply (not_eq_sym (A:=R)); apply sqrt2_neq_0 | assumption ] ] ]. Qed. Lemma Rlt_sqrt3_0 : 0 < sqrt 3. @@ -162,7 +162,7 @@ Proof. [ 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; + unfold INR; 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; @@ -173,7 +173,7 @@ Qed. Lemma PI4_RGT_0 : 0 < PI / 4. Proof. - unfold Rdiv in |- *; apply Rmult_lt_0_compat; + unfold Rdiv; apply Rmult_lt_0_compat; [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup0 ]. Qed. @@ -189,17 +189,17 @@ Proof with trivial. 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 |- *; + unfold Rsqr; pattern (cos (PI / 4)) at 1; 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... + unfold Rdiv; 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... + unfold Rdiv; rewrite Rmult_1_l; repeat rewrite <- Rmult_assoc... rewrite <- Rinv_l_sym... rewrite Rmult_1_l... left; prove_sup... @@ -213,18 +213,18 @@ Qed. Lemma tan_PI4 : tan (PI / 4) = 1. 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. + unfold tan; rewrite sin_cos_PI4. + unfold Rdiv; apply Rinv_r. + change (cos (PI / 4) <> 0); 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; + unfold Rdiv; rewrite Ropp_mult_distr_l_reverse... + unfold Rminus; rewrite Ropp_involutive; pattern PI at 1; + rewrite double_var; unfold Rdiv; rewrite Rmult_plus_distr_r; repeat rewrite Rmult_assoc; rewrite <- Rinv_mult_distr; [ ring | discrR | discrR ]... Qed. @@ -233,8 +233,8 @@ 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; + unfold Rminus; rewrite Ropp_involutive; pattern PI at 1; + rewrite double_var; unfold Rdiv; rewrite Rmult_plus_distr_r; repeat rewrite Rmult_assoc; rewrite <- Rinv_mult_distr; [ ring | discrR | discrR ]... Qed. @@ -251,8 +251,8 @@ Proof with trivial. 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 cos2; unfold Rsqr; rewrite sin_PI6; rewrite sqrt_def... + unfold Rdiv; 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... @@ -265,14 +265,14 @@ Qed. Lemma tan_PI6 : tan (PI / 6) = 1 / sqrt 3. Proof. - unfold tan in |- *; rewrite sin_PI6; rewrite cos_PI6; unfold Rdiv in |- *; + unfold tan; rewrite sin_PI6; rewrite cos_PI6; unfold Rdiv; 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; + red; intro; assert (H1 := Rlt_sqrt3_0); rewrite H in H1; elim (Rlt_irrefl 0 H1). apply Rinv_neq_0_compat; discrR. Qed. @@ -289,7 +289,7 @@ Qed. Lemma tan_PI3 : tan (PI / 3) = sqrt 3. Proof. - unfold tan in |- *; rewrite sin_PI3; rewrite cos_PI3; unfold Rdiv in |- *; + unfold tan; rewrite sin_PI3; rewrite cos_PI3; unfold Rdiv; rewrite Rmult_1_l; rewrite Rinv_involutive. rewrite Rmult_assoc; rewrite <- Rinv_l_sym. apply Rmult_1_r. @@ -300,7 +300,7 @@ Qed. Lemma sin_2PI3 : sin (2 * (PI / 3)) = sqrt 3 / 2. Proof. rewrite double; rewrite sin_plus; rewrite sin_PI3; rewrite cos_PI3; - unfold Rdiv in |- *; repeat rewrite Rmult_1_l; rewrite (Rmult_comm (/ 2)); + unfold Rdiv; repeat rewrite Rmult_1_l; rewrite (Rmult_comm (/ 2)); repeat rewrite <- Rmult_assoc; rewrite double_var; reflexivity. Qed. @@ -310,12 +310,12 @@ 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... + unfold Rdiv; 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; + pattern 2 at 4; 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... @@ -329,7 +329,7 @@ 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 |- *; + unfold tan; rewrite sin_2PI3; rewrite cos_2PI3; unfold Rdiv; rewrite Ropp_mult_distr_l_reverse; rewrite Rmult_1_l; rewrite <- Ropp_inv_permute... rewrite Rinv_involutive... @@ -341,21 +341,21 @@ 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 neg_cos; rewrite cos_PI4; unfold Rdiv; rewrite Ropp_mult_distr_l_reverse... - pattern PI at 2 in |- *; rewrite double_var; pattern PI at 2 3 in |- *; + pattern PI at 2; rewrite double_var; pattern PI at 2 3; rewrite double_var; assert (H : 2 <> 0); - [ discrR | unfold Rdiv in |- *; repeat rewrite Rinv_mult_distr; try ring ]... + [ discrR | unfold Rdiv; 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 neg_sin; rewrite sin_PI4; unfold Rdiv; rewrite Ropp_mult_distr_l_reverse... - pattern PI at 2 in |- *; rewrite double_var; pattern PI at 2 3 in |- *; + pattern PI at 2; rewrite double_var; pattern PI at 2 3; rewrite double_var; assert (H : 2 <> 0); - [ discrR | unfold Rdiv in |- *; repeat rewrite Rinv_mult_distr; try ring ]... + [ discrR | unfold Rdiv; repeat rewrite Rinv_mult_distr; try ring ]... Qed. Lemma sin_cos5PI4 : cos (5 * (PI / 4)) = sin (5 * (PI / 4)). @@ -367,7 +367,7 @@ Lemma Rgt_3PI2_0 : 0 < 3 * (PI / 2). Proof. apply Rmult_lt_0_compat; [ prove_sup0 - | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + | unfold Rdiv; apply Rmult_lt_0_compat; [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup0 ] ]. Qed. @@ -382,7 +382,7 @@ Proof. 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. + pattern PI at 2; rewrite double_var; ring. Qed. Lemma Rlt_3PI2_2PI : 3 * (PI / 2) < 2 * PI. @@ -391,7 +391,7 @@ Proof. 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. + rewrite double; pattern PI at 1 2; rewrite double_var; ring. Qed. (***************************************************************) @@ -404,13 +404,13 @@ Definition toDeg (x:R) : R := x * plat * / PI. Lemma rad_deg : forall x:R, toRad (toDeg x) = x. Proof. - intro; unfold toRad, toDeg in |- *; + intro; unfold toRad, toDeg; 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. + unfold plat; discrR. Qed. Lemma toRad_inj : forall x y:R, toRad x = toRad y -> x = y. @@ -420,7 +420,7 @@ Proof. 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 Rinv_neq_0_compat; unfold plat; discrR. apply PI_neq0. Qed. @@ -435,7 +435,7 @@ Definition tand (x:R) : R := tan (toRad x). Lemma Rsqr_sin_cos_d_one : forall x:R, Rsqr (sind x) + Rsqr (cosd x) = 1. Proof. - intro x; unfold sind in |- *; unfold cosd in |- *; apply sin2_cos2. + intro x; unfold sind; unfold cosd; apply sin2_cos2. Qed. (***************************************************) @@ -447,10 +447,10 @@ 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 |- *; + rewrite <- H2; unfold sin_lb; unfold sin_approx; + unfold sum_f_R0; unfold sin_term; repeat rewrite pow_ne_zero. - unfold Rdiv in |- *; repeat rewrite Rmult_0_l; repeat rewrite Rmult_0_r; + unfold Rdiv; repeat rewrite Rmult_0_l; repeat rewrite Rmult_0_r; repeat rewrite Rplus_0_r; right; reflexivity. discriminate. discriminate. diff --git a/theories/Reals/Rtrigo_def.v b/theories/Reals/Rtrigo_def.v index c6493135..f3e69037 100644 --- a/theories/Reals/Rtrigo_def.v +++ b/theories/Reals/Rtrigo_def.v @@ -1,13 +1,13 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) Require Import Rbase Rfunctions SeqSeries Rtrigo_fun Max. -Open Local Scope R_scope. +Local Open Scope R_scope. (********************************) (** * Definition of exponential *) @@ -27,7 +27,7 @@ Proof. intro; generalize (Alembert_C3 (fun n:nat => / INR (fact n)) x exp_cof_no_R0 Alembert_exp). - unfold Pser, exp_in in |- *. + unfold Pser, exp_in. trivial. Defined. @@ -36,24 +36,24 @@ Definition exp (x:R) : R := proj1_sig (exist_exp x). Lemma pow_i : forall i:nat, (0 < i)%nat -> 0 ^ i = 0. Proof. intros; apply pow_ne_zero. - red in |- *; intro; rewrite H0 in H; elim (lt_irrefl _ H). + red; intro; rewrite H0 in H; elim (lt_irrefl _ H). Qed. Lemma exist_exp0 : { l:R | exp_in 0 l }. Proof. exists 1. - unfold exp_in in |- *; unfold infinite_sum in |- *; intros. + unfold exp_in; unfold infinite_sum; 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; + unfold R_dist; replace (1 - 1) with 0; [ rewrite Rabs_R0; assumption | ring ]. induction n as [| n Hrecn]. - simpl in |- *; rewrite Rinv_1; ring. + simpl; rewrite Rinv_1; ring. rewrite tech5. rewrite <- Hrecn. - simpl in |- *. + simpl. ring. - unfold ge in |- *; apply le_O_n. + unfold ge; apply le_O_n. Defined. (* Value of [exp 0] *) @@ -61,7 +61,7 @@ Lemma exp_0 : exp 0 = 1. Proof. cut (exp_in 0 (exp 0)). cut (exp_in 0 1). - unfold exp_in in |- *; intros; eapply uniqueness_sum. + unfold exp_in; intros; eapply uniqueness_sum. apply H0. apply H. exact (proj2_sig exist_exp0). @@ -77,14 +77,14 @@ Definition tanh (x:R) : R := sinh x / cosh x. Lemma cosh_0 : cosh 0 = 1. Proof. - unfold cosh in |- *; rewrite Ropp_0; rewrite exp_0. - unfold Rdiv in |- *; rewrite <- Rinv_r_sym; [ reflexivity | discrR ]. + unfold cosh; rewrite Ropp_0; rewrite exp_0. + unfold Rdiv; rewrite <- Rinv_r_sym; [ reflexivity | discrR ]. Qed. Lemma sinh_0 : sinh 0 = 0. Proof. - unfold sinh in |- *; rewrite Ropp_0; rewrite exp_0. - unfold Rminus, Rdiv in |- *; rewrite Rplus_opp_r; apply Rmult_0_l. + unfold sinh; rewrite Ropp_0; rewrite exp_0. + unfold Rminus, Rdiv; rewrite Rplus_opp_r; apply Rmult_0_l. Qed. Definition cos_n (n:nat) : R := (-1) ^ n / INR (fact (2 * n)). @@ -92,8 +92,8 @@ 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)). 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. + intro; unfold cos_n; replace (S n) with (n + 1)%nat; [ idtac | ring ]. + rewrite pow_add; unfold Rdiv; rewrite Rinv_mult_distr. rewrite Rinv_involutive. replace ((-1) ^ n * (-1) ^ 1 * / INR (fact (2 * (n + 1))) * @@ -101,7 +101,7 @@ Proof. ((-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. + rewrite Rmult_1_l; unfold pow; 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). @@ -130,29 +130,29 @@ Proof. 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)). + 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)). + [ idtac | red; 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_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; + red; 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. + pattern eps at 1; 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). + red; 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. @@ -166,10 +166,10 @@ Qed. Lemma Alembert_cos : Un_cv (fun n:nat => Rabs (cos_n (S n) / cos_n n)) 0. Proof. - unfold Un_cv in |- *; intros. + unfold Un_cv; intros. assert (H0 := archimed_cor1 eps H). elim H0; intros; exists x. - intros; rewrite simpl_cos_n; unfold R_dist in |- *; unfold Rminus in |- *; + intros; rewrite simpl_cos_n; unfold R_dist; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; rewrite Rabs_Ropp; rewrite Rabs_right. rewrite mult_INR; rewrite Rinv_mult_distr. @@ -177,7 +177,7 @@ Proof. 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; + change (0 < / INR (2 * n + 1)); 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. @@ -221,7 +221,7 @@ Proof. Qed. Lemma cosn_no_R0 : forall n:nat, cos_n n <> 0. - intro; unfold cos_n in |- *; unfold Rdiv in |- *; apply prod_neq_R0. + intro; unfold cos_n; unfold Rdiv; apply prod_neq_R0. apply pow_nonzero; discrR. apply Rinv_neq_0_compat. apply INR_fact_neq_0. @@ -234,7 +234,7 @@ Definition cos_in (x l:R) : Prop := (**********) Lemma exist_cos : forall x:R, { l:R | cos_in x l }. intro; generalize (Alembert_C3 cos_n x cosn_no_R0 Alembert_cos). - unfold Pser, cos_in in |- *; trivial. + unfold Pser, cos_in; trivial. Qed. @@ -246,8 +246,8 @@ 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)). 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. + intro; unfold sin_n; replace (S n) with (n + 1)%nat; [ idtac | ring ]. + rewrite pow_add; unfold Rdiv; rewrite Rinv_mult_distr. rewrite Rinv_involutive. replace ((-1) ^ n * (-1) ^ 1 * / INR (fact (2 * (n + 1) + 1)) * @@ -255,7 +255,7 @@ Proof. ((-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; + rewrite Rmult_1_l; unfold pow; 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. @@ -291,9 +291,9 @@ Qed. Lemma Alembert_sin : Un_cv (fun n:nat => Rabs (sin_n (S n) / sin_n n)) 0. Proof. - unfold Un_cv in |- *; intros; assert (H0 := archimed_cor1 eps H). + unfold Un_cv; intros; assert (H0 := archimed_cor1 eps H). elim H0; intros; exists x. - intros; rewrite simpl_sin_n; unfold R_dist in |- *; unfold Rminus in |- *; + intros; rewrite simpl_sin_n; unfold R_dist; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; rewrite Rabs_Ropp; rewrite Rabs_right. rewrite mult_INR; rewrite Rinv_mult_distr. @@ -301,7 +301,7 @@ Proof. 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; + change (0 < / INR (2 * S n + 1)); 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. @@ -329,7 +329,7 @@ Proof. 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 |- *; + left; change (0 < / INR ((2 * S n + 1) * (2 * S n))); apply Rinv_0_lt_compat. apply lt_INR_0. replace ((2 * S n + 1) * (2 * S n))%nat with @@ -342,7 +342,7 @@ Defined. Lemma sin_no_R0 : forall n:nat, sin_n n <> 0. Proof. - intro; unfold sin_n in |- *; unfold Rdiv in |- *; apply prod_neq_R0. + intro; unfold sin_n; unfold Rdiv; apply prod_neq_R0. apply pow_nonzero; discrR. apply Rinv_neq_0_compat; apply INR_fact_neq_0. Qed. @@ -355,7 +355,7 @@ Definition sin_in (x l:R) : Prop := Lemma exist_sin : forall x:R, { l:R | sin_in x l }. Proof. intro; generalize (Alembert_C3 sin_n x sin_no_R0 Alembert_sin). - unfold Pser, sin_n in |- *; trivial. + unfold Pser, sin_n; trivial. Defined. (***********************) @@ -368,40 +368,40 @@ Definition sin (x:R) : R := let (a,_) := exist_sin (Rsqr x) in x * a. Lemma cos_sym : forall x:R, cos x = cos (- x). Proof. - intros; unfold cos in |- *; replace (Rsqr (- x)) with (Rsqr x). + intros; unfold cos; replace (Rsqr (- x)) with (Rsqr x). reflexivity. apply Rsqr_neg. Qed. Lemma sin_antisym : forall x:R, sin (- x) = - sin x. Proof. - intro; unfold sin in |- *; replace (Rsqr (- x)) with (Rsqr x); + intro; unfold sin; replace (Rsqr (- x)) with (Rsqr x); [ idtac | apply Rsqr_neg ]. case (exist_sin (Rsqr x)); intros; ring. Qed. Lemma sin_0 : sin 0 = 0. Proof. - unfold sin in |- *; case (exist_sin (Rsqr 0)). + unfold sin; case (exist_sin (Rsqr 0)). intros; ring. Qed. Lemma exist_cos0 : { l:R | cos_in 0 l }. Proof. exists 1. - unfold cos_in in |- *; unfold infinite_sum in |- *; intros; exists 0%nat. + unfold cos_in; unfold infinite_sum; intros; exists 0%nat. intros. - unfold R_dist in |- *. + unfold R_dist. induction n as [| n Hrecn]. - unfold cos_n in |- *; simpl in |- *. - unfold Rdiv in |- *; rewrite Rinv_1. + unfold cos_n; simpl. + unfold Rdiv; rewrite Rinv_1. do 2 rewrite Rmult_1_r. - unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. + unfold Rminus; 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. + apply Hrecn; unfold ge; apply le_O_n. + simpl; ring. Defined. (* Value of [cos 0] *) @@ -409,10 +409,10 @@ Lemma cos_0 : cos 0 = 1. Proof. cut (cos_in 0 (cos 0)). cut (cos_in 0 1). - unfold cos_in in |- *; intros; eapply uniqueness_sum. + unfold cos_in; intros; eapply uniqueness_sum. apply H0. apply H. exact (proj2_sig exist_cos0). - assert (H := proj2_sig (exist_cos (Rsqr 0))); unfold cos in |- *; - pattern 0 at 1 in |- *; replace 0 with (Rsqr 0); [ exact H | apply Rsqr_0 ]. + assert (H := proj2_sig (exist_cos (Rsqr 0))); unfold cos; + pattern 0 at 1; 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 b7720141..b131b510 100644 --- a/theories/Reals/Rtrigo_fun.v +++ b/theories/Reals/Rtrigo_fun.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -9,7 +9,7 @@ Require Import Rbase. Require Import Rfunctions. Require Import SeqSeries. -Open Local Scope R_scope. +Local Open Scope R_scope. (*****************************************************************) (** To define transcendental functions *) @@ -20,8 +20,8 @@ Open Local Scope R_scope. Lemma Alembert_exp : 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 |- *; + unfold Un_cv; intros; elim (Rgt_dec eps 1); intro. + split with 0%nat; intros; rewrite (simpl_fact n); unfold R_dist; 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))). @@ -39,7 +39,7 @@ Proof. 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 (Rinv_l (INR (S n)) (not_O_INR (S n) (not_eq_sym (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; @@ -47,11 +47,11 @@ Proof. 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. + unfold Rgt; 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 (simpl_fact n); unfold R_dist; 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))). @@ -72,28 +72,28 @@ Proof. 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 (Rinv_l (INR (S n)) (not_O_INR (S n) (not_eq_sym (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)); + 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. + unfold Rgt; 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; + generalize (Rnot_gt_le eps 1 b); clear b; unfold Rle; 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)))) + (not_eq_sym (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. + intro; fold (/ eps - 1 > 0); apply Rgt_minus; + unfold Rgt; assumption. + right; rewrite H0; rewrite Rinv_1; symmetry; 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 100e0818..fff4fec9 100644 --- a/theories/Reals/Rtrigo_reg.v +++ b/theories/Reals/Rtrigo_reg.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -9,169 +9,23 @@ Require Import Rbase. Require Import Rfunctions. Require Import SeqSeries. -Require Import Rtrigo. +Require Import Rtrigo1. Require Import Ranalysis1. Require Import PSeries_reg. -Open Local Scope nat_scope. -Open Local Scope R_scope. +Local Open Scope nat_scope. +Local Open 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. -Proof. - unfold CVN_R in |- *; intros. - cut ((r:R) <> 0). - intro hyp_r; unfold CVN_r in |- *. - exists (fun n:nat => / INR (fact (2 * n)) * r ^ (2 * n)). - cut - { 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. - exists 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. - 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. -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, { 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 infinite_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. Proof. - unfold continuity in |- *; intro. + unfold continuity; 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. + unfold continuity_pt; unfold continue_in; + unfold limit1_in; unfold limit_in; + simpl; unfold R_dist; intros. elim (H0 _ H); intros. exists x0; intros. elim H1; intros. @@ -180,9 +34,9 @@ Proof. intros; rewrite <- (cos_shift x); rewrite <- (cos_shift x1); apply H3. elim H4; intros. split. - unfold D_x, no_cond in |- *; split. + unfold D_x, no_cond; split. trivial. - red in |- *; intro; unfold D_x, no_cond in H5; elim H5; intros _ H8; elim H8; + red; 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. @@ -196,7 +50,7 @@ Lemma CVN_R_sin : (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. + unfold CVN_R; unfold CVN_r; intros fn H r. exists (fun n:nat => / INR (fact (2 * n + 1)) * r ^ (2 * n)). cut { l:R | @@ -209,7 +63,7 @@ Proof. exists x. split. apply p. - intros; rewrite H; unfold Rdiv in |- *; do 2 rewrite Rabs_mult; + intros; rewrite H; unfold Rdiv; 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))). @@ -226,11 +80,11 @@ Proof. 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. + unfold sin_n in H1; unfold Un_cv in H1; unfold Un_cv; 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; assert (H6 := H4 _ H5). unfold R_dist in H5; replace (Rabs @@ -242,15 +96,15 @@ Proof. ((-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)). + pattern (/ Rsqr r) at 1; 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. + unfold Rsqr; 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; + unfold Rdiv; 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. @@ -272,10 +126,10 @@ Proof. replace (r ^ (2 * S n)) with (r ^ (2 * n) * r * r). do 2 rewrite <- Rmult_assoc. rewrite <- Rinv_l_sym. - unfold Rsqr in |- *; ring. + unfold Rsqr; ring. apply pow_nonzero; assumption. replace (2 * S n)%nat with (S (S (2 * n))). - simpl in |- *; ring. + simpl; ring. ring. apply Rle_ge; apply pow_le; left; apply (cond_pos r). apply Rle_ge; apply pow_le; left; apply (cond_pos r). @@ -288,16 +142,16 @@ Proof. 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; + unfold Rdiv; 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; + assert (H0 := cond_pos r); red; intro; rewrite H1 in H0; elim (Rlt_irrefl _ H0). Qed. (** (sin h)/h -> 1 when h -> 0 *) Lemma derivable_pt_lim_sin_0 : derivable_pt_lim sin 0 1. Proof. - unfold derivable_pt_lim in |- *; intros. + unfold derivable_pt_lim; intros. set (fn := fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N + 1)) * x ^ (2 * N)). cut (CVN_R fn). @@ -313,58 +167,58 @@ Proof. 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; + simpl; intros. + rewrite sin_0; rewrite Rplus_0_l; unfold Rminus; 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 |- *. + unfold SFL, sin. case (cv h); intros. case (exist_sin (Rsqr h)); intros. - unfold Rdiv in |- *; rewrite (Rinv_r_simpl_m h x0 H6). + unfold Rdiv; rewrite (Rinv_r_simpl_m h x0 H6). eapply UL_sequence. apply u. unfold sin_in in s; unfold sin_n, infinite_sum in s; - unfold SP, fn, Un_cv in |- *; intros. + unfold SP, fn, Un_cv; intros. elim (s _ H10); intros N0 H11. exists N0; intros. - unfold R_dist in |- *; unfold R_dist in H11. + unfold R_dist; 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 |- *; + apply sum_eq; intros; apply Rmult_eq_compat_l; unfold Rsqr; rewrite pow_sqr; reflexivity. - unfold SFL, sin in |- *. + unfold SFL, sin. 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 |- *; + unfold SP, fn; unfold Un_cv; intros; exists 1%nat; intros. + unfold R_dist; 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. + unfold Rminus; 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; + simpl; rewrite Rmult_1_r; unfold Rdiv; rewrite Rinv_1; + rewrite Rmult_1_r; pattern 1 at 1; rewrite <- Rplus_0_r; apply Rplus_eq_compat_l. - symmetry in |- *; apply sum_eq_R0; intros. + symmetry ; 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. + unfold D_x, no_cond; 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; + apply (not_eq_sym (A:=R)); apply H6. + unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; apply H7. + unfold Boule; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_R0; apply (cond_pos r). - intros; unfold fn in |- *; + intros; unfold fn; 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 ]. @@ -375,13 +229,13 @@ Proof. apply (derivable_pt_pow (2 * n) y). apply (X r). apply (CVN_R_CVS _ X). - apply CVN_R_sin; unfold fn in |- *; reflexivity. + apply CVN_R_sin; unfold fn; reflexivity. Qed. (** ((cos h)-1)/h -> 0 when h -> 0 *) Lemma derivable_pt_lim_cos_0 : derivable_pt_lim cos 0 0. Proof. - unfold derivable_pt_lim in |- *; intros. + unfold derivable_pt_lim; intros. assert (H0 := derivable_pt_lim_sin_0). unfold derivable_pt_lim in H0. cut (0 < eps / 2). @@ -396,8 +250,8 @@ Proof. 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. + unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r. + unfold Rdiv; 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)). @@ -407,12 +261,12 @@ Proof. 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 |- *; + pattern (Rabs (sin (h / 2) / (h / 2) - 1)) at 2; 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). + unfold Rabs; case (Rcase_abs (sin (h / 2))); intro. + pattern 1 at 3; rewrite <- (Ropp_involutive 1). apply Ropp_le_contravar. elim H9; intros; assumption. elim H9; intros; assumption. @@ -421,50 +275,50 @@ Proof. 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. + unfold Rdiv; apply prod_neq_R0. apply H7. apply Rinv_neq_0_compat; discrR. apply Rlt_trans with (del / 2). - unfold Rdiv in |- *; rewrite Rabs_mult. + unfold Rdiv; 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. + unfold delta; simpl; 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 <- (Rplus_0_r (del / 2)); pattern del at 1; rewrite (double_var del); apply Rplus_lt_compat_l; - unfold Rdiv in |- *; apply Rmult_lt_0_compat. + unfold Rdiv; 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. + unfold D_x, no_cond; split. trivial. - apply (sym_not_eq (A:=R)); unfold Rdiv in |- *; apply prod_neq_R0. + apply (not_eq_sym (A:=R)); unfold Rdiv; 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. + unfold Rdiv; 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. + unfold delta; simpl; 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 <- (Rplus_0_r (del_c / 2)); pattern del_c at 2; rewrite (double_var del_c); apply Rplus_lt_compat_l. - unfold Rdiv in |- *; apply Rmult_lt_0_compat. + unfold Rdiv; 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 Rmult_minus_distr_l; rewrite Rmult_1_r; unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; - rewrite (Rmult_comm 2); unfold Rdiv, Rsqr in |- *. + rewrite (Rmult_comm 2); unfold Rdiv, Rsqr. repeat rewrite Rmult_assoc. repeat apply Rmult_eq_compat_l. rewrite Rinv_mult_distr. @@ -473,16 +327,16 @@ Proof. discrR. apply H7. apply Rinv_neq_0_compat; discrR. - pattern h at 2 in |- *; replace h with (2 * (h / 2)). + pattern h at 2; 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. + rewrite cos_0; unfold Rsqr; ring. + unfold Rdiv; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m. discrR. - unfold Rmin in |- *; case (Rle_dec del del_c); intro. + unfold Rmin; 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; + unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. Qed. @@ -492,10 +346,10 @@ 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. + unfold derivable_pt_lim; intros. cut (0 < eps / 2); [ intro - | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + | unfold Rdiv; 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. @@ -510,11 +364,11 @@ Proof. 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; + pattern (Rabs ((cos h - 1) / h)) at 2; 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. + unfold Rabs; case (Rcase_abs (sin x)); intro. rewrite <- (Ropp_involutive 1). apply Ropp_le_contravar; assumption. assumption. @@ -524,14 +378,14 @@ Proof. apply H9. apply Rlt_le_trans with alp. apply H7. - unfold alp in |- *; apply Rmin_r. + unfold alp; 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; + pattern (Rabs (sin h / h - 1)) at 2; 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. + unfold Rabs; case (Rcase_abs (cos x)); intro. rewrite <- (Ropp_involutive 1); apply Ropp_le_contravar; assumption. assumption. cut (Rabs h < alp1). @@ -540,8 +394,8 @@ Proof. apply H9. apply Rlt_le_trans with alp. apply H7. - unfold alp in |- *; apply Rmin_l. - rewrite sin_plus; unfold Rminus, Rdiv in |- *; + unfold alp; apply Rmin_l. + rewrite sin_plus; unfold Rminus, Rdiv; 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. @@ -550,7 +404,7 @@ Proof. 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. + unfold alp; unfold Rmin; case (Rle_dec alp1 alp2); intro. apply (cond_pos alp1). apply (cond_pos alp2). Qed. @@ -565,7 +419,7 @@ Proof. 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. + unfold derivable_pt_lim; intros. elim (H3 eps H4); intros. exists x0. intros; rewrite <- (H (x + h)); rewrite <- (H x); apply H5; assumption. @@ -579,26 +433,26 @@ Qed. Lemma derivable_pt_sin : forall x:R, derivable_pt sin x. Proof. - unfold derivable_pt in |- *; intro. + unfold derivable_pt; intro. exists (cos x). apply derivable_pt_lim_sin. Qed. Lemma derivable_pt_cos : forall x:R, derivable_pt cos x. Proof. - unfold derivable_pt in |- *; intro. + unfold derivable_pt; intro. exists (- sin x). apply derivable_pt_lim_cos. Qed. Lemma derivable_sin : derivable sin. Proof. - unfold derivable in |- *; intro; apply derivable_pt_sin. + unfold derivable; intro; apply derivable_pt_sin. Qed. Lemma derivable_cos : derivable cos. Proof. - unfold derivable in |- *; intro; apply derivable_pt_cos. + unfold derivable; intro; apply derivable_pt_cos. Qed. Lemma derive_pt_sin : diff --git a/theories/Reals/SeqProp.v b/theories/Reals/SeqProp.v index 75c57401..41e853cc 100644 --- a/theories/Reals/SeqProp.v +++ b/theories/Reals/SeqProp.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -10,7 +10,7 @@ Require Import Rbase. Require Import Rfunctions. Require Import Rseries. Require Import Max. -Open Local Scope R_scope. +Local Open Scope R_scope. (*****************************************************************) (** Convergence properties of sequences *) @@ -36,7 +36,7 @@ Lemma decreasing_growing : forall Un:nat -> R, Un_decreasing Un -> Un_growing (opp_seq Un). Proof. intro. - unfold Un_growing, opp_seq, Un_decreasing in |- *. + unfold Un_growing, opp_seq, Un_decreasing. intros. apply Ropp_le_contravar. apply H. @@ -58,8 +58,8 @@ Proof. unfold Un_cv in p. unfold R_dist in p. unfold opp_seq in p. - unfold Un_cv in |- *. - unfold R_dist in |- *. + unfold Un_cv. + unfold R_dist. intros. elim (p eps H1); intros. exists x0; intros. @@ -77,7 +77,7 @@ Proof. apply completeness. assumption. exists (Un 0%nat). - unfold EUn in |- *. + unfold EUn. exists 0%nat; reflexivity. Qed. @@ -114,9 +114,9 @@ Proof. unfold bound in H. elim H; intros. unfold is_upper_bound in H0. - unfold has_ub in |- *. + unfold has_ub. exists x. - unfold is_upper_bound in |- *. + unfold is_upper_bound. intros. apply H0. elim H1; intros. @@ -132,9 +132,9 @@ Proof. unfold bound in H. elim H; intros. unfold is_upper_bound in H0. - unfold has_lb in |- *. + unfold has_lb. exists x. - unfold is_upper_bound in |- *. + unfold is_upper_bound. intros. apply H0. elim H1; intros. @@ -155,9 +155,9 @@ Lemma Wn_decreasing : forall (Un:nat -> R) (pr:has_ub Un), Un_decreasing (sequence_ub Un pr). Proof. intros. - unfold Un_decreasing in |- *. + unfold Un_decreasing. intro. - unfold sequence_ub in |- *. + unfold sequence_ub. assert (H := ub_to_lub (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)). assert (H0 := ub_to_lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)). elim H; intros. @@ -171,7 +171,7 @@ Proof. elim p; intros. apply H2. elim p0; intros. - unfold is_upper_bound in |- *. + unfold is_upper_bound. intros. unfold is_upper_bound in H3. apply H3. @@ -190,7 +190,7 @@ Proof. assert (H7 := H3 (lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)) H4). apply Rle_antisym; assumption. - unfold lub in |- *. + unfold lub. case (ub_to_lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)). trivial. cut @@ -204,7 +204,7 @@ Proof. (H7 := H3 (lub (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)) H4). apply Rle_antisym; assumption. - unfold lub in |- *. + unfold lub. case (ub_to_lub (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)). trivial. Qed. @@ -213,9 +213,9 @@ Lemma Vn_growing : forall (Un:nat -> R) (pr:has_lb Un), Un_growing (sequence_lb Un pr). Proof. intros. - unfold Un_growing in |- *. + unfold Un_growing. intro. - unfold sequence_lb in |- *. + unfold sequence_lb. assert (H := lb_to_glb (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)). assert (H0 := lb_to_glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)). elim H; intros. @@ -230,14 +230,14 @@ Proof. apply Ropp_le_contravar. apply H2. elim p0; intros. - unfold is_upper_bound in |- *. + unfold is_upper_bound. 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 |- *. + unfold opp_seq. replace (n + (1 + x2))%nat with (S n + x2)%nat. assumption. replace (S n) with (1 + n)%nat; [ ring | ring ]. @@ -254,7 +254,7 @@ Proof. (Ropp_involutive (glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr))) . apply Ropp_eq_compat; apply Rle_antisym; assumption. - unfold glb in |- *. + unfold glb. case (lb_to_glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)); simpl. intro; rewrite Ropp_involutive. trivial. @@ -273,7 +273,7 @@ Proof. (glb (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr))) . apply Ropp_eq_compat; apply Rle_antisym; assumption. - unfold glb in |- *. + unfold glb. case (lb_to_glb (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)); simpl. intro; rewrite Ropp_involutive. trivial. @@ -286,7 +286,7 @@ Lemma Vn_Un_Wn_order : Proof. intros. split. - unfold sequence_lb in |- *. + unfold sequence_lb. cut { l:R | is_lub (EUn (opp_seq (fun i:nat => Un (n + i)%nat))) l }. intro X. elim X; intros. @@ -298,7 +298,7 @@ Proof. apply Ropp_le_contravar. apply H. exists 0%nat. - unfold opp_seq in |- *. + unfold opp_seq. replace (n + 0)%nat with n; [ reflexivity | ring ]. cut (is_lub (EUn (opp_seq (fun k:nat => Un (n + k)%nat))) @@ -313,13 +313,13 @@ Proof. (Ropp_involutive (glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2))) . apply Ropp_eq_compat; apply Rle_antisym; assumption. - unfold glb in |- *. + unfold glb. case (lb_to_glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)); simpl. intro; rewrite Ropp_involutive. trivial. apply lb_to_glb. apply min_ss; assumption. - unfold sequence_ub in |- *. + unfold sequence_ub. cut { l:R | is_lub (EUn (fun i:nat => Un (n + i)%nat)) l }. intro X. elim X; intros. @@ -340,7 +340,7 @@ Proof. assert (H5 := H1 (lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)) H2). apply Rle_antisym; assumption. - unfold lub in |- *. + unfold lub. case (ub_to_lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)). intro; trivial. apply ub_to_lub. @@ -353,13 +353,13 @@ Lemma min_maj : Proof. intros. assert (H := Vn_Un_Wn_order Un pr1 pr2). - unfold has_ub in |- *. - unfold bound in |- *. + unfold has_ub. + unfold bound. unfold has_ub in pr1. unfold bound in pr1. elim pr1; intros. exists x. - unfold is_upper_bound in |- *. + unfold is_upper_bound. intros. unfold is_upper_bound in H0. elim H1; intros. @@ -376,20 +376,20 @@ Lemma maj_min : Proof. intros. assert (H := Vn_Un_Wn_order Un pr1 pr2). - unfold has_lb in |- *. - unfold bound in |- *. + unfold has_lb. + unfold bound. unfold has_lb in pr2. unfold bound in pr2. elim pr2; intros. exists x. - unfold is_upper_bound in |- *. + unfold is_upper_bound. 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. + unfold opp_seq; apply Ropp_le_contravar. assumption. apply H0. exists x1; reflexivity. @@ -399,7 +399,7 @@ Qed. Lemma cauchy_maj : forall Un:nat -> R, Cauchy_crit Un -> has_ub Un. Proof. intros. - unfold has_ub in |- *. + unfold has_ub. apply cauchy_bound. assumption. Qed. @@ -409,12 +409,12 @@ Lemma cauchy_opp : forall Un:nat -> R, Cauchy_crit Un -> Cauchy_crit (opp_seq Un). Proof. intro. - unfold Cauchy_crit in |- *. - unfold R_dist in |- *. + unfold Cauchy_crit. + unfold R_dist. intros. elim (H eps H0); intros. exists x; intros. - unfold opp_seq in |- *. + unfold opp_seq. rewrite <- Rabs_Ropp. replace (- (- Un n - - Un m)) with (Un n - Un m); [ apply H1; assumption | ring ]. @@ -424,7 +424,7 @@ Qed. Lemma cauchy_min : forall Un:nat -> R, Cauchy_crit Un -> has_lb Un. Proof. intros. - unfold has_lb in |- *. + unfold has_lb. assert (H0 := cauchy_opp _ H). apply cauchy_bound. assumption. @@ -485,7 +485,7 @@ Qed. Lemma not_Rlt : forall r1 r2:R, ~ r1 < r2 -> r1 >= r2. Proof. - intros r1 r2; generalize (Rtotal_order r1 r2); unfold Rge in |- *. + intros r1 r2; generalize (Rtotal_order r1 r2); unfold Rge. tauto. Qed. @@ -595,11 +595,11 @@ Qed. Lemma UL_sequence : 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. + intros Un l1 l2; unfold Un_cv; unfold R_dist; intros. apply cond_eq. intros; cut (0 < eps / 2); [ intro - | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + | unfold Rdiv; 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. @@ -609,8 +609,8 @@ Proof. [ 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. + unfold ge, N; apply le_max_l. + apply H4; unfold ge, N; apply le_max_r. Qed. (**********) @@ -618,10 +618,10 @@ 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). Proof. - unfold Un_cv in |- *; unfold R_dist in |- *; intros. + unfold Un_cv; unfold R_dist; intros. cut (0 < eps / 2); [ intro - | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + | unfold Rdiv; 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. @@ -632,10 +632,10 @@ Proof. 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 ]. + apply H3; unfold ge; apply le_trans with N; + [ unfold N; apply le_max_l | assumption ]. + apply H4; unfold ge; apply le_trans with N; + [ unfold N; apply le_max_r | assumption ]. Qed. (**********) @@ -643,7 +643,7 @@ Lemma cv_cvabs : 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. + unfold Un_cv; unfold R_dist; intros. elim (H eps H0); intros. exists x; intros. apply Rle_lt_trans with (Rabs (Un n - l)). @@ -656,15 +656,15 @@ Lemma CV_Cauchy : forall Un:nat -> R, { l:R | Un_cv Un l } -> Cauchy_crit Un. Proof. intros Un X; elim X; intros. - unfold Cauchy_crit in |- *; intros. + unfold Cauchy_crit; intros. unfold Un_cv in p; unfold R_dist in p. cut (0 < eps / 2); [ intro - | unfold Rdiv in |- *; apply Rmult_lt_0_compat; + | unfold Rdiv; 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 |- *; + unfold R_dist; 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 ]. @@ -695,7 +695,7 @@ Proof. 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; + pattern x0 at 1; 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. @@ -717,7 +717,7 @@ Proof. assert (H1 := maj_by_pos An X). elim H1; intros M H2. elim H2; intros. - unfold Un_cv in |- *; unfold R_dist in |- *; intros. + unfold Un_cv; unfold R_dist; intros. cut (0 < eps / (2 * M)). intro. case (Req_dec l2 0); intro. @@ -744,24 +744,24 @@ Proof. 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. + unfold Rdiv; 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. + pattern (eps * / M) at 1; 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 |- *; + red; intro; rewrite H10 in H3; elim (Rlt_irrefl _ H3). + red; intro; rewrite H10 in H3; elim (Rlt_irrefl _ H3). + rewrite H7; do 2 rewrite Rmult_0_r; unfold Rminus; 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. + symmetry ; 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; @@ -790,36 +790,36 @@ Proof. 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. + unfold ge; apply le_trans with N. + unfold N; apply le_max_r. assumption. - unfold Rdiv in |- *; rewrite Rinv_mult_distr. + unfold Rdiv; 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). + red; intro; rewrite H12 in H3; elim (Rlt_irrefl _ H3). + red; 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. + unfold ge; apply le_trans with N. + unfold N; apply le_max_l. assumption. - unfold Rdiv in |- *; right; rewrite Rinv_mult_distr. + unfold Rdiv; 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 ]. + [ symmetry ; 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. + [ symmetry ; apply Rabs_mult | ring ]. + unfold Rdiv; 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; + unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; [ prove_sup0 | assumption ] ]. @@ -858,15 +858,15 @@ 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. + pattern k at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l. + unfold Rdiv; 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; + unfold Rdiv; rewrite Rmult_1_r; rewrite Rmult_plus_distr_l; + pattern 2 at 1; 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. @@ -885,7 +885,7 @@ Proof. 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. + unfold Rdiv; 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. @@ -910,12 +910,12 @@ Proof. 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)); + unfold ge, N; apply le_max_r. + unfold Rminus; do 2 rewrite <- (Rplus_comm (- l)); apply Rplus_le_compat_l. apply tech9. assumption. - unfold N in |- *; apply le_max_l. + unfold N; 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 ]. @@ -926,10 +926,10 @@ Lemma CV_opp : 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. + unfold Un_cv; unfold R_dist; intros. elim (H eps H0); intros. exists x; intros. - unfold opp_seq in |- *; replace (- An n - - l) with (- (An n - l)); + unfold opp_seq; replace (- An n - - l) with (- (An n - l)); [ rewrite Rabs_Ropp | ring ]. apply H1; assumption. Qed. @@ -954,10 +954,10 @@ Lemma CV_minus : 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. + unfold Rminus; apply CV_plus. assumption. apply CV_opp; assumption. - unfold Rminus, opp_seq in |- *; reflexivity. + unfold Rminus, opp_seq; reflexivity. Qed. (** Un -> +oo *) @@ -969,10 +969,10 @@ 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. Proof. - unfold cv_infty, Un_cv in |- *; unfold R_dist in |- *; intros. + unfold cv_infty, Un_cv; unfold R_dist; intros. elim (H0 (/ eps)); intros N0 H2. exists N0; intros. - unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; + unfold Rminus; 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. @@ -984,7 +984,7 @@ Proof. 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). + red; intro; rewrite H4 in H1; elim (Rlt_irrefl _ H1). apply Rabs_no_R0; apply H. Qed. @@ -993,7 +993,7 @@ Lemma decreasing_prop : forall (Un:nat -> R) (m n:nat), Un_decreasing Un -> (m <= n)%nat -> Un n <= Un m. Proof. - unfold Un_decreasing in |- *; intros. + unfold Un_decreasing; intros. induction n as [| n Hrecn]. induction m as [| m Hrecm]. right; reflexivity. @@ -1016,17 +1016,17 @@ Proof. (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); + unfold Un_cv; unfold R_dist; intros; case (Req_dec x 0); intro. exists 1%nat; intros. - rewrite H1; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; + rewrite H1; unfold Rminus; 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) ]. + [ unfold Rdiv; rewrite Rmult_0_l; rewrite Rabs_R0; assumption + | red; 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. + cut (Un_cv Un 0); unfold Un_cv; unfold R_dist; 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). @@ -1034,7 +1034,7 @@ Proof. 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; + unfold ge; 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. @@ -1048,43 +1048,43 @@ Proof. 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. + unfold Un_cv; unfold R_dist; 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; + unfold Rminus; 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; + inversion H12; simpl; reflexivity. + apply Rle_ge; unfold Rminus; 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 Rle_ge; unfold Rminus; 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 ]. + apply H11; unfold ge; apply le_S_n; replace (S (pred n)) with n; + [ unfold ge in H12; exact H12 | inversion H12; simpl; 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 |- *. + unfold Un_cv, R_dist; intros; unfold Vn. 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 ]. + [ idtac | unfold Rdiv; 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; + assert (H16 := H7 0%nat); red; 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)). + unfold Rdiv; rewrite (Rabs_right (Rabs x * Un 0%nat)). apply Rmult_comm. apply Rle_ge; apply Rmult_le_pos. apply Rabs_pos. @@ -1092,9 +1092,9 @@ Proof. 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; + | assert (H16 := H7 0%nat); red; intro; rewrite H17 in H16; elim (Rlt_irrefl _ H16) ]. - unfold Rdiv in |- *; apply Rmult_lt_0_compat. + unfold Rdiv; apply Rmult_lt_0_compat. assumption. apply Rinv_0_lt_compat; apply Rmult_lt_0_compat. apply Rabs_pos_lt; assumption. @@ -1102,7 +1102,7 @@ Proof. 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. + unfold cv_infty; 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 ]. @@ -1116,13 +1116,13 @@ Proof. 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 le_IZR; left; simpl; unfold M0_z; 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. + unfold Un; 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)); + [ idtac | simpl; ring ]. + unfold Rdiv; rewrite <- (Rmult_comm (Rabs x)); repeat rewrite Rmult_assoc; repeat apply Rmult_le_compat_l. apply Rabs_pos. left; apply pow_lt; assumption. @@ -1130,33 +1130,33 @@ Proof. 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_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red; + intro; assert (H10 := eq_sym 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 ]. + pattern n at 1; 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. ring. - unfold Vn in |- *; rewrite Rmult_assoc; unfold Rdiv in |- *; + unfold Vn; rewrite Rmult_assoc; unfold Rdiv; 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 |- *. + unfold Un_decreasing; intro; unfold Un. replace (M_nat + S n)%nat with (M_nat + n + 1)%nat. - rewrite pow_add; unfold Rdiv in |- *; rewrite Rmult_assoc; + rewrite pow_add; unfold Rdiv; 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 (Rabs x ^ 1) with (Rabs x); [ idtac | simpl; 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); + apply lt_INR_0; apply neq_O_lt; red; intro; assert (H9 := eq_sym H8); elim (fact_neq_0 _ H9). rewrite (Rmult_comm (Rabs x)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym. rewrite Rmult_1_l. @@ -1170,37 +1170,37 @@ Proof. apply INR_fact_neq_0. ring. ring. - intro; unfold Un in |- *; unfold Rdiv in |- *; apply Rmult_lt_0_compat. + intro; unfold Un; unfold Rdiv; 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 |- *. + apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red; intro; + assert (H8 := eq_sym H7); elim (fact_neq_0 _ H8). + clear Un Vn; apply INR_le; simpl. 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). + apply le_IZR; simpl; 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. + unfold Un_cv; unfold R_dist; 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; + unfold Rminus; 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))). + unfold Rdiv; 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. + red; intro; assert (H4 := eq_sym H3); elim (fact_neq_0 _ H4). + apply Rle_ge; unfold Rdiv; 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 ]. + [ simpl; left; apply Rlt_0_1 + | simpl; 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). + left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red; + intro; assert (H4 := eq_sym H3); elim (fact_neq_0 _ H4). apply H1; assumption. Qed. diff --git a/theories/Reals/SeqSeries.v b/theories/Reals/SeqSeries.v index 0d876be5..5140c29c 100644 --- a/theories/Reals/SeqSeries.v +++ b/theories/Reals/SeqSeries.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -19,7 +19,7 @@ Require Export Rsigma. Require Export Rprod. Require Export Cauchy_prod. Require Export Alembert. -Open Local Scope R_scope. +Local Open Scope R_scope. (**********) Lemma sum_maj1 : @@ -41,21 +41,21 @@ Proof. 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. + unfold SP; apply H2. apply H3. intros; apply H1. - symmetry in |- *; eapply UL_sequence. + symmetry ; eapply UL_sequence. apply H3. - unfold Un_cv in H0; unfold Un_cv in |- *; intros; elim (H0 eps H5); + unfold Un_cv in H0; unfold Un_cv; intros; elim (H0 eps H5); intros N0 H6. unfold R_dist in H6; exists N0; intros. - unfold R_dist in |- *; + unfold R_dist; 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 H6; unfold ge; apply le_trans with n. apply H7. apply le_trans with (N + n)%nat. apply le_plus_r. @@ -80,12 +80,12 @@ Proof. reflexivity. apply le_lt_n_Sm; apply le_plus_l. apply le_O_n. - symmetry in |- *; eapply UL_sequence. + symmetry ; eapply UL_sequence. apply H2. - unfold Un_cv in H; unfold Un_cv in |- *; intros. + unfold Un_cv in H; unfold Un_cv; intros. elim (H eps H4); intros N0 H5. unfold R_dist in H5; exists N0; intros. - unfold R_dist, SP in |- *; + unfold R_dist, SP; 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 @@ -96,7 +96,7 @@ Proof. (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. + unfold SP in H5; apply H5; unfold ge; apply le_trans with n. apply H6. apply le_trans with (N + n)%nat. apply le_plus_r. @@ -124,16 +124,16 @@ Proof. apply le_plus_l. apply le_O_n. exists (l2 - sum_f_R0 An N). - unfold Un_cv in H0; unfold Un_cv in |- *; intros. + unfold Un_cv in H0; unfold Un_cv; intros. elim (H0 eps H2); intros N0 H3. unfold R_dist in H3; exists N0; intros. - unfold R_dist in |- *; + unfold R_dist; 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 H3; unfold ge; apply le_trans with n. apply H4. apply le_trans with (N + n)%nat. apply le_plus_r. @@ -160,10 +160,10 @@ Proof. apply le_plus_l. apply le_O_n. exists (l1 - SP fn N x). - unfold Un_cv in H; unfold Un_cv in |- *; intros. + unfold Un_cv in H; unfold Un_cv; intros. elim (H eps H2); intros N0 H3. unfold R_dist in H3; exists N0; intros. - unfold R_dist, SP in |- *. + unfold R_dist, SP. 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 @@ -175,7 +175,7 @@ Proof. 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. + unfold ge; apply le_trans with n. apply H4. apply le_trans with (N + n)%nat. apply le_plus_r. @@ -213,7 +213,7 @@ Lemma Rseries_CV_comp : 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 |- *. + unfold Cauchy_crit_series; unfold Cauchy_crit. intros; elim (H0 eps H1); intros. exists x; intros. cut @@ -227,7 +227,7 @@ Proof. 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; + unfold R_dist; unfold Rminus; 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. @@ -238,12 +238,12 @@ Proof. 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 |- *; + rewrite b; unfold R_dist; unfold Rminus; 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; + unfold R_dist; unfold Rminus; 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. @@ -266,13 +266,13 @@ Lemma Cesaro : 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)... + unfold Un_cv; 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; + intro; red; 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... + unfold Rdiv; 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)); @@ -282,10 +282,10 @@ Proof with trivial. (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... + rewrite H7; unfold Rdiv; 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... + unfold Rdiv; apply Rmult_lt_0_compat... apply Rinv_0_lt_compat; apply Rmult_lt_0_compat... prove_sup... apply Rabs_pos_lt... @@ -294,23 +294,23 @@ Proof with trivial. 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)... + unfold Rdiv; 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... + unfold Rdiv; 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 |- *; + unfold R_dist; 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 |- *; + apply le_lt_n_Sm; unfold N; apply le_max_l... + rewrite (tech2 (fun k:nat => An k * (Bn k - l)) _ _ H9); unfold Rdiv; 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) + @@ -319,12 +319,12 @@ Proof with trivial. (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... + unfold Rdiv; rewrite Rabs_mult; fold C; 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 le_trans with N; [ unfold N; 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; + unfold R_dist in H; unfold Rdiv; 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))) @@ -340,22 +340,22 @@ Proof with trivial. 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 |- *; + pattern (An (S N1 + n0)%nat) at 2; 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); + left; apply H; unfold ge; 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... + unfold Rdiv; repeat rewrite Rmult_assoc; apply Rmult_lt_compat_l... + pattern (/ 2) at 2; 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 |- *; + pattern (sum_f_R0 (fun i:nat => An (S N1 + i)%nat) (n - S N1)) at 1; 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 @@ -371,41 +371,41 @@ Lemma Cesaro_1 : 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... + intro; unfold An; 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... + unfold cv_infty; 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; + apply le_IZR; unfold m; simpl; left; apply Rlt_trans with M... + elim (IZN _ H5); intros; exists x; intros; unfold An; 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... + rewrite INR_IZR_INZ; fold m; 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; + unfold Un_cv; unfold Un_cv in H3; intros; elim (H3 _ H4); intros; + exists (S x); intros; unfold R_dist; 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)); + unfold Rminus; do 2 rewrite <- (Rplus_comm (- l)); apply Rplus_eq_compat_l... - unfold An in |- *; + unfold An; 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 H5; unfold ge; 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 819606c4..d0de58b0 100644 --- a/theories/Reals/SplitAbsolu.v +++ b/theories/Reals/SplitAbsolu.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -19,5 +19,5 @@ Ltac split_Rabs := match goal with | id:context [(Rabs _)] |- _ => generalize id; clear id; try split_Rabs | |- context [(Rabs ?X1)] => - unfold Rabs in |- *; try split_case_Rabs; intros + unfold Rabs; try split_case_Rabs; intros end. diff --git a/theories/Reals/SplitRmult.v b/theories/Reals/SplitRmult.v index e554913c..09031fd6 100644 --- a/theories/Reals/SplitRmult.v +++ b/theories/Reals/SplitRmult.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Sqrt_reg.v b/theories/Reals/Sqrt_reg.v index d00ed178..89c17821 100644 --- a/theories/Reals/Sqrt_reg.v +++ b/theories/Reals/Sqrt_reg.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -10,7 +10,7 @@ Require Import Rbase. Require Import Rfunctions. Require Import Ranalysis1. Require Import R_sqrt. -Open Local Scope R_scope. +Local Open Scope R_scope. (**********) Lemma sqrt_var_maj : @@ -21,67 +21,67 @@ Proof. case (total_order_T h 0); intro. elim s; intro. repeat rewrite Rabs_left. - unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (-1)). + unfold Rminus; 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 |- *; + pattern (1 + h) at 2; rewrite <- Rmult_1_r; unfold Rsqr; apply Rmult_le_compat_l. apply H0. - pattern 1 at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; + pattern 1 at 2; 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; + unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r. - pattern 1 at 2 in |- *; rewrite <- sqrt_1; apply sqrt_lt_1. + pattern 1 at 2; 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; + pattern 1 at 2; rewrite <- Rsqr_1; apply Rsqr_incrst_1. + pattern 1 at 2; 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; + unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r. - pattern 1 at 2 in |- *; rewrite <- sqrt_1; apply sqrt_lt_1. + pattern 1 at 2; 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; + pattern 1 at 2; 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)); + unfold Rminus; 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 |- *; + pattern (1 + h) at 1; rewrite <- Rmult_1_r; unfold Rsqr; apply Rmult_le_compat_l. apply H0. - pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; + pattern 1 at 1; 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_0_r; rewrite Rplus_comm; unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r. - pattern 1 at 1 in |- *; rewrite <- sqrt_1; apply sqrt_le_1. + pattern 1 at 1; 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; + pattern 1 at 1; rewrite <- Rsqr_1; apply Rsqr_incr_1. + pattern 1 at 1; 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_0_r; rewrite Rplus_comm; unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r. - pattern 1 at 1 in |- *; rewrite <- sqrt_1; apply sqrt_lt_1. + pattern 1 at 1; 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; + pattern 1 at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; assumption. rewrite sqrt_Rsqr. replace (1 + h - 1) with h; [ right; reflexivity | ring ]. @@ -101,14 +101,14 @@ Qed. (** sqrt is continuous in 1 *) Lemma sqrt_continuity_pt_R1 : continuity_pt sqrt 1. 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 |- *; + unfold continuity_pt; unfold continue_in; + unfold limit1_in; unfold limit_in; + unfold dist; simpl; unfold R_dist; intros. set (alpha := Rmin eps 1). exists alpha; intros. split. - unfold alpha in |- *; unfold Rmin in |- *; case (Rle_dec eps 1); intro. + unfold alpha; unfold Rmin; case (Rle_dec eps 1); intro. assumption. apply Rlt_0_1. intros; elim H0; intros. @@ -117,18 +117,18 @@ Proof. apply sqrt_var_maj. apply Rle_trans with alpha. left; apply H2. - unfold alpha in |- *; apply Rmin_r. + unfold alpha; apply Rmin_r. apply Rlt_le_trans with alpha; - [ apply H2 | unfold alpha in |- *; apply Rmin_l ]. + [ apply H2 | unfold alpha; apply Rmin_l ]. Qed. (** sqrt is continuous forall x>0 *) Lemma sqrt_continuity_pt : forall x:R, 0 < x -> continuity_pt sqrt x. 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 |- *; + unfold continuity_pt; unfold continue_in; + unfold limit1_in; unfold limit_in; + unfold dist; simpl; unfold R_dist; intros. cut (0 < eps / sqrt x). intro; elim (H0 _ H2); intros alp_1 H3. @@ -136,9 +136,9 @@ Proof. set (alpha := alp_1 * x). exists (Rmin alpha x); intros. split. - change (0 < Rmin alpha x) in |- *; unfold Rmin in |- *; + change (0 < Rmin alpha x); unfold Rmin; case (Rle_dec alpha x); intro. - unfold alpha in |- *; apply Rmult_lt_0_compat; assumption. + unfold alpha; 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 @@ -150,7 +150,7 @@ Proof. 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 H7; unfold Rminus, Rdiv; rewrite Rplus_opp_r; rewrite Rmult_0_l; rewrite Rplus_0_r; rewrite Rplus_opp_r; rewrite Rabs_R0. apply Rmult_lt_0_compat. @@ -158,10 +158,10 @@ Proof. apply Rinv_0_lt_compat; rewrite <- H7; apply sqrt_lt_R0; assumption. apply H5. split. - unfold D_x, no_cond in |- *. + unfold D_x, no_cond. split. trivial. - red in |- *; intro. + red; intro. cut ((x0 - x) * / x = 0). intro. elim (Rmult_integral _ _ H9); intro. @@ -170,35 +170,35 @@ Proof. 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; + red; intro; rewrite H12 in H; elim (Rlt_irrefl _ H). + symmetry ; 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; + unfold Rminus; rewrite Rplus_comm; rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; elim H6; intros. - unfold Rdiv in |- *; rewrite Rabs_mult. + unfold Rdiv; 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 |- *. + rewrite Rmult_1_l; rewrite Rmult_comm; fold alpha. apply Rlt_le_trans with (Rmin alpha x). apply H9. apply Rmin_l. - red in |- *; intro; rewrite H10 in H; elim (Rlt_irrefl _ H). + red; 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). + red; 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). + red; 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; + unfold Rminus; 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; + unfold Rdiv; 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). + red; intro; rewrite H7 in H; elim (Rlt_irrefl _ H). left; apply H. left; apply Rlt_0_1. left; apply H. @@ -208,7 +208,7 @@ Proof. 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. + rewrite Rplus_0_l; unfold Rdiv; 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; @@ -216,13 +216,13 @@ Proof. 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). + red; 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. + unfold Rdiv; 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. + unfold Rdiv; apply Rmult_lt_0_compat. apply H1. apply Rinv_0_lt_compat; apply sqrt_lt_R0; apply H. Qed. @@ -235,7 +235,7 @@ Proof. 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 derivable_pt_lim; 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. @@ -247,29 +247,29 @@ Proof. 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 |- *. + unfold D_x, no_cond. split. trivial. - apply (sym_not_eq (A:=R)); exact H8. - unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; + apply (not_eq_sym (A:=R)); exact H8. + unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; apply Rlt_le_trans with alpha1. exact H9. - unfold alpha1 in |- *; apply Rmin_l. + unfold alpha1; 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 Rplus_comm; unfold Rdiv; rewrite <- Rmult_assoc; rewrite Rsqr_plus_minus; repeat rewrite Rsqr_sqrt. - rewrite Rplus_comm; unfold Rminus in |- *; rewrite Rplus_assoc; + rewrite Rplus_comm; unfold Rminus; 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). + red; intro; rewrite H12 in H11; elim (Rlt_irrefl _ H11). + red; 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. @@ -279,35 +279,35 @@ Proof. 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. + unfold alpha1; 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. + unfold alpha1; unfold Rmin; case (Rle_dec alpha x); intro. apply H5. apply H. - unfold g in |- *; rewrite Rplus_0_r. + unfold g; rewrite Rplus_0_r. cut (0 < sqrt x + sqrt x). - intro; red in |- *; intro; rewrite H2 in H1; elim (Rlt_irrefl _ H1). + intro; red; 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; + apply continuity_pt_const; unfold constant, fct_cte; intro; reflexivity. apply continuity_pt_comp. apply continuity_pt_plus. - apply continuity_pt_const; unfold constant, fct_cte in |- *; intro; + apply continuity_pt_const; unfold constant, fct_cte; 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. + unfold plus_fct, fct_cte, id; rewrite Rplus_0_r; apply H. Qed. (**********) Lemma derivable_pt_sqrt : forall x:R, 0 < x -> derivable_pt sqrt x. Proof. - unfold derivable_pt in |- *; intros. + unfold derivable_pt; intros. exists (/ (2 * sqrt x)). apply derivable_pt_lim_sqrt; assumption. Qed. @@ -330,19 +330,19 @@ 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. + unfold continuity_pt; unfold continue_in; + unfold limit1_in; unfold limit_in; + simpl; unfold R_dist; 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). + change (0 < Rsqr eps); apply Rsqr_pos_lt. + red; 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 <- H1; rewrite sqrt_0; unfold Rminus; 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. + unfold sqrt; 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. diff --git a/theories/Reals/vo.itarget b/theories/Reals/vo.itarget index bcd47a0b..36dd0f56 100644 --- a/theories/Reals/vo.itarget +++ b/theories/Reals/vo.itarget @@ -9,6 +9,7 @@ DiscrR.vo Exp_prop.vo Integration.vo LegacyRfield.vo +Machin.vo MVT.vo NewtonInt.vo PartSum.vo @@ -17,7 +18,10 @@ Ranalysis1.vo Ranalysis2.vo Ranalysis3.vo Ranalysis4.vo +Ranalysis5.vo Ranalysis.vo +Ranalysis_reg.vo +Ratan.vo Raxioms.vo Rbase.vo Rbasic_fun.vo @@ -48,6 +52,7 @@ Rtrigo_calc.vo Rtrigo_def.vo Rtrigo_fun.vo Rtrigo_reg.vo +Rtrigo1.vo Rtrigo.vo SeqProp.vo SeqSeries.vo diff --git a/theories/Relations/Operators_Properties.v b/theories/Relations/Operators_Properties.v index f7f5512e..779c3d9a 100644 --- a/theories/Relations/Operators_Properties.v +++ b/theories/Relations/Operators_Properties.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -50,7 +50,7 @@ Section Properties. Lemma clos_rt_idempotent : inclusion (R*)* R*. Proof. - red in |- *. + red. induction 1; auto with sets. intros. apply rt_trans with y; auto with sets. @@ -66,7 +66,7 @@ Section Properties. Lemma clos_rt_clos_rst : inclusion (clos_refl_trans R) (clos_refl_sym_trans R). Proof. - red in |- *. + red. induction 1; auto with sets. apply rst_trans with y; auto with sets. Qed. @@ -87,7 +87,7 @@ Section Properties. inclusion (clos_refl_sym_trans (clos_refl_sym_trans R)) (clos_refl_sym_trans R). Proof. - red in |- *. + red. induction 1; auto with sets. apply rst_trans with y; auto with sets. Qed. diff --git a/theories/Relations/Relation_Definitions.v b/theories/Relations/Relation_Definitions.v index a84c1310..0e6d034e 100644 --- a/theories/Relations/Relation_Definitions.v +++ b/theories/Relations/Relation_Definitions.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Relations/Relation_Operators.v b/theories/Relations/Relation_Operators.v index abf23997..b7159578 100644 --- a/theories/Relations/Relation_Operators.v +++ b/theories/Relations/Relation_Operators.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -149,13 +149,13 @@ Section Lexicographic_Product. Variable leA : A -> A -> Prop. Variable leB : forall x:A, B x -> B x -> Prop. - Inductive lexprod : sigS B -> sigS B -> Prop := + Inductive lexprod : sigT B -> sigT 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') + leA x x' -> lexprod (existT B x y) (existT B x' y') | right_lex : forall (x:A) (y y':B x), - leB x y y' -> lexprod (existS B x y) (existS B x y'). + leB x y y' -> lexprod (existT B x y) (existT B x y'). End Lexicographic_Product. diff --git a/theories/Relations/Relations.v b/theories/Relations/Relations.v index f9fb2c44..08b7574f 100644 --- a/theories/Relations/Relations.v +++ b/theories/Relations/Relations.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -14,16 +14,16 @@ Lemma inverse_image_of_equivalence : forall (A B:Type) (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; split; elim H; red; 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:Type) (f:A -> B), equivalence A (fun x y:A => f x = f y). Proof. - split; red in |- *; + split; red; [ (* reflexivity *) reflexivity | (* transitivity *) intros; transitivity (f y); assumption - | (* symmetry *) intros; symmetry in |- *; assumption ]. + | (* symmetry *) intros; symmetry ; assumption ]. Qed. diff --git a/theories/Setoids/Setoid.v b/theories/Setoids/Setoid.v index f5677005..eec7aa2d 100644 --- a/theories/Setoids/Setoid.v +++ b/theories/Setoids/Setoid.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Classical_sets.v b/theories/Sets/Classical_sets.v index f93631c7..3129dbb1 100644 --- a/theories/Sets/Classical_sets.v +++ b/theories/Sets/Classical_sets.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -38,8 +38,8 @@ Section Ensembles_classical. 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 |- *. + red; intro. + apply NI; red. intros x H'; elim (H x); trivial with sets. Qed. @@ -47,7 +47,7 @@ Section Ensembles_classical. forall A:Ensemble U, A <> Empty_set U -> Inhabited U A. Proof. intros; apply not_included_empty_Inhabited. - red in |- *; auto with sets. + red; auto with sets. Qed. Lemma Inhabited_Setminus : @@ -73,7 +73,7 @@ Section Ensembles_classical. 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. + unfold Subtract at 1; auto with sets. Qed. Hint Resolve Subtract_intro : sets. @@ -103,7 +103,7 @@ Section Ensembles_classical. 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'. + intro X; red; 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. @@ -113,10 +113,10 @@ Section Ensembles_classical. Lemma Complement_Complement : forall A:Ensemble U, Complement U (Complement U A) = A. Proof. - unfold Complement in |- *; intros; apply Extensionality_Ensembles; + unfold Complement; intros; apply Extensionality_Ensembles; auto with sets. - red in |- *; split; auto with sets. - red in |- *; intros; apply NNPP; auto with sets. + red; split; auto with sets. + red; intros; apply NNPP; auto with sets. Qed. End Ensembles_classical. diff --git a/theories/Sets/Constructive_sets.v b/theories/Sets/Constructive_sets.v index e6dd8381..f559533a 100644 --- a/theories/Sets/Constructive_sets.v +++ b/theories/Sets/Constructive_sets.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -36,24 +36,24 @@ Section Ensembles_facts. Lemma Noone_in_empty : forall x:U, ~ In U (Empty_set U) x. Proof. - red in |- *; destruct 1. + red; destruct 1. Qed. Lemma Included_Empty : forall A:Ensemble U, Included U (Empty_set U) A. Proof. - intro; red in |- *. + intro; red. 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. + unfold Add at 1; 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. + unfold Add at 1; auto with sets. Qed. Lemma Inhabited_add : forall (A:Ensemble U) (x:U), Inhabited U (Add U A x). @@ -66,7 +66,7 @@ Section Ensembles_facts. 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. + intros x H'0; red; intro H'1. absurd (In U X x); auto with sets. rewrite H'1; auto using Noone_in_empty with sets. Qed. @@ -78,7 +78,7 @@ Section Ensembles_facts. 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. + intros; red; 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. @@ -121,7 +121,7 @@ Section Ensembles_facts. 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. + unfold Setminus at 1; red; auto with sets. Qed. Lemma Strict_Included_intro : @@ -132,7 +132,7 @@ Section Ensembles_facts. Lemma Strict_Included_strict : forall X:Ensemble U, ~ Strict_Included U X X. Proof. - intro X; red in |- *; intro H'; elim H'. + intro X; red; intro H'; elim H'. intros H'0 H'1; elim H'1; auto with sets. Qed. diff --git a/theories/Sets/Cpo.v b/theories/Sets/Cpo.v index d612e71e..058eec3d 100644 --- a/theories/Sets/Cpo.v +++ b/theories/Sets/Cpo.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Ensembles.v b/theories/Sets/Ensembles.v index 58b979dd..181069d5 100644 --- a/theories/Sets/Ensembles.v +++ b/theories/Sets/Ensembles.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Finite_sets.v b/theories/Sets/Finite_sets.v index f0843675..fc940e48 100644 --- a/theories/Sets/Finite_sets.v +++ b/theories/Sets/Finite_sets.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -61,7 +61,7 @@ Section Ensembles_finis_facts. (exists x : _, X = Add U A x /\ ~ In U A x /\ cardinal U A n) end. Proof. - induction 1; simpl in |- *; auto. + induction 1; simpl; auto. exists A; exists x; auto. Qed. @@ -73,7 +73,7 @@ Section Ensembles_finis_facts. | S n => Inhabited U X end. Proof. - intros X p C; elim C; simpl in |- *; trivial with sets. + intros X p C; elim C; simpl; 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 350cd783..c0613637 100644 --- a/theories/Sets/Finite_sets_facts.v +++ b/theories/Sets/Finite_sets_facts.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -62,7 +62,7 @@ Section Finite_sets_facts. 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. + change (Finite U (Add U (Empty_set U) x)); auto with sets. Qed. Theorem Union_preserves_Finite : @@ -134,15 +134,15 @@ Section Finite_sets_facts. 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. + red; 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 |- *. + unfold pred at 2; symmetry . apply S_pred with (m := 0). - change (n > 0) in |- *. + change (n > 0). 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. + red; intro H'3. apply H'1. elim H'3; auto with sets. rewrite H'3; auto with sets. @@ -152,7 +152,7 @@ Section Finite_sets_facts. 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. + red; intro H'5; try exact H'5. lapply (Add_inv U X x x0); tauto. Qed. @@ -183,11 +183,11 @@ Section Finite_sets_facts. intros H'6 H'7; apply f_equal. 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. + pattern x at 2; 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'. + red; intro H'. lapply (Extension U (Add U X x) (Add U X0 x0)); auto with sets. clear H'. intro H'; red in H'. @@ -254,7 +254,7 @@ Section Finite_sets_facts. 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. + pattern x0 at 1; 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. diff --git a/theories/Sets/Image.v b/theories/Sets/Image.v index 24facb6f..bdb7c077 100644 --- a/theories/Sets/Image.v +++ b/theories/Sets/Image.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -55,7 +55,7 @@ Section Image. Proof. intros X x f. apply Extensionality_Ensembles. - split; red in |- *; intros x0 H'. + split; red; intros x0 H'. elim H'; intros. rewrite H0. elim Add_inv with U X x x1; auto using Im_def with sets. @@ -72,7 +72,7 @@ Section Image. intro f; try assumption. apply Extensionality_Ensembles. split; auto with sets. - red in |- *. + red. intros x H'; elim H'. intros x0 H'0; elim H'0; auto with sets. Qed. @@ -102,7 +102,7 @@ Section Image. forall f:U -> V, ~ injective f -> exists x : _, (exists y : _, f x = f y /\ x <> y). Proof. - unfold injective in |- *; intros f H. + unfold injective; 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. @@ -153,7 +153,7 @@ Section Image. 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. + red; intro; apply H'2. apply In_Image_elim with f; trivial with sets. Qed. @@ -180,7 +180,7 @@ Section Image. 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. + unfold not; 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); diff --git a/theories/Sets/Infinite_sets.v b/theories/Sets/Infinite_sets.v index a21fe880..897046ab 100644 --- a/theories/Sets/Infinite_sets.v +++ b/theories/Sets/Infinite_sets.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -56,7 +56,7 @@ Section Infinite_sets. 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'. + red; intro H'3; apply H'. rewrite <- H'3; auto with sets. Qed. @@ -76,7 +76,7 @@ Section Infinite_sets. split. apply card_add; auto with sets. cut (In U A x). - intro H'4; red in |- *; auto with sets. + intro H'4; red; 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. @@ -91,7 +91,7 @@ Section Infinite_sets. split. apply card_add; auto with sets. elim H'2; auto with sets. - red in |- *. + red. 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. @@ -167,11 +167,11 @@ Section Infinite_sets. 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. + red; 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. + red; 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. @@ -235,7 +235,7 @@ Section Infinite_sets. Proof. intros A f H' H'0 H'1. apply NNPP. - red in |- *; intro H'2. + red; intro H'2. elim (Pigeonhole_bis A f); auto with sets. Qed. diff --git a/theories/Sets/Integers.v b/theories/Sets/Integers.v index 2c94a2e1..4ee7496e 100644 --- a/theories/Sets/Integers.v +++ b/theories/Sets/Integers.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -49,17 +49,17 @@ Section Integers_sect. Lemma le_reflexive : Reflexive nat le. Proof. - red in |- *; auto with arith. + red; auto with arith. Qed. Lemma le_antisym : Antisymmetric nat le. Proof. - red in |- *; intros x y H H'; rewrite (le_antisym x y); auto. + red; 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. + red; intros; apply le_trans with y; auto. Qed. Lemma le_Order : Order nat le. @@ -83,7 +83,7 @@ Section Integers_sect. Lemma le_total_order : Totally_ordered nat nat_po Integers. Proof. apply Totally_ordered_definition. - simpl in |- *. + simpl. intros H' x y H'0. elim le_or_lt with (n := x) (m := y). intro H'1; left; auto with sets arith. @@ -103,7 +103,7 @@ Section Integers_sect. 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 |- *. + simpl. intro H'1; try assumption. lapply H'1; [ intro H'4; idtac | try assumption ]; auto with sets arith. generalize (H'4 x0 x). @@ -114,28 +114,28 @@ Section Integers_sect. [ 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. + apply Upper_Bound_definition. simpl. 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. + apply H'4 with (y := x0). elim H'3; simpl; 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. + elim H'3; simpl; auto with sets arith. intros x1 H'4; elim H'4; auto with sets arith. - red in |- *. + red. 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'. + red; intro H'; elim H'. intros x H'0. elim H'0; intros H'1 H'2. cut (In nat Integers (S x)). @@ -150,7 +150,7 @@ Section Integers_sect. Lemma Integers_infinite : ~ Finite nat Integers. Proof. generalize Integers_has_no_ub. - intro H'; red in |- *; intro H'0; try exact H'0. + intro H'; red; intro H'0; try exact H'0. apply H'. apply Finite_subset_has_lub; auto with sets arith. Qed. diff --git a/theories/Sets/Multiset.v b/theories/Sets/Multiset.v index 5f21335f..1d0abab8 100644 --- a/theories/Sets/Multiset.v +++ b/theories/Sets/Multiset.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -42,14 +42,14 @@ Section multiset_defs. Lemma meq_trans : forall x y z:multiset, meq x y -> meq y z -> meq x z. Proof. - unfold meq in |- *. + unfold meq. 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 |- *. + unfold meq. destruct x; destruct y; auto. Qed. @@ -59,12 +59,12 @@ Section multiset_defs. Lemma munion_empty_left : forall x:multiset, meq x (munion EmptyBag x). Proof. - unfold meq in |- *; unfold munion in |- *; simpl in |- *; auto. + unfold meq; unfold munion; simpl; auto. Qed. Lemma munion_empty_right : forall x:multiset, meq x (munion x EmptyBag). Proof. - unfold meq in |- *; unfold munion in |- *; simpl in |- *; auto. + unfold meq; unfold munion; simpl; auto. Qed. @@ -72,21 +72,21 @@ Section multiset_defs. Lemma munion_comm : forall x y:multiset, meq (munion x y) (munion y x). Proof. - unfold meq in |- *; unfold multiplicity in |- *; unfold munion in |- *. + unfold meq; unfold multiplicity; unfold munion. 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 |- *. + unfold meq; unfold munion; unfold multiplicity. 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 |- *. + unfold meq; unfold munion; unfold multiplicity. destruct x; destruct y; destruct z. intros; elim H; auto with arith. Qed. @@ -94,7 +94,7 @@ Section multiset_defs. 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 |- *. + unfold meq; unfold munion; unfold multiplicity. destruct x; destruct y; destruct z. intros; elim H; auto. Qed. diff --git a/theories/Sets/Partial_Order.v b/theories/Sets/Partial_Order.v index a319b983..054164da 100644 --- a/theories/Sets/Partial_Order.v +++ b/theories/Sets/Partial_Order.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -63,13 +63,13 @@ Section Partial_order_facts. 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 |- *. + unfold Strict_Rel_of at 1. + red. + elim D; simpl. 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. + red; 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. @@ -79,20 +79,20 @@ Section Partial_order_facts. 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 |- *. + unfold Strict_Rel_of at 1. + red. + elim D; simpl. 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. + red; 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 |- *. + red. 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 ]. diff --git a/theories/Sets/Permut.v b/theories/Sets/Permut.v index e28a1264..5523f64c 100644 --- a/theories/Sets/Permut.v +++ b/theories/Sets/Permut.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Powerset.v b/theories/Sets/Powerset.v index f8b24e74..cdbeaf7b 100644 --- a/theories/Sets/Powerset.v +++ b/theories/Sets/Powerset.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -39,7 +39,7 @@ Inductive Power_set (A:Ensemble U) : Ensemble (Ensemble U) := Hint Resolve Definition_of_Power_set. Theorem Empty_set_minimal : forall X:Ensemble U, Included U (Empty_set U) X. -intro X; red in |- *. +intro X; red. intros x H'; elim H'. Qed. Hint Resolve Empty_set_minimal. @@ -79,7 +79,7 @@ Lemma Strict_inclusion_is_transitive_with_inclusion : Strict_Included U x y -> Included U y z -> Strict_Included U x z. intros x y z H' H'0; try assumption. elim Strict_Rel_is_Strict_Included. -unfold contains in |- *. +unfold contains. intros H'1 H'2; try assumption. apply H'1. apply Strict_Rel_Transitive_with_Rel with (y := y); auto with sets. @@ -90,7 +90,7 @@ Lemma Strict_inclusion_is_transitive_with_inclusion_left : Included U x y -> Strict_Included U y z -> Strict_Included U x z. intros x y z H' H'0; try assumption. elim Strict_Rel_is_Strict_Included. -unfold contains in |- *. +unfold contains. intros H'1 H'2; try assumption. apply H'1. apply Strict_Rel_Transitive_with_Rel_left with (y := y); auto with sets. @@ -105,14 +105,14 @@ Qed. Theorem Empty_set_is_Bottom : forall A:Ensemble U, Bottom (Ensemble U) (Power_set_PO A) (Empty_set U). -intro A; apply Bottom_definition; simpl in |- *; auto with sets. +intro A; apply Bottom_definition; simpl; auto with sets. Qed. Hint Resolve Empty_set_is_Bottom. Theorem Union_minimal : forall a b X:Ensemble U, Included U a X -> Included U b X -> Included U (Union U a b) X. -intros a b X H' H'0; red in |- *. +intros a b X H' H'0; red. intros x H'1; elim H'1; auto with sets. Qed. Hint Resolve Union_minimal. @@ -133,13 +133,13 @@ Qed. Theorem Intersection_decreases_l : forall a b:Ensemble U, Included U (Intersection U a b) a. -intros a b; red in |- *. +intros a b; red. intros x H'; elim H'; auto with sets. Qed. Theorem Intersection_decreases_r : forall a b:Ensemble U, Included U (Intersection U a b) b. -intros a b; red in |- *. +intros a b; red. intros x H'; elim H'; auto with sets. Qed. Hint Resolve Union_increases_l Union_increases_r Intersection_decreases_l @@ -151,10 +151,10 @@ Theorem Union_is_Lub : Included U b A -> Lub (Ensemble U) (Power_set_PO A) (Couple (Ensemble U) a b) (Union U a b). intros A a b H' H'0. -apply Lub_definition; simpl in |- *. -apply Upper_Bound_definition; simpl in |- *; auto with sets. +apply Lub_definition; simpl. +apply Upper_Bound_definition; simpl; auto with sets. intros y H'1; elim H'1; auto with sets. -intros y H'1; elim H'1; simpl in |- *; auto with sets. +intros y H'1; elim H'1; simpl; auto with sets. Qed. Theorem Intersection_is_Glb : @@ -164,13 +164,13 @@ Theorem Intersection_is_Glb : Glb (Ensemble U) (Power_set_PO A) (Couple (Ensemble U) a b) (Intersection U a b). intros A a b H' H'0. -apply Glb_definition; simpl in |- *. -apply Lower_Bound_definition; simpl in |- *; auto with sets. +apply Glb_definition; simpl. +apply Lower_Bound_definition; simpl; auto with sets. apply Definition_of_Power_set. generalize Inclusion_is_transitive; intro IT; red in IT; apply IT with a; auto with sets. intros y H'1; elim H'1; auto with sets. -intros y H'1; elim H'1; simpl in |- *; auto with sets. +intros y H'1; elim H'1; simpl; auto with sets. Qed. End The_power_set_partial_order. diff --git a/theories/Sets/Powerset_Classical_facts.v b/theories/Sets/Powerset_Classical_facts.v index 09fc2094..d24e931d 100644 --- a/theories/Sets/Powerset_Classical_facts.v +++ b/theories/Sets/Powerset_Classical_facts.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -44,13 +44,13 @@ Section Sets_as_an_algebra. ~ 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 |- *. + intros A B x H' H'0; red. 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. + red; intro H'2. elim H'0; clear H'0. rewrite <- H'2; auto with sets. Qed. @@ -58,7 +58,7 @@ Section Sets_as_an_algebra. 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 X x H'; red. intros x0 H'0; elim H'0; auto with sets. Qed. @@ -66,7 +66,7 @@ Section Sets_as_an_algebra. 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 X Y x H'; red. intros x0 H'0; elim H'0. intros H'1 H'2. apply Subtract_intro; auto with sets. @@ -75,7 +75,7 @@ Section Sets_as_an_algebra. 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 X x; red. 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. @@ -85,10 +85,10 @@ Section Sets_as_an_algebra. 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 X x H'; red. 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. + red; intro H'1; apply H'; rewrite H'1; auto with sets. Qed. Hint Resolve incl_soustr_add_r: sets v62. @@ -96,7 +96,7 @@ Section Sets_as_an_algebra. 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 X x H'; red. intros x0 H'0; try assumption. elim (classic (x = x0)); intro K; auto with sets. elim K; auto with sets. @@ -106,7 +106,7 @@ Section Sets_as_an_algebra. 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 X x H'; red. 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. @@ -118,7 +118,7 @@ Section Sets_as_an_algebra. 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 |- *. + split; red. intros x0 H'0; elim H'0; auto with sets. intro H'1; elim H'1. intros u H'2 H'3; try assumption. @@ -146,7 +146,7 @@ Section Sets_as_an_algebra. 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. + red; intro H'0; apply H'2. rewrite H'0; auto 8 using add_soustr_xy, add_soustr_1, add_soustr_2 with sets. Qed. @@ -177,7 +177,7 @@ Section Sets_as_an_algebra. 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 |- *. + red. 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. @@ -189,7 +189,7 @@ Section Sets_as_an_algebra. elim K'; auto with sets. intro H'1; left; try assumption. red in H'0. - red in |- *. + red. intros x0 H'2; try assumption. lapply (H'0 x0); auto with sets. intro H'3; try assumption. @@ -207,7 +207,7 @@ Section Sets_as_an_algebra. (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 |- *. + unfold Strict_Rel_of; simpl. 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. @@ -227,11 +227,11 @@ Section Sets_as_an_algebra. 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. + red. + split; [ idtac | red; 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. + red; 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. @@ -249,7 +249,7 @@ Section Sets_as_an_algebra. red in K. elim K; intros H'11 H'12; apply H'12; clear K; auto with sets. rewrite H'15. - red in |- *. + red. intros x1 H'10; elim H'10; auto with sets. intros x2 H'11; elim H'11; auto with sets. Qed. @@ -275,11 +275,11 @@ Section Sets_as_an_algebra. 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. + red; intro H'8; try exact H'8. apply H'3. rewrite H'8; auto with sets. auto with sets. - red in |- *. + red. intros x0 H'1; elim H'1; auto with sets. intros x1 H'8; elim H'8; auto with sets. split; [ idtac | try assumption ]. diff --git a/theories/Sets/Powerset_facts.v b/theories/Sets/Powerset_facts.v index f756f985..58e3f44d 100644 --- a/theories/Sets/Powerset_facts.v +++ b/theories/Sets/Powerset_facts.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -42,7 +42,7 @@ Section Sets_as_an_algebra. 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. + unfold Add at 1; auto using Empty_set_zero with sets. Qed. Lemma less_than_empty : @@ -76,7 +76,7 @@ Section Sets_as_an_algebra. 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 x y; apply Extensionality_Ensembles; split; red. intros x0 H'; elim H'; (intros x1 H'0; elim H'0; auto with sets). intros x0 H'; elim H'; auto with sets. Qed. @@ -86,7 +86,7 @@ Section Sets_as_an_algebra. 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 x y z; apply Extensionality_Ensembles; split; red. 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. @@ -114,7 +114,7 @@ Section Sets_as_an_algebra. Proof. intros A B. apply Extensionality_Ensembles. - split; red in |- *; intros x H'; elim H'; auto with sets. + split; red; intros x H'; elim H'; auto with sets. Qed. Theorem Distributivity : @@ -124,7 +124,7 @@ Section Sets_as_an_algebra. Proof. intros A B C. apply Extensionality_Ensembles. - split; red in |- *; intros x H'. + split; red; intros x H'. elim H'. intros x0 H'0 H'1; generalize H'0. elim H'1; auto with sets. @@ -138,7 +138,7 @@ Section Sets_as_an_algebra. Proof. intros A B C. apply Extensionality_Ensembles. - split; red in |- *; intros x H'. + split; red; intros x H'. elim H'; auto with sets. intros x0 H'0; elim H'0; auto with sets. elim H'. @@ -151,15 +151,15 @@ Section Sets_as_an_algebra. 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. + unfold Add; 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 X x H'; unfold Add. + apply Extensionality_Ensembles; red. + split; red; auto with sets. intros x0 H'0; elim H'0; auto with sets. intros t H'1; elim H'1; auto with sets. Qed. @@ -167,12 +167,12 @@ Section Sets_as_an_algebra. 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 |- *. + intros X x H'; unfold Subtract. apply Extensionality_Ensembles. - split; red in |- *; auto with sets. + split; red; 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. + red; 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. @@ -186,7 +186,7 @@ Section Sets_as_an_algebra. 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 A B x H'; red; auto with sets. intros x0 H'0. lapply (Add_inv U A x x0); auto with sets. intro H'1; elim H'1; @@ -198,7 +198,7 @@ Section Sets_as_an_algebra. 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 |- *. + unfold Included. 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. @@ -212,7 +212,7 @@ Section Sets_as_an_algebra. 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 |- *. + unfold Add. 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)); @@ -234,7 +234,7 @@ Section Sets_as_an_algebra. Proof. intros A B x y H'; try assumption. rewrite <- (Union_add (Add U A x) B y). - unfold Add at 4 in |- *. + unfold Add at 4. rewrite (Union_commutative A (Singleton U x)). rewrite Union_associative. rewrite (Union_absorbs A B H'). diff --git a/theories/Sets/Relations_1.v b/theories/Sets/Relations_1.v index a7fbb53d..229ef592 100644 --- a/theories/Sets/Relations_1.v +++ b/theories/Sets/Relations_1.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Relations_1_facts.v b/theories/Sets/Relations_1_facts.v index 0c8329dd..c4ede814 100644 --- a/theories/Sets/Relations_1_facts.v +++ b/theories/Sets/Relations_1_facts.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -33,8 +33,8 @@ Theorem Rsym_imp_notRsym : forall (U:Type) (R:Relation U), Symmetric U R -> Symmetric U (Complement U R). Proof. -unfold Symmetric, Complement in |- *. -intros U R H' x y H'0; red in |- *; intro H'1; apply H'0; auto with sets. +unfold Symmetric, Complement. +intros U R H' x y H'0; red; intro H'1; apply H'0; auto with sets. Qed. Theorem Equiv_from_preorder : @@ -44,8 +44,8 @@ Proof. intros U R H'; elim H'; intros H'0 H'1. apply Definition_of_equivalence. red in H'0; auto 10 with sets. -2: red in |- *; intros x y h; elim h; intros H'3 H'4; auto 10 with sets. -red in H'1; red in |- *; auto 10 with sets. +2: red; intros x y h; elim h; intros H'3 H'4; auto 10 with sets. +red in H'1; red; auto 10 with sets. intros x y z h; elim h; intros H'3 H'4; clear h. intro h; elim h; intros H'5 H'6; clear h. split; apply H'1 with y; auto 10 with sets. @@ -70,7 +70,7 @@ Hint Resolve contains_is_preorder. Theorem same_relation_is_equivalence : forall U:Type, Equivalence (Relation U) (same_relation U). Proof. -unfold same_relation at 1 in |- *; auto 10 with sets. +unfold same_relation at 1; auto 10 with sets. Qed. Hint Resolve same_relation_is_equivalence. @@ -78,14 +78,14 @@ Theorem cong_reflexive_same_relation : forall (U:Type) (R R':Relation U), same_relation U R R' -> Reflexive U R -> Reflexive U R'. Proof. -unfold same_relation in |- *; intuition. +unfold same_relation; intuition. Qed. Theorem cong_symmetric_same_relation : forall (U:Type) (R R':Relation U), same_relation U R R' -> Symmetric U R -> Symmetric U R'. Proof. - compute in |- *; intros; elim H; intros; clear H; + compute; intros; elim H; intros; clear H; apply (H3 y x (H0 x y (H2 x y H1))). (*Intuition.*) Qed. @@ -94,7 +94,7 @@ Theorem cong_antisymmetric_same_relation : forall (U:Type) (R R':Relation U), same_relation U R R' -> Antisymmetric U R -> Antisymmetric U R'. Proof. - compute in |- *; intros; elim H; intros; clear H; + compute; intros; elim H; intros; clear H; apply (H0 x y (H3 x y H1) (H3 y x H2)). (*Intuition.*) Qed. @@ -103,7 +103,7 @@ Theorem cong_transitive_same_relation : forall (U:Type) (R R':Relation U), same_relation U R R' -> Transitive U R -> Transitive U R'. Proof. -intros U R R' H' H'0; red in |- *. +intros U R R' H' H'0; red. elim H'. intros H'1 H'2 x y z H'3 H'4; apply H'2. apply H'0 with y; auto with sets. diff --git a/theories/Sets/Relations_2.v b/theories/Sets/Relations_2.v index e7a69c99..a371f316 100644 --- a/theories/Sets/Relations_2.v +++ b/theories/Sets/Relations_2.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Relations_2_facts.v b/theories/Sets/Relations_2_facts.v index 89b98c1f..676fd719 100644 --- a/theories/Sets/Relations_2_facts.v +++ b/theories/Sets/Relations_2_facts.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -43,13 +43,13 @@ Qed. Theorem Rstar_contains_R : forall (U:Type) (R:Relation U), contains U (Rstar U R) R. Proof. -intros U R; red in |- *; intros x y H'; apply Rstar_n with y; auto with sets. +intros U R; red; intros x y H'; apply Rstar_n with y; auto with sets. Qed. Theorem Rstar_contains_Rplus : forall (U:Type) (R:Relation U), contains U (Rstar U R) (Rplus U R). Proof. -intros U R; red in |- *. +intros U R; red. intros x y H'; elim H'. generalize Rstar_contains_R; intro T; red in T; auto with sets. intros x0 y0 z H'0 H'1 H'2; apply Rstar_n with y0; auto with sets. @@ -58,7 +58,7 @@ Qed. Theorem Rstar_transitive : forall (U:Type) (R:Relation U), Transitive U (Rstar U R). Proof. -intros U R; red in |- *. +intros U R; red. intros x y z H'; elim H'; auto with sets. intros x0 y0 z0 H'0 H'1 H'2 H'3; apply Rstar_n with y0; auto with sets. Qed. @@ -75,7 +75,7 @@ Theorem Rstar_equiv_Rstar1 : forall (U:Type) (R:Relation U), same_relation U (Rstar U R) (Rstar1 U R). Proof. generalize Rstar_contains_R; intro T; red in T. -intros U R; unfold same_relation, contains in |- *. +intros U R; unfold same_relation, contains. split; intros x y H'; elim H'; auto with sets. generalize Rstar_transitive; intro T1; red in T1. intros x0 y0 z H'0 H'1 H'2 H'3; apply T1 with y0; auto with sets. @@ -85,7 +85,7 @@ Qed. Theorem Rsym_imp_Rstarsym : forall (U:Type) (R:Relation U), Symmetric U R -> Symmetric U (Rstar U R). Proof. -intros U R H'; red in |- *. +intros U R H'; red. intros x y H'0; elim H'0; auto with sets. intros x0 y0 z H'1 H'2 H'3. generalize Rstar_transitive; intro T1; red in T1. @@ -97,7 +97,7 @@ Theorem Sstar_contains_Rstar : forall (U:Type) (R S:Relation U), contains U (Rstar U S) R -> contains U (Rstar U S) (Rstar U R). Proof. -unfold contains in |- *. +unfold contains. intros U R S H' x y H'0; elim H'0; auto with sets. generalize Rstar_transitive; intro T1; red in T1. intros x0 y0 z H'1 H'2 H'3; apply T1 with y0; auto with sets. diff --git a/theories/Sets/Relations_3.v b/theories/Sets/Relations_3.v index 51092f7a..6d1853e2 100644 --- a/theories/Sets/Relations_3.v +++ b/theories/Sets/Relations_3.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Relations_3_facts.v b/theories/Sets/Relations_3_facts.v index 8ac6e7fb..a63f7c80 100644 --- a/theories/Sets/Relations_3_facts.v +++ b/theories/Sets/Relations_3_facts.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -33,7 +33,7 @@ Require Export Relations_3. Theorem Rstar_imp_coherent : forall (U:Type) (R:Relation U) (x y:U), Rstar U R x y -> coherent U R x y. Proof. -intros U R x y H'; red in |- *. +intros U R x y H'; red. exists y; auto with sets. Qed. Hint Resolve Rstar_imp_coherent. @@ -41,8 +41,8 @@ Hint Resolve Rstar_imp_coherent. Theorem coherent_symmetric : forall (U:Type) (R:Relation U), Symmetric U (coherent U R). Proof. -unfold coherent at 1 in |- *. -intros U R; red in |- *. +unfold coherent at 1. +intros U R; red. intros x y H'; elim H'. intros z H'0; exists z; tauto. Qed. @@ -50,9 +50,9 @@ Qed. Theorem Strong_confluence : forall (U:Type) (R:Relation U), Strongly_confluent U R -> Confluent U R. Proof. -intros U R H'; red in |- *. -intro x; red in |- *; intros a b H'0. -unfold coherent at 1 in |- *. +intros U R H'; red. +intro x; red; intros a b H'0. +unfold coherent at 1. generalize b; clear b. elim H'0; clear H'0. intros x0 b H'1; exists b; auto with sets. @@ -75,9 +75,9 @@ Qed. Theorem Strong_confluence_direct : forall (U:Type) (R:Relation U), Strongly_confluent U R -> Confluent U R. Proof. -intros U R H'; red in |- *. -intro x; red in |- *; intros a b H'0. -unfold coherent at 1 in |- *. +intros U R H'; red. +intro x; red; intros a b H'0. +unfold coherent at 1. generalize b; clear b. elim H'0; clear H'0. intros x0 b H'1; exists b; auto with sets. @@ -111,7 +111,7 @@ Theorem Noetherian_contains_Noetherian : forall (U:Type) (R R':Relation U), Noetherian U R -> contains U R R' -> Noetherian U R'. Proof. -unfold Noetherian at 2 in |- *. +unfold Noetherian at 2. intros U R R' H' H'0 x. elim (H' x); auto with sets. Qed. @@ -120,8 +120,8 @@ Theorem Newman : forall (U:Type) (R:Relation U), Noetherian U R -> Locally_confluent U R -> Confluent U R. Proof. -intros U R H' H'0; red in |- *; intro x. -elim (H' x); unfold confluent in |- *. +intros U R H' H'0; red; intro x. +elim (H' x); unfold confluent. intros x0 H'1 H'2 y z H'3 H'4. generalize (Rstar_cases U R x0 y); intro h; lapply h; [ intro h0; elim h0; @@ -163,7 +163,7 @@ generalize (H'2 v); intro h; lapply h; | clear h h0 ] | clear h h0 ] | clear h ]; auto with sets. -red in |- *; (exists z1; split); auto with sets. +red; (exists z1; split); auto with sets. apply T with y1; auto with sets. apply T with t; auto with sets. Qed. diff --git a/theories/Sets/Uniset.v b/theories/Sets/Uniset.v index bf1aaf8d..6e38b5e5 100644 --- a/theories/Sets/Uniset.v +++ b/theories/Sets/Uniset.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -51,37 +51,37 @@ Hint Unfold seq. Lemma leb_refl : forall b:bool, leb b b. Proof. -destruct b; simpl in |- *; auto. +destruct b; simpl; auto. Qed. Hint Resolve leb_refl. Lemma incl_left : forall s1 s2:uniset, seq s1 s2 -> incl s1 s2. Proof. -unfold incl in |- *; intros s1 s2 E a; elim (E a); auto. +unfold incl; intros s1 s2 E a; elim (E a); auto. Qed. Lemma incl_right : forall s1 s2:uniset, seq s1 s2 -> incl s2 s1. Proof. -unfold incl in |- *; intros s1 s2 E a; elim (E a); auto. +unfold incl; intros s1 s2 E a; elim (E a); auto. Qed. Lemma seq_refl : forall x:uniset, seq x x. Proof. -destruct x; unfold seq in |- *; auto. +destruct x; unfold seq; auto. Qed. Hint Resolve seq_refl. Lemma seq_trans : forall x y z:uniset, seq x y -> seq y z -> seq x z. Proof. -unfold seq in |- *. -destruct x; destruct y; destruct z; simpl in |- *; intros. +unfold seq. +destruct x; destruct y; destruct z; simpl; intros. rewrite H; auto. Qed. Lemma seq_sym : forall x y:uniset, seq x y -> seq y x. Proof. -unfold seq in |- *. -destruct x; destruct y; simpl in |- *; auto. +unfold seq. +destruct x; destruct y; simpl; auto. Qed. (** uniset union *) @@ -90,20 +90,20 @@ Definition union (m1 m2:uniset) := Lemma union_empty_left : forall x:uniset, seq x (union Emptyset x). Proof. -unfold seq in |- *; unfold union in |- *; simpl in |- *; auto. +unfold seq; unfold union; simpl; auto. Qed. Hint Resolve union_empty_left. Lemma union_empty_right : forall x:uniset, seq x (union x Emptyset). Proof. -unfold seq in |- *; unfold union in |- *; simpl in |- *. +unfold seq; unfold union; simpl. intros x a; rewrite (orb_b_false (charac x a)); auto. Qed. Hint Resolve union_empty_right. Lemma union_comm : forall x y:uniset, seq (union x y) (union y x). Proof. -unfold seq in |- *; unfold charac in |- *; unfold union in |- *. +unfold seq; unfold charac; unfold union. destruct x; destruct y; auto with bool. Qed. Hint Resolve union_comm. @@ -111,14 +111,14 @@ Hint Resolve union_comm. Lemma union_ass : forall x y z:uniset, seq (union (union x y) z) (union x (union y z)). Proof. -unfold seq in |- *; unfold union in |- *; unfold charac in |- *. +unfold seq; unfold union; unfold charac. destruct x; destruct y; destruct z; auto with bool. Qed. Hint Resolve union_ass. Lemma seq_left : forall x y z:uniset, seq x y -> seq (union x z) (union y z). Proof. -unfold seq in |- *; unfold union in |- *; unfold charac in |- *. +unfold seq; unfold union; unfold charac. destruct x; destruct y; destruct z. intros; elim H; auto. Qed. @@ -126,7 +126,7 @@ Hint Resolve seq_left. Lemma seq_right : forall x y z:uniset, seq x y -> seq (union z x) (union z y). Proof. -unfold seq in |- *; unfold union in |- *; unfold charac in |- *. +unfold seq; unfold union; unfold charac. destruct x; destruct y; destruct z. intros; elim H; auto. Qed. diff --git a/theories/Sorting/Heap.v b/theories/Sorting/Heap.v index 60bb50ce..8b1bdbd4 100644 --- a/theories/Sorting/Heap.v +++ b/theories/Sorting/Heap.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -55,13 +55,13 @@ Section defs. Lemma leA_Tree_Leaf : forall a:A, leA_Tree a Tree_Leaf. Proof. - simpl in |- *; auto with datatypes. + simpl; 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. + simpl; auto with datatypes. Qed. @@ -121,7 +121,7 @@ Section defs. 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. + intros; simpl; apply leA_trans with b; auto with datatypes. Qed. (** ** Merging two sorted lists *) @@ -213,12 +213,12 @@ Section defs. 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. + simpl; unfold meq, munion; auto using node_is_heap with datatypes. elim (leA_dec a a0); intros. elim (X 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. + simpl; apply treesort_twist1; trivial with datatypes. elim (X 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. @@ -226,7 +226,7 @@ Section defs. 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. + simpl; apply treesort_twist2; trivial with datatypes. Qed. @@ -242,10 +242,10 @@ Section defs. Proof. simple induction l. apply (heap_exist nil Tree_Leaf); auto with datatypes. - simpl in |- *; unfold meq in |- *; exact nil_is_heap. + simpl; unfold meq; 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. + intros; apply heap_exist with T1; simpl; 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. @@ -269,7 +269,7 @@ Section defs. apply flat_exist with (nil (A:=A)); auto with datatypes. elim X; intros l1 s1 i1 m1; elim X0; intros l2 s2 i2 m2. elim (merge _ s1 _ s2); intros. - apply flat_exist with (a :: l); simpl in |- *; auto with datatypes. + apply flat_exist with (a :: l); simpl; auto with datatypes. apply meq_trans with (munion (list_contents _ eqA_dec l1) (munion (list_contents _ eqA_dec l2) (singletonBag a))). @@ -288,7 +288,7 @@ Section defs. forall l:list A, {m : list A | Sorted leA m & permutation _ eqA_dec l m}. Proof. - intro l; unfold permutation in |- *. + intro l; unfold permutation. elim (list_to_heap l). intros. elim (heap_to_list T); auto with datatypes. diff --git a/theories/Sorting/Mergesort.v b/theories/Sorting/Mergesort.v index 7124cd53..301a2142 100644 --- a/theories/Sorting/Mergesort.v +++ b/theories/Sorting/Mergesort.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -131,7 +131,7 @@ Theorem Sorted_merge : forall l1 l2, Sorted l1 -> Sorted l2 -> Sorted (merge l1 l2). Proof. induction l1; induction l2; intros; simpl; auto. - destruct (a <=? a0) as ()_eqn:Heq1. + destruct (a <=? a0) eqn:Heq1. invert H. simpl. constructor; trivial; rewrite Heq1; constructor. assert (Sorted (merge (b::l) (a0::l2))) by (apply IHl1; auto). diff --git a/theories/Sorting/PermutEq.v b/theories/Sorting/PermutEq.v index d4e5fba4..cc47b500 100644 --- a/theories/Sorting/PermutEq.v +++ b/theories/Sorting/PermutEq.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sorting/PermutSetoid.v b/theories/Sorting/PermutSetoid.v index fa807c15..2cd4f5f7 100644 --- a/theories/Sorting/PermutSetoid.v +++ b/theories/Sorting/PermutSetoid.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -52,7 +52,7 @@ 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. + simple induction l; simpl; auto with datatypes. intros. apply meq_trans with (munion (singletonBag a) (munion (list_contents l0) (list_contents m))); @@ -65,19 +65,19 @@ 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. + unfold permutation; 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. + unfold permutation, meq; intros; symmetry; trivial. Qed. Lemma permut_trans : forall l m n:list A, permutation l m -> permutation m n -> permutation l n. Proof. - unfold permutation in |- *; intros. + unfold permutation; intros. apply meq_trans with (list_contents m); auto with datatypes. Qed. @@ -102,7 +102,7 @@ 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. + unfold permutation; 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')); diff --git a/theories/Sorting/Permutation.v b/theories/Sorting/Permutation.v index 797583d0..a69c4aa7 100644 --- a/theories/Sorting/Permutation.v +++ b/theories/Sorting/Permutation.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sorting/Sorted.v b/theories/Sorting/Sorted.v index 0e230b77..03952c95 100644 --- a/theories/Sorting/Sorted.v +++ b/theories/Sorting/Sorted.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sorting/Sorting.v b/theories/Sorting/Sorting.v index 22e56592..ab03cb5e 100644 --- a/theories/Sorting/Sorting.v +++ b/theories/Sorting/Sorting.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Strings/Ascii.v b/theories/Strings/Ascii.v index 1ed9140a..a89b888e 100644 --- a/theories/Strings/Ascii.v +++ b/theories/Strings/Ascii.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -65,7 +65,7 @@ Definition ascii_of_N (n : N) := (** Same for [nat] *) -Definition ascii_of_nat (a : nat) := ascii_of_N (N_of_nat a). +Definition ascii_of_nat (a : nat) := ascii_of_N (N.of_nat a). (** The opposite functions *) @@ -81,7 +81,7 @@ Definition N_of_ascii (a : ascii) : N := let (a0,a1,a2,a3,a4,a5,a6,a7) := a in N_of_digits (a0::a1::a2::a3::a4::a5::a6::a7::nil). -Definition nat_of_ascii (a : ascii) : nat := nat_of_N (N_of_ascii a). +Definition nat_of_ascii (a : ascii) : nat := N.to_nat (N_of_ascii a). (** Proofs that we have indeed opposite function (below 256) *) @@ -111,10 +111,10 @@ Theorem nat_ascii_embedding : Proof. intros. unfold nat_of_ascii, ascii_of_nat. rewrite N_ascii_embedding. - apply nat_of_N_of_nat. - unfold Nlt. - change 256%N with (N_of_nat 256). - rewrite <- N_of_nat_compare. + apply Nat2N.id. + unfold N.lt. + change 256%N with (N.of_nat 256). + rewrite <- Nat2N.inj_compare. rewrite <- Compare_dec.nat_compare_lt. auto. Qed. @@ -137,7 +137,7 @@ Qed. which is typically not the case in coqide). *) -Open Local Scope char_scope. +Local Open Scope char_scope. Example Space := " ". Example DoubleQuote := """". diff --git a/theories/Strings/String.v b/theories/Strings/String.v index 958ecd4f..6294d156 100644 --- a/theories/Strings/String.v +++ b/theories/Strings/String.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -24,7 +24,7 @@ Inductive string : Set := Delimit Scope string_scope with string. Bind Scope string_scope with string. -Open Local Scope string_scope. +Local Open Scope string_scope. (** Equality is decidable *) @@ -72,14 +72,14 @@ Fixpoint get (n : nat) (s : string) {struct s} : option ascii := Theorem get_correct : forall s1 s2 : string, (forall n : nat, get n s1 = get n s2) <-> s1 = s2. Proof. -intros s1; elim s1; simpl in |- *. -intros s2; case s2; simpl in |- *; split; auto. +intros s1; elim s1; simpl. +intros s2; case s2; simpl; split; auto. intros H; generalize (H 0); intros H1; inversion H1. intros; discriminate. -intros a s1' Rec s2; case s2; simpl in |- *; split; auto. +intros a s1' Rec s2; case s2; simpl; split; auto. intros H; generalize (H 0); intros H1; inversion H1. intros; discriminate. -intros H; generalize (H 0); simpl in |- *; intros H1; inversion H1. +intros H; generalize (H 0); simpl; intros H1; inversion H1. case (Rec s). intros H0; rewrite H0; auto. intros n; exact (H (S n)). @@ -94,9 +94,9 @@ Theorem append_correct1 : forall (s1 s2 : string) (n : nat), n < length s1 -> get n s1 = get n (s1 ++ s2). Proof. -intros s1; elim s1; simpl in |- *; auto. +intros s1; elim s1; simpl; auto. intros s2 n H; inversion H. -intros a s1' Rec s2 n; case n; simpl in |- *; auto. +intros a s1' Rec s2 n; case n; simpl; auto. intros n0 H; apply Rec; auto. apply lt_S_n; auto. Qed. @@ -107,10 +107,10 @@ Theorem append_correct2 : forall (s1 s2 : string) (n : nat), get n s2 = get (n + length s1) (s1 ++ s2). Proof. -intros s1; elim s1; simpl in |- *; auto. -intros s2 n; rewrite plus_comm; simpl in |- *; auto. -intros a s1' Rec s2 n; case n; simpl in |- *; auto. -generalize (Rec s2 0); simpl in |- *; auto. intros. +intros s1; elim s1; simpl; auto. +intros s2 n; rewrite plus_comm; simpl; auto. +intros a s1' Rec s2 n; case n; simpl; auto. +generalize (Rec s2 0); simpl; auto. intros. rewrite <- Plus.plus_Snm_nSm; auto. Qed. @@ -135,16 +135,16 @@ Theorem substring_correct1 : forall (s : string) (n m p : nat), p < m -> get p (substring n m s) = get (p + n) s. Proof. -intros s; elim s; simpl in |- *; auto. -intros n; case n; simpl in |- *; auto. -intros m; case m; simpl in |- *; auto. -intros a s' Rec; intros n; case n; simpl in |- *; auto. -intros m; case m; simpl in |- *; auto. +intros s; elim s; simpl; auto. +intros n; case n; simpl; auto. +intros m; case m; simpl; auto. +intros a s' Rec; intros n; case n; simpl; auto. +intros m; case m; simpl; auto. intros p H; inversion H. -intros m' p; case p; simpl in |- *; auto. -intros n0 H; apply Rec; simpl in |- *; auto. +intros m' p; case p; simpl; auto. +intros n0 H; apply Rec; simpl; auto. apply Lt.lt_S_n; auto. -intros n' m p H; rewrite <- Plus.plus_Snm_nSm; simpl in |- *; auto. +intros n' m p H; rewrite <- Plus.plus_Snm_nSm; simpl; auto. Qed. (** The substring has at most [m] elements *) @@ -152,14 +152,14 @@ Qed. Theorem substring_correct2 : forall (s : string) (n m p : nat), m <= p -> get p (substring n m s) = None. Proof. -intros s; elim s; simpl in |- *; auto. -intros n; case n; simpl in |- *; auto. -intros m; case m; simpl in |- *; auto. -intros a s' Rec; intros n; case n; simpl in |- *; auto. -intros m; case m; simpl in |- *; auto. -intros m' p; case p; simpl in |- *; auto. +intros s; elim s; simpl; auto. +intros n; case n; simpl; auto. +intros m; case m; simpl; auto. +intros a s' Rec; intros n; case n; simpl; auto. +intros m; case m; simpl; auto. +intros m' p; case p; simpl; auto. intros H; inversion H. -intros n0 H; apply Rec; simpl in |- *; auto. +intros n0 H; apply Rec; simpl; auto. apply Le.le_S_n; auto. Qed. @@ -188,11 +188,11 @@ Theorem prefix_correct : forall s1 s2 : string, prefix s1 s2 = true <-> substring 0 (length s1) s2 = s1. Proof. -intros s1; elim s1; simpl in |- *; auto. -intros s2; case s2; simpl in |- *; split; auto. -intros a s1' Rec s2; case s2; simpl in |- *; auto. +intros s1; elim s1; simpl; auto. +intros s2; case s2; simpl; split; auto. +intros a s1' Rec s2; case s2; simpl; auto. split; intros; discriminate. -intros b s2'; case (ascii_dec a b); simpl in |- *; auto. +intros b s2'; case (ascii_dec a b); simpl; auto. intros e; case (Rec s2'); intros H1 H2; split; intros H3; auto. rewrite e; rewrite H1; auto. apply H2; injection H3; auto. @@ -234,25 +234,25 @@ Theorem index_correct1 : forall (n m : nat) (s1 s2 : string), index n s1 s2 = Some m -> substring m (length s1) s2 = s1. Proof. -intros n m s1 s2; generalize n m s1; clear n m s1; elim s2; simpl in |- *; +intros n m s1 s2; generalize n m s1; clear n m s1; elim s2; simpl; auto. -intros n; case n; simpl in |- *; auto. -intros m s1; case s1; simpl in |- *; auto. +intros n; case n; simpl; auto. +intros m s1; case s1; simpl; auto. intros H; injection H; intros H1; rewrite <- H1; auto. intros; discriminate. intros; discriminate. intros b s2' Rec n m s1. -case n; simpl in |- *; auto. +case n; simpl; auto. generalize (prefix_correct s1 (String b s2')); case (prefix s1 (String b s2')). intros H0 H; injection H; intros H1; rewrite <- H1; auto. -case H0; simpl in |- *; auto. -case m; simpl in |- *; auto. +case H0; simpl; auto. +case m; simpl; auto. case (index 0 s1 s2'); intros; discriminate. intros m'; generalize (Rec 0 m' s1); case (index 0 s1 s2'); auto. intros x H H0 H1; apply H; injection H1; auto. intros; discriminate. -intros n'; case m; simpl in |- *; auto. +intros n'; case m; simpl; auto. case (index n' s1 s2'); intros; discriminate. intros m'; generalize (Rec n' m' s1); case (index n' s1 s2'); auto. intros x H H1; apply H; injection H1; auto. @@ -267,35 +267,35 @@ Theorem index_correct2 : index n s1 s2 = Some m -> forall p : nat, n <= p -> p < m -> substring p (length s1) s2 <> s1. Proof. -intros n m s1 s2; generalize n m s1; clear n m s1; elim s2; simpl in |- *; +intros n m s1 s2; generalize n m s1; clear n m s1; elim s2; simpl; auto. -intros n; case n; simpl in |- *; auto. -intros m s1; case s1; simpl in |- *; auto. +intros n; case n; simpl; auto. +intros m s1; case s1; simpl; auto. intros H; injection H; intros H1; rewrite <- H1. intros p H0 H2; inversion H2. intros; discriminate. intros; discriminate. intros b s2' Rec n m s1. -case n; simpl in |- *; auto. +case n; simpl; auto. generalize (prefix_correct s1 (String b s2')); case (prefix s1 (String b s2')). intros H0 H; injection H; intros H1; rewrite <- H1; auto. intros p H2 H3; inversion H3. -case m; simpl in |- *; auto. +case m; simpl; auto. case (index 0 s1 s2'); intros; discriminate. intros m'; generalize (Rec 0 m' s1); case (index 0 s1 s2'); auto. -intros x H H0 H1 p; try case p; simpl in |- *; auto. -intros H2 H3; red in |- *; intros H4; case H0. +intros x H H0 H1 p; try case p; simpl; auto. +intros H2 H3; red; intros H4; case H0. intros H5 H6; absurd (false = true); auto with bool. intros n0 H2 H3; apply H; auto. injection H1; auto. apply Le.le_O_n. apply Lt.lt_S_n; auto. intros; discriminate. -intros n'; case m; simpl in |- *; auto. +intros n'; case m; simpl; auto. case (index n' s1 s2'); intros; discriminate. intros m'; generalize (Rec n' m' s1); case (index n' s1 s2'); auto. -intros x H H0 p; case p; simpl in |- *; auto. +intros x H H0 p; case p; simpl; auto. intros H1; inversion H1; auto. intros n0 H1 H2; apply H; auto. injection H0; auto. @@ -312,33 +312,33 @@ Theorem index_correct3 : index n s1 s2 = None -> s1 <> EmptyString -> n <= m -> substring m (length s1) s2 <> s1. Proof. -intros n m s1 s2; generalize n m s1; clear n m s1; elim s2; simpl in |- *; +intros n m s1 s2; generalize n m s1; clear n m s1; elim s2; simpl; auto. -intros n; case n; simpl in |- *; auto. -intros m s1; case s1; simpl in |- *; auto. -case m; intros; red in |- *; intros; discriminate. +intros n; case n; simpl; auto. +intros m s1; case s1; simpl; auto. +case m; intros; red; intros; discriminate. intros n' m; case m; auto. -intros s1; case s1; simpl in |- *; auto. +intros s1; case s1; simpl; auto. intros b s2' Rec n m s1. -case n; simpl in |- *; auto. +case n; simpl; auto. generalize (prefix_correct s1 (String b s2')); case (prefix s1 (String b s2')). intros; discriminate. -case m; simpl in |- *; auto with bool. -case s1; simpl in |- *; auto. -intros a s H H0 H1 H2; red in |- *; intros H3; case H. +case m; simpl; auto with bool. +case s1; simpl; auto. +intros a s H H0 H1 H2; red; intros H3; case H. intros H4 H5; absurd (false = true); auto with bool. -case s1; simpl in |- *; auto. +case s1; simpl; auto. intros a s n0 H H0 H1 H2; - change (substring n0 (length (String a s)) s2' <> String a s) in |- *; + change (substring n0 (length (String a s)) s2' <> String a s); apply (Rec 0); auto. -generalize H0; case (index 0 (String a s) s2'); simpl in |- *; auto; intros; +generalize H0; case (index 0 (String a s) s2'); simpl; auto; intros; discriminate. apply Le.le_O_n. -intros n'; case m; simpl in |- *; auto. +intros n'; case m; simpl; auto. intros H H0 H1; inversion H1. intros n0 H H0 H1; apply (Rec n'); auto. -generalize H; case (index n' s1 s2'); simpl in |- *; auto; intros; +generalize H; case (index n' s1 s2'); simpl; auto; intros; discriminate. apply Le.le_S_n; auto. Qed. @@ -353,13 +353,13 @@ Theorem index_correct4 : forall (n : nat) (s : string), index n EmptyString s = None -> length s < n. Proof. -intros n s; generalize n; clear n; elim s; simpl in |- *; auto. -intros n; case n; simpl in |- *; auto. +intros n s; generalize n; clear n; elim s; simpl; auto. +intros n; case n; simpl; auto. intros; discriminate. intros; apply Lt.lt_O_Sn. -intros a s' H n; case n; simpl in |- *; auto. +intros a s' H n; case n; simpl; auto. intros; discriminate. -intros n'; generalize (H n'); case (index n' EmptyString s'); simpl in |- *; +intros n'; generalize (H n'); case (index n' EmptyString s'); simpl; auto. intros; discriminate. intros H0 H1; apply Lt.lt_n_S; auto. diff --git a/theories/Structures/DecidableTypeEx.v b/theories/Structures/DecidableTypeEx.v index 2c02f8dd..971fcd7f 100644 --- a/theories/Structures/DecidableTypeEx.v +++ b/theories/Structures/DecidableTypeEx.v @@ -79,9 +79,9 @@ End PairDecidableType. Module PairUsualDecidableType(D1 D2:UsualDecidableType) <: UsualDecidableType. Definition t := prod D1.t D2.t. Definition eq := @eq t. - Definition eq_refl := @refl_equal t. - Definition eq_sym := @sym_eq t. - Definition eq_trans := @trans_eq t. + Definition eq_refl := @eq_refl t. + Definition eq_sym := @eq_sym t. + Definition eq_trans := @eq_trans t. Definition eq_dec : forall x y, { eq x y }+{ ~eq x y }. Proof. intros (x1,x2) (y1,y2); diff --git a/theories/Structures/OrderedTypeEx.v b/theories/Structures/OrderedTypeEx.v index adeba9e4..83130deb 100644 --- a/theories/Structures/OrderedTypeEx.v +++ b/theories/Structures/OrderedTypeEx.v @@ -21,9 +21,9 @@ Module Type UsualOrderedType. Parameter Inline t : Type. Definition eq := @eq t. Parameter Inline lt : t -> t -> Prop. - Definition eq_refl := @refl_equal t. - Definition eq_sym := @sym_eq t. - Definition eq_trans := @trans_eq t. + Definition eq_refl := @eq_refl t. + Definition eq_sym := @eq_sym t. + Definition eq_trans := @eq_trans t. Axiom lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z. Axiom lt_not_eq : forall x y : t, lt x y -> ~ eq x y. Parameter compare : forall x y : t, Compare lt eq x y. @@ -41,9 +41,9 @@ Module Nat_as_OT <: UsualOrderedType. Definition t := nat. Definition eq := @eq nat. - Definition eq_refl := @refl_equal t. - Definition eq_sym := @sym_eq t. - Definition eq_trans := @trans_eq t. + Definition eq_refl := @eq_refl t. + Definition eq_sym := @eq_sym t. + Definition eq_trans := @eq_trans t. Definition lt := lt. @@ -53,12 +53,12 @@ Module Nat_as_OT <: UsualOrderedType. Lemma lt_not_eq : forall x y : t, lt x y -> ~ eq x y. Proof. unfold lt, eq; intros; omega. Qed. - Definition compare : forall x y : t, Compare lt eq x y. + Definition compare x y : Compare lt eq x y. Proof. - intros x y; destruct (nat_compare x y) as [ | | ]_eqn. - apply EQ. apply nat_compare_eq; assumption. - apply LT. apply nat_compare_Lt_lt; assumption. - apply GT. apply nat_compare_Gt_gt; assumption. + case_eq (nat_compare x y); intro. + - apply EQ. now apply nat_compare_eq. + - apply LT. now apply nat_compare_Lt_lt. + - apply GT. now apply nat_compare_Gt_gt. Defined. Definition eq_dec := eq_nat_dec. @@ -68,15 +68,15 @@ End Nat_as_OT. (** [Z] is an ordered type with respect to the usual order on integers. *) -Open Local Scope Z_scope. +Local Open Scope Z_scope. Module Z_as_OT <: UsualOrderedType. Definition t := Z. Definition eq := @eq Z. - Definition eq_refl := @refl_equal t. - Definition eq_sym := @sym_eq t. - Definition eq_trans := @trans_eq t. + Definition eq_refl := @eq_refl t. + Definition eq_sym := @eq_sym t. + Definition eq_trans := @eq_trans t. Definition lt (x y:Z) := (x<y). @@ -86,81 +86,73 @@ Module Z_as_OT <: UsualOrderedType. Lemma lt_not_eq : forall x y, x<y -> ~ x=y. Proof. intros; omega. Qed. - Definition compare : forall x y, Compare lt eq x y. + Definition compare x y : Compare lt eq x y. Proof. - intros x y; destruct (x ?= y) as [ | | ]_eqn. - apply EQ; apply Zcompare_Eq_eq; assumption. - apply LT; assumption. - apply GT; apply Zgt_lt; assumption. + case_eq (x ?= y); intro. + - apply EQ. now apply Z.compare_eq. + - apply LT. assumption. + - apply GT. now apply Z.gt_lt. Defined. - Definition eq_dec := Z_eq_dec. + Definition eq_dec := Z.eq_dec. End Z_as_OT. (** [positive] is an ordered type with respect to the usual order on natural numbers. *) -Open Local Scope positive_scope. +Local Open Scope positive_scope. Module Positive_as_OT <: UsualOrderedType. Definition t:=positive. Definition eq:=@eq positive. - Definition eq_refl := @refl_equal t. - Definition eq_sym := @sym_eq t. - Definition eq_trans := @trans_eq t. + Definition eq_refl := @eq_refl t. + Definition eq_sym := @eq_sym t. + Definition eq_trans := @eq_trans t. - Definition lt := Plt. + Definition lt := Pos.lt. - Definition lt_trans := Plt_trans. + Definition lt_trans := Pos.lt_trans. Lemma lt_not_eq : forall x y : t, lt x y -> ~ eq x y. Proof. - intros x y H. contradict H. rewrite H. apply Plt_irrefl. + intros x y H. contradict H. rewrite H. apply Pos.lt_irrefl. Qed. - Definition compare : forall x y : t, Compare lt eq x y. + Definition compare x y : Compare lt eq x y. Proof. - intros x y. destruct (x ?= y) as [ | | ]_eqn. - apply EQ; apply Pcompare_Eq_eq; assumption. - apply LT; assumption. - apply GT; apply ZC1; assumption. + case_eq (x ?= y); intros H. + - apply EQ. now apply Pos.compare_eq. + - apply LT; assumption. + - apply GT. now apply Pos.gt_lt. Defined. - Definition eq_dec : forall x y, { eq x y } + { ~ eq x y }. - Proof. - intros; unfold eq; decide equality. - Defined. + Definition eq_dec := Pos.eq_dec. End Positive_as_OT. (** [N] is an ordered type with respect to the usual order on natural numbers. *) -Open Local Scope positive_scope. - Module N_as_OT <: UsualOrderedType. Definition t:=N. Definition eq:=@eq N. - Definition eq_refl := @refl_equal t. - Definition eq_sym := @sym_eq t. - Definition eq_trans := @trans_eq t. + Definition eq_refl := @eq_refl t. + Definition eq_sym := @eq_sym t. + Definition eq_trans := @eq_trans t. - Definition lt:=Nlt. - Definition lt_trans := Nlt_trans. - Definition lt_not_eq := Nlt_not_eq. + Definition lt := N.lt. + Definition lt_trans := N.lt_trans. + Definition lt_not_eq := N.lt_neq. - Definition compare : forall x y : t, Compare lt eq x y. + Definition compare x y : Compare lt eq x y. Proof. - intros x y. destruct (x ?= y)%N as [ | | ]_eqn. - apply EQ; apply Ncompare_Eq_eq; assumption. - apply LT; assumption. - apply GT. apply Ngt_Nlt; assumption. + case_eq (x ?= y)%N; intro. + - apply EQ. now apply N.compare_eq. + - apply LT. assumption. + - apply GT. now apply N.gt_lt. Defined. - Definition eq_dec : forall x y, { eq x y } + { ~ eq x y }. - Proof. - intros. unfold eq. decide equality. apply Positive_as_OT.eq_dec. - Defined. + Definition eq_dec := N.eq_dec. End N_as_OT. @@ -240,9 +232,9 @@ End PairOrderedType. Module PositiveOrderedTypeBits <: UsualOrderedType. Definition t:=positive. Definition eq:=@eq positive. - Definition eq_refl := @refl_equal t. - Definition eq_sym := @sym_eq t. - Definition eq_trans := @trans_eq t. + Definition eq_refl := @eq_refl t. + Definition eq_sym := @eq_sym t. + Definition eq_trans := @eq_trans t. Fixpoint bits_lt (p q:positive) : Prop := match p, q with @@ -286,38 +278,38 @@ Module PositiveOrderedTypeBits <: UsualOrderedType. Definition compare : forall x y : t, Compare lt eq x y. Proof. induction x; destruct y. - (* I I *) - destruct (IHx y). - apply LT; auto. - apply EQ; rewrite e; red; auto. - apply GT; auto. - (* I O *) - apply GT; simpl; auto. - (* I H *) - apply GT; simpl; auto. - (* O I *) - apply LT; simpl; auto. - (* O O *) - destruct (IHx y). - apply LT; auto. - apply EQ; rewrite e; red; auto. - apply GT; auto. - (* O H *) - apply LT; simpl; auto. - (* H I *) - apply LT; simpl; auto. - (* H O *) - apply GT; simpl; auto. - (* H H *) - apply EQ; red; auto. + - (* I I *) + destruct (IHx y). + apply LT; auto. + apply EQ; rewrite e; red; auto. + apply GT; auto. + - (* I O *) + apply GT; simpl; auto. + - (* I H *) + apply GT; simpl; auto. + - (* O I *) + apply LT; simpl; auto. + - (* O O *) + destruct (IHx y). + apply LT; auto. + apply EQ; rewrite e; red; auto. + apply GT; auto. + - (* O H *) + apply LT; simpl; auto. + - (* H I *) + apply LT; simpl; auto. + - (* H O *) + apply GT; simpl; auto. + - (* H H *) + apply EQ; red; auto. Qed. Lemma eq_dec (x y: positive): {x = y} + {x <> y}. Proof. intros. case_eq (x ?= y); intros. - left. apply Pcompare_Eq_eq; auto. - right. red. intro. subst y. rewrite (Pos.compare_refl x) in H. discriminate. - right. red. intro. subst y. rewrite (Pos.compare_refl x) in H. discriminate. + - left. now apply Pos.compare_eq. + - right. intro. subst y. now rewrite (Pos.compare_refl x) in *. + - right. intro. subst y. now rewrite (Pos.compare_refl x) in *. Qed. End PositiveOrderedTypeBits. diff --git a/theories/Structures/OrdersAlt.v b/theories/Structures/OrdersAlt.v index 85e7fb17..5dd917a7 100644 --- a/theories/Structures/OrdersAlt.v +++ b/theories/Structures/OrdersAlt.v @@ -140,7 +140,7 @@ Module OT_from_Alt (Import O:OrderedTypeAlt) <: OrderedType. Lemma lt_eq : forall x y z, lt x y -> eq y z -> lt x z. Proof. unfold lt, eq; intros x y z Hxy Hyz. - destruct (compare x z) as [ ]_eqn:Hxz; auto. + destruct (compare x z) eqn:Hxz; auto. rewrite compare_sym, CompOpp_iff in Hyz. simpl in Hyz. rewrite (compare_trans Hxz Hyz) in Hxy; discriminate. rewrite compare_sym, CompOpp_iff in Hxy. simpl in Hxy. @@ -150,7 +150,7 @@ Module OT_from_Alt (Import O:OrderedTypeAlt) <: OrderedType. Lemma eq_lt : forall x y z, eq x y -> lt y z -> lt x z. Proof. unfold lt, eq; intros x y z Hxy Hyz. - destruct (compare x z) as [ ]_eqn:Hxz; auto. + destruct (compare x z) eqn:Hxz; auto. rewrite compare_sym, CompOpp_iff in Hxy. simpl in Hxy. rewrite (compare_trans Hxy Hxz) in Hyz; discriminate. rewrite compare_sym, CompOpp_iff in Hyz. simpl in Hyz. @@ -169,7 +169,7 @@ Module OT_from_Alt (Import O:OrderedTypeAlt) <: OrderedType. Lemma compare_spec : forall x y, CompSpec eq lt x y (compare x y). Proof. unfold eq, lt, compare; intros. - destruct (O.compare x y) as [ ]_eqn:H; auto. + destruct (O.compare x y) eqn:H; auto. apply CompGt. rewrite compare_sym, H; auto. Qed. diff --git a/theories/Unicode/Utf8.v b/theories/Unicode/Utf8.v index 86ab4776..6d2da154 100644 --- a/theories/Unicode/Utf8.v +++ b/theories/Unicode/Utf8.v @@ -1,7 +1,7 @@ (* -*- coding:utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -20,5 +20,5 @@ Check ∀ x z, True -> (∃ y v, x + v ≥ y + z) ∨ x ≤ 0. (* Integer Arithmetic *) (* TODO: this should come after ZArith -Notation "x ≤ y" := (Zle x y) (at level 70, no associativity). +Notation "x ≤ y" := (Z.le x y) (at level 70, no associativity). *) diff --git a/theories/Unicode/Utf8_core.v b/theories/Unicode/Utf8_core.v index 13387f30..f9670d17 100644 --- a/theories/Unicode/Utf8_core.v +++ b/theories/Unicode/Utf8_core.v @@ -1,7 +1,7 @@ (* -*- coding:utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Vectors/VectorDef.v b/theories/Vectors/VectorDef.v index 30c0d4c0..32ffcb3d 100644 --- a/theories/Vectors/VectorDef.v +++ b/theories/Vectors/VectorDef.v @@ -19,7 +19,7 @@ have to be the same. complain if you see mistakes ... *) Require Import Arith_base. Require Vectors.Fin. Import EqNotations. -Open Local Scope nat_scope. +Local Open Scope nat_scope. (** A vector is a list of size n whose elements belong to a set A. *) diff --git a/theories/Wellfounded/Disjoint_Union.v b/theories/Wellfounded/Disjoint_Union.v index f5daa301..8f5c0957 100644 --- a/theories/Wellfounded/Disjoint_Union.v +++ b/theories/Wellfounded/Disjoint_Union.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -41,7 +41,7 @@ Section Wf_Disjoint_Union. well_founded leA -> well_founded leB -> well_founded Le_AsB. Proof. intros. - unfold well_founded in |- *. + unfold well_founded. destruct a as [a| b]. apply (acc_A_sum a). apply (H a). diff --git a/theories/Wellfounded/Inclusion.v b/theories/Wellfounded/Inclusion.v index 1c83c481..c7cc29b5 100644 --- a/theories/Wellfounded/Inclusion.v +++ b/theories/Wellfounded/Inclusion.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -24,7 +24,7 @@ Section WfInclusion. Theorem wf_incl : inclusion A R1 R2 -> well_founded R2 -> well_founded R1. Proof. - unfold well_founded in |- *; auto with sets. + unfold well_founded; auto with sets. Qed. End WfInclusion. diff --git a/theories/Wellfounded/Inverse_Image.v b/theories/Wellfounded/Inverse_Image.v index 27a1c381..e38b2157 100644 --- a/theories/Wellfounded/Inverse_Image.v +++ b/theories/Wellfounded/Inverse_Image.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -31,7 +31,7 @@ Section Inverse_Image. Theorem wf_inverse_image : well_founded R -> well_founded Rof. Proof. - red in |- *; intros; apply Acc_inverse_image; auto. + red; intros; apply Acc_inverse_image; auto. Qed. Variable F : A -> B -> Prop. @@ -49,7 +49,7 @@ Section Inverse_Image. Theorem wf_inverse_rel : well_founded R -> well_founded RoF. Proof. - red in |- *; constructor; intros. + red; constructor; intros. case H0; intros. apply (Acc_inverse_rel x); auto. Qed. diff --git a/theories/Wellfounded/Lexicographic_Exponentiation.v b/theories/Wellfounded/Lexicographic_Exponentiation.v index 6d5b663b..13db01a3 100644 --- a/theories/Wellfounded/Lexicographic_Exponentiation.v +++ b/theories/Wellfounded/Lexicographic_Exponentiation.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -36,11 +36,11 @@ Section Wf_Lexicographic_Exponentiation. Proof. simple induction x. simple induction z. - simpl in |- *; intros H. + simpl; intros H. inversion_clear H. - simpl in |- *; intros; apply (Lt_nil A leA). + simpl; intros; apply (Lt_nil A leA). intros a l HInd. - simpl in |- *. + simpl. intros. inversion_clear H. apply (Lt_hd A leA); auto with sets. @@ -54,7 +54,7 @@ Section Wf_Lexicographic_Exponentiation. 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 |- *. + elim y; simpl. right. exists x0; auto with sets. intros. @@ -196,7 +196,7 @@ Section Wf_Lexicographic_Exponentiation. Descl x0 /\ Descl (l0 ++ Cons x1 Nil)). - simpl in |- *. + simpl. split. generalize (app_inj_tail _ _ _ _ H2); simple induction 1. simple induction 1; auto with sets. @@ -239,7 +239,7 @@ Section Wf_Lexicographic_Exponentiation. Proof. intros a b x. case x. - simpl in |- *. + simpl. simple induction 1. intros. inversion H1; auto with sets. @@ -267,7 +267,7 @@ Section Wf_Lexicographic_Exponentiation. case x. intros; apply (Lt_nil A leA). - simpl in |- *; intros. + simpl; intros. inversion_clear H0. apply (Lt_hd A leA a b); auto with sets. @@ -284,17 +284,17 @@ Section Wf_Lexicographic_Exponentiation. apply (Acc_inv (R:=Lex_Exp) (x:=<< x1 ++ x2, y1 >>)). auto with sets. - unfold lex_exp in |- *; simpl in |- *; auto with sets. + unfold lex_exp; simpl; auto with sets. Qed. Theorem wf_lex_exp : well_founded leA -> well_founded Lex_Exp. Proof. - unfold well_founded at 2 in |- *. + unfold well_founded at 2. simple induction a; intros x y. apply Acc_intro. simple induction y0. - unfold lex_exp at 1 in |- *; simpl in |- *. + unfold lex_exp at 1; simpl. apply rev_ind with (A := A) (P := fun x:List => @@ -335,8 +335,8 @@ Section Wf_Lexicographic_Exponentiation. intro. apply Acc_intro. simple induction y2. - unfold lex_exp at 1 in |- *. - simpl in |- *; intros x4 y3. intros. + unfold lex_exp at 1. + simpl; intros x4 y3. intros. apply (H0 x4 y3); auto with sets. intros. @@ -357,7 +357,7 @@ Section Wf_Lexicographic_Exponentiation. generalize (HInd2 f); intro. apply Acc_intro. simple induction y3. - unfold lex_exp at 1 in |- *; simpl in |- *; intros. + unfold lex_exp at 1; simpl; intros. apply H15; auto with sets. Qed. diff --git a/theories/Wellfounded/Lexicographic_Product.v b/theories/Wellfounded/Lexicographic_Product.v index 0e096100..c3e8c92c 100644 --- a/theories/Wellfounded/Lexicographic_Product.v +++ b/theories/Wellfounded/Lexicographic_Product.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -27,7 +27,7 @@ Section WfLexicographic_Product. 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). + forall y:B x, Acc (leB x) y -> Acc LexProd (existT B x y). Proof. induction 1 as [x _ IHAcc]; intros H2 y. induction 1 as [x0 H IHAcc0]; intros. @@ -60,7 +60,7 @@ Section WfLexicographic_Product. well_founded leA -> (forall x:A, well_founded (leB x)) -> well_founded LexProd. Proof. - intros wfA wfB; unfold well_founded in |- *. + intros wfA wfB; unfold well_founded. destruct a. apply acc_A_B_lexprod; auto with sets; intros. red in wfB. @@ -94,7 +94,7 @@ Section Wf_Symmetric_Product. Lemma wf_symprod : well_founded leA -> well_founded leB -> well_founded Symprod. Proof. - red in |- *. + red. destruct a. apply Acc_symprod; auto with sets. Defined. @@ -161,7 +161,7 @@ Section Swap. Lemma wf_swapprod : well_founded R -> well_founded SwapProd. Proof. - red in |- *. + red. destruct a; intros. apply Acc_swapprod; auto with sets. Defined. diff --git a/theories/Wellfounded/Transitive_Closure.v b/theories/Wellfounded/Transitive_Closure.v index e9bc7ccf..943840cd 100644 --- a/theories/Wellfounded/Transitive_Closure.v +++ b/theories/Wellfounded/Transitive_Closure.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -18,7 +18,7 @@ Section Wf_Transitive_Closure. Notation trans_clos := (clos_trans A R). Lemma incl_clos_trans : inclusion A R trans_clos. - red in |- *; auto with sets. + red; auto with sets. Qed. Lemma Acc_clos_trans : forall x:A, Acc R x -> Acc trans_clos x. @@ -39,7 +39,7 @@ Section Wf_Transitive_Closure. Theorem wf_clos_trans : well_founded R -> well_founded trans_clos. Proof. - unfold well_founded in |- *; auto with sets. + unfold well_founded; auto with sets. Defined. End Wf_Transitive_Closure. diff --git a/theories/Wellfounded/Union.v b/theories/Wellfounded/Union.v index e3fdc4c5..5e4fec65 100644 --- a/theories/Wellfounded/Union.v +++ b/theories/Wellfounded/Union.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -51,7 +51,7 @@ Section WfUnion. elim strip_commut with x x0 y0; auto with sets; intros. apply Acc_inv_trans with x1; auto with sets. - unfold union in |- *. + unfold union. elim H11; auto with sets; intros. apply t_trans with y1; auto with sets. @@ -65,7 +65,7 @@ Section WfUnion. Theorem wf_union : commut A R1 R2 -> well_founded R1 -> well_founded R2 -> well_founded Union. Proof. - unfold well_founded in |- *. + unfold well_founded. intros. apply Acc_union; auto with sets. Qed. diff --git a/theories/Wellfounded/Well_Ordering.v b/theories/Wellfounded/Well_Ordering.v index fc4e2ebc..df6d9ed6 100644 --- a/theories/Wellfounded/Well_Ordering.v +++ b/theories/Wellfounded/Well_Ordering.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -25,7 +25,7 @@ Section WellOrdering. Theorem wf_WO : well_founded le_WO. Proof. - unfold well_founded in |- *; intro. + unfold well_founded; intro. apply Acc_intro. elim a. intros. @@ -37,7 +37,7 @@ Section WellOrdering. apply (H v0 y0). cut (f = f1). intros E; rewrite E; auto. - symmetry in |- *. + symmetry . apply (inj_pair2 A (fun a0:A => B a0 -> WO) a0 f1 f H5). Qed. @@ -61,7 +61,7 @@ Section Characterisation_wf_relations. apply (well_founded_induction_type H (fun a:A => WO A B)); auto. intros x H1. apply (sup A B x). - unfold B at 1 in |- *. + unfold B at 1. destruct 1 as [x0]. apply (H1 x0); auto. Qed. diff --git a/theories/Wellfounded/Wellfounded.v b/theories/Wellfounded/Wellfounded.v index 4dc4d59d..b8c6653b 100644 --- a/theories/Wellfounded/Wellfounded.v +++ b/theories/Wellfounded/Wellfounded.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/BinInt.v b/theories/ZArith/BinInt.v index 3a5eb885..eeec9042 100644 --- a/theories/ZArith/BinInt.v +++ b/theories/ZArith/BinInt.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -82,8 +82,8 @@ Lemma pos_sub_spec p q : pos_sub p q = match (p ?= q)%positive with | Eq => 0 - | Lt => Zneg (q - p) - | Gt => Zpos (p - q) + | Lt => neg (q - p) + | Gt => pos (p - q) end. Proof. revert q. induction p; destruct q; simpl; trivial; @@ -95,6 +95,18 @@ Proof. subst; unfold Pos.sub; simpl; now rewrite Pos.sub_mask_diag. Qed. +Lemma pos_sub_discr p q : + match pos_sub p q with + | Z0 => p = q + | pos k => p = q + k + | neg k => q = p + k + end%positive. +Proof. + rewrite pos_sub_spec. + case Pos.compare_spec; auto; intros; + now rewrite Pos.add_comm, Pos.sub_add. +Qed. + (** Particular cases of the previous result *) Lemma pos_sub_diag p : pos_sub p p = 0. @@ -102,12 +114,12 @@ Proof. now rewrite pos_sub_spec, Pos.compare_refl. Qed. -Lemma pos_sub_lt p q : (p < q)%positive -> pos_sub p q = Zneg (q - p). +Lemma pos_sub_lt p q : (p < q)%positive -> pos_sub p q = neg (q - p). Proof. intros H. now rewrite pos_sub_spec, H. Qed. -Lemma pos_sub_gt p q : (q < p)%positive -> pos_sub p q = Zpos (p - q). +Lemma pos_sub_gt p q : (q < p)%positive -> pos_sub p q = pos (p - q). Proof. intros H. now rewrite pos_sub_spec, Pos.compare_antisym, H. Qed. @@ -120,89 +132,6 @@ Proof. rewrite <- IHp; now destruct pos_sub. Qed. -(** * Results concerning [Zpos] and [Zneg] and the operators *) - -Lemma opp_Zneg p : - Zneg p = Zpos p. -Proof. - reflexivity. -Qed. - -Lemma opp_Zpos p : - Zpos p = Zneg p. -Proof. - reflexivity. -Qed. - -Lemma succ_Zpos p : succ (Zpos p) = Zpos (Pos.succ p). -Proof. - simpl. f_equal. apply Pos.add_1_r. -Qed. - -Lemma add_Zpos p q : Zpos p + Zpos q = Zpos (p+q). -Proof. - reflexivity. -Qed. - -Lemma add_Zneg p q : Zneg p + Zneg q = Zneg (p+q). -Proof. - reflexivity. -Qed. - -Lemma add_Zpos_Zneg p q : Zpos p + Zneg q = pos_sub p q. -Proof. - reflexivity. -Qed. - -Lemma add_Zneg_Zpos p q : Zneg p + Zpos q = pos_sub q p. -Proof. - reflexivity. -Qed. - -Lemma sub_Zpos n m : (n < m)%positive -> Zpos m - Zpos n = Zpos (m-n). -Proof. - intros H. simpl. now apply pos_sub_gt. -Qed. - -Lemma mul_Zpos (p q : positive) : Zpos p * Zpos q = Zpos (p*q). -Proof. - reflexivity. -Qed. - -Lemma pow_Zpos p q : (Zpos p)^(Zpos q) = Zpos (p^q). -Proof. - unfold Pos.pow, pow, pow_pos. - symmetry. now apply Pos.iter_swap_gen. -Qed. - -Lemma inj_Zpos p q : Zpos p = Zpos q <-> p = q. -Proof. - split; intros H. now injection H. now f_equal. -Qed. - -Lemma inj_Zneg p q : Zneg p = Zneg q <-> p = q. -Proof. - split; intros H. now injection H. now f_equal. -Qed. - -Lemma pos_xI p : Zpos p~1 = 2 * Zpos p + 1. -Proof. - reflexivity. -Qed. - -Lemma pos_xO p : Zpos p~0 = 2 * Zpos p. -Proof. - reflexivity. -Qed. - -Lemma neg_xI p : Zneg p~1 = 2 * Zneg p - 1. -Proof. - reflexivity. -Qed. - -Lemma neg_xO p : Zneg p~0 = 2 * Zneg p. -Proof. - reflexivity. -Qed. - (** In the following module, we group results that are needed now to prove specifications of operations, but will also be provided later by the generic functor of properties. *) @@ -242,7 +171,7 @@ Qed. (** ** Addition is associative *) Lemma pos_sub_add p q r : - pos_sub (p + q) r = Zpos p + pos_sub q r. + pos_sub (p + q) r = pos p + pos_sub q r. Proof. simpl. rewrite !pos_sub_spec. case (Pos.compare_spec q r); intros E0. @@ -269,19 +198,19 @@ Qed. Lemma add_assoc n m p : n + (m + p) = n + m + p. Proof. - assert (AUX : forall x y z, Zpos x + (y + z) = Zpos x + y + z). + assert (AUX : forall x y z, pos x + (y + z) = pos x + y + z). { intros x [|y|y] [|z|z]; rewrite ?add_0_r; trivial. - simpl. now rewrite Pos.add_assoc. - - simpl (_ + Zneg _). symmetry. apply pos_sub_add. - - simpl (Zneg _ + _); simpl (_ + Zneg _). - now rewrite (add_comm _ (Zpos _)), <- 2 pos_sub_add, Pos.add_comm. - - apply opp_inj. rewrite !opp_add_distr, opp_Zpos, !opp_Zneg. - simpl (Zneg _ + _); simpl (_ + Zneg _). + - simpl (_ + neg _). symmetry. apply pos_sub_add. + - simpl (neg _ + _); simpl (_ + neg _). + now rewrite (add_comm _ (pos _)), <- 2 pos_sub_add, Pos.add_comm. + - apply opp_inj. rewrite !opp_add_distr. simpl opp. + simpl (neg _ + _); simpl (_ + neg _). rewrite add_comm, Pos.add_comm. apply pos_sub_add. } destruct n. - trivial. - apply AUX. - - apply opp_inj. rewrite !opp_add_distr, opp_Zneg. apply AUX. + - apply opp_inj. rewrite !opp_add_distr. simpl opp. apply AUX. Qed. (** ** Subtraction and successor *) @@ -354,7 +283,7 @@ Qed. (** ** Distributivity of multiplication over addition *) Lemma mul_add_distr_pos (p:positive) n m : - Zpos p * (n + m) = Zpos p * n + Zpos p * m. + pos p * (n + m) = pos p * n + pos p * m. Proof. destruct n as [|n|n], m as [|m|m]; simpl; trivial; rewrite ?pos_sub_spec, ?Pos.mul_compare_mono_l; try case Pos.compare_spec; @@ -365,7 +294,8 @@ Lemma mul_add_distr_l n m p : n * (m + p) = n * m + n * p. Proof. destruct n as [|n|n]. trivial. apply mul_add_distr_pos. - rewrite <- opp_Zpos, !mul_opp_l, <- opp_add_distr. f_equal. + change (neg n) with (- pos n). + rewrite !mul_opp_l, <- opp_add_distr. f_equal. apply mul_add_distr_pos. Qed. @@ -374,6 +304,57 @@ Proof. rewrite !(mul_comm _ p). apply mul_add_distr_l. Qed. +(** ** Basic properties of divisibility *) + +Lemma divide_Zpos p q : (pos p|pos q) <-> (p|q)%positive. +Proof. + split. + intros ([ |r|r],H); simpl in *; destr_eq H. exists r; auto. + intros (r,H). exists (pos r); simpl; now f_equal. +Qed. + +Lemma divide_Zpos_Zneg_r n p : (n|pos p) <-> (n|neg p). +Proof. + split; intros (m,H); exists (-m); now rewrite mul_opp_l, <- H. +Qed. + +Lemma divide_Zpos_Zneg_l n p : (pos p|n) <-> (neg p|n). +Proof. + split; intros (m,H); exists (-m); now rewrite mul_opp_l, <- mul_opp_r. +Qed. + +(** ** Conversions between [Z.testbit] and [N.testbit] *) + +Lemma testbit_of_N a n : + testbit (of_N a) (of_N n) = N.testbit a n. +Proof. + destruct a as [|a], n; simpl; trivial. now destruct a. +Qed. + +Lemma testbit_of_N' a n : 0<=n -> + testbit (of_N a) n = N.testbit a (to_N n). +Proof. + intro Hn. rewrite <- testbit_of_N. f_equal. + destruct n; trivial; now destruct Hn. +Qed. + +Lemma testbit_Zpos a n : 0<=n -> + testbit (pos a) n = N.testbit (N.pos a) (to_N n). +Proof. + intro Hn. now rewrite <- testbit_of_N'. +Qed. + +Lemma testbit_Zneg a n : 0<=n -> + testbit (neg a) n = negb (N.testbit (Pos.pred_N a) (to_N n)). +Proof. + intro Hn. + rewrite <- testbit_of_N' by trivial. + destruct n as [ |n|n]; + [ | simpl; now destruct (Pos.pred_N a) | now destruct Hn]. + unfold testbit. + now destruct a as [|[ | | ]| ]. +Qed. + End Private_BootStrap. (** * Proofs of specifications *) @@ -454,9 +435,8 @@ Qed. Lemma eqb_eq n m : (n =? m) = true <-> n = m. Proof. - destruct n, m; simpl; try (now split). - rewrite inj_Zpos. apply Pos.eqb_eq. - rewrite inj_Zneg. apply Pos.eqb_eq. + destruct n, m; simpl; try (now split); rewrite Pos.eqb_eq; + split; (now injection 1) || (intros; now f_equal). Qed. Lemma ltb_lt n m : (n <? m) = true <-> n < m. @@ -580,7 +560,7 @@ Qed. (** For folding back a [pow_pos] into a [pow] *) -Lemma pow_pos_fold n p : pow_pos n p = n ^ (Zpos p). +Lemma pow_pos_fold n p : pow_pos n p = n ^ (pos p). Proof. reflexivity. Qed. @@ -607,7 +587,7 @@ Lemma sqrt_spec n : 0<=n -> let s := sqrt n in s*s <= n < (succ s)*(succ s). Proof. destruct n. now repeat split. unfold sqrt. - rewrite succ_Zpos. intros _. apply (Pos.sqrt_spec p). + intros _. simpl succ. rewrite Pos.add_1_r. apply (Pos.sqrt_spec p). now destruct 1. Qed. @@ -627,8 +607,10 @@ Qed. Lemma log2_spec n : 0 < n -> 2^(log2 n) <= n < 2^(succ (log2 n)). Proof. + assert (Pow : forall p q, pos (p^q) = (pos p)^(pos q)). + { intros. now apply Pos.iter_swap_gen. } destruct n as [|[p|p|]|]; intros Hn; split; try easy; unfold log2; - rewrite ?succ_Zpos, pow_Zpos. + simpl succ; rewrite ?Pos.add_1_r, <- Pow. change (2^Pos.size p <= Pos.succ (p~0))%positive. apply Pos.lt_le_incl, Pos.lt_succ_r, Pos.size_le. apply Pos.size_gt. @@ -678,20 +660,22 @@ Qed. (** ** Correctness proofs for Trunc division *) Lemma pos_div_eucl_eq a b : 0 < b -> - let (q, r) := pos_div_eucl a b in Zpos a = q * b + r. + let (q, r) := pos_div_eucl a b in pos a = q * b + r. Proof. intros Hb. induction a; unfold pos_div_eucl; fold pos_div_eucl. - (* ~1 *) destruct pos_div_eucl as (q,r). - rewrite pos_xI, IHa, mul_add_distr_l, mul_assoc. + change (pos a~1) with (2*(pos a)+1). + rewrite IHa, mul_add_distr_l, mul_assoc. destruct ltb. now rewrite add_assoc. rewrite mul_add_distr_r, mul_1_l, <- !add_assoc. f_equal. unfold sub. now rewrite (add_comm _ (-b)), add_assoc, add_opp_diag_r. - (* ~0 *) destruct pos_div_eucl as (q,r). - rewrite (pos_xO a), IHa, mul_add_distr_l, mul_assoc. + change (pos a~0) with (2*pos a). + rewrite IHa, mul_add_distr_l, mul_assoc. destruct ltb. trivial. rewrite mul_add_distr_r, mul_1_l, <- !add_assoc. f_equal. @@ -709,21 +693,23 @@ Lemma div_eucl_eq a b : b<>0 -> Proof. destruct a as [ |a|a], b as [ |b|b]; unfold div_eucl; trivial; (now destruct 1) || intros _; - generalize (pos_div_eucl_eq a (Zpos b) (eq_refl _)); - destruct pos_div_eucl as (q,r); rewrite <- ?opp_Zpos, mul_comm; - intros ->. - - (* Zpos Zpos *) + generalize (pos_div_eucl_eq a (pos b) (eq_refl _)); + destruct pos_div_eucl as (q,r); rewrite mul_comm. + - (* pos pos *) trivial. - - (* Zpos Zneg *) - destruct r as [ |r|r]; rewrite !mul_opp_opp; trivial; + - (* pos neg *) + intros ->. + destruct r as [ |r|r]; rewrite <- !mul_opp_comm; trivial; rewrite mul_add_distr_l, mul_1_r, <- add_assoc; f_equal; now rewrite add_assoc, add_opp_diag_r. - - (* Zneg Zpos *) + - (* neg pos *) + change (neg a) with (- pos a). intros ->. rewrite (opp_add_distr _ r), <- mul_opp_r. destruct r as [ |r|r]; trivial; rewrite opp_add_distr, mul_add_distr_l, <- add_assoc; f_equal; unfold sub; now rewrite add_assoc, mul_opp_r, mul_1_r, add_opp_diag_l. - - (* Zneg Zneg *) + - (* neg neg *) + change (neg a) with (- pos a). intros ->. now rewrite opp_add_distr, <- mul_opp_l. Qed. @@ -735,10 +721,10 @@ Qed. Lemma pos_div_eucl_bound a b : 0<b -> 0 <= snd (pos_div_eucl a b) < b. Proof. - assert (AUX : forall m p, m < Zpos (p~0) -> m - Zpos p < Zpos p). + assert (AUX : forall m p, m < pos (p~0) -> m - pos p < pos p). intros m p. unfold lt. - rewrite (compare_sub m), (compare_sub _ (Zpos _)). unfold sub. - rewrite <- add_assoc. simpl opp; simpl (Zneg _ + _). + rewrite (compare_sub m), (compare_sub _ (pos _)). unfold sub. + rewrite <- add_assoc. simpl opp; simpl (neg _ + _). now rewrite Pos.add_diag. intros Hb. destruct b as [|b|b]; discriminate Hb || clear Hb. @@ -770,7 +756,7 @@ Proof. destruct a as [|a|a]; unfold modulo, div_eucl. now split. now apply pos_div_eucl_bound. - generalize (pos_div_eucl_bound a (Zpos b) (eq_refl _)). + generalize (pos_div_eucl_bound a (pos b) (eq_refl _)). destruct pos_div_eucl as (q,r); unfold snd; intros (Hr,Hr'). destruct r as [|r|r]; (now destruct Hr) || clear Hr. now split. @@ -787,17 +773,17 @@ Proof. destruct b as [|b|b]; try easy; intros _. destruct a as [|a|a]; unfold modulo, div_eucl. now split. - generalize (pos_div_eucl_bound a (Zpos b) (eq_refl _)). + generalize (pos_div_eucl_bound a (pos b) (eq_refl _)). destruct pos_div_eucl as (q,r); unfold snd; intros (Hr,Hr'). destruct r as [|r|r]; (now destruct Hr) || clear Hr. now split. split. unfold lt in *; simpl in *. rewrite pos_sub_lt by trivial. rewrite <- Pos.compare_antisym. now apply Pos.sub_decr. - change (Zneg b - Zneg r <= 0). unfold le, lt in *. + change (neg b - neg r <= 0). unfold le, lt in *. rewrite <- compare_sub. simpl in *. now rewrite <- Pos.compare_antisym, Hr'. - generalize (pos_div_eucl_bound a (Zpos b) (eq_refl _)). + generalize (pos_div_eucl_bound a (pos b) (eq_refl _)). destruct pos_div_eucl as (q,r); unfold snd; intros (Hr,Hr'). split; destruct r; try easy. red; simpl; now rewrite <- Pos.compare_antisym. @@ -808,9 +794,10 @@ Qed. Theorem quotrem_eq a b : let (q,r) := quotrem a b in a = q * b + r. Proof. destruct a as [|a|a], b as [|b|b]; simpl; trivial; - generalize (N.pos_div_eucl_spec a (Npos b)); case N.pos_div_eucl; trivial; - intros q r; rewrite <- ?opp_Zpos; - change (Zpos a) with (of_N (Npos a)); intros ->; now destruct q, r. + generalize (N.pos_div_eucl_spec a (N.pos b)); case N.pos_div_eucl; trivial; + intros q r; + try change (neg a) with (-pos a); + change (pos a) with (of_N (N.pos a)); intros ->; now destruct q, r. Qed. Lemma quot_rem' a b : a = b*(a÷b) + rem a b. @@ -829,7 +816,7 @@ Proof. destruct a as [|a|a]; (now destruct Ha) || clear Ha. compute. now split. unfold rem, quotrem. - assert (H := N.pos_div_eucl_remainder a (Npos b)). + assert (H := N.pos_div_eucl_remainder a (N.pos b)). destruct N.pos_div_eucl as (q,[|r]); simpl; split; try easy. now apply H. Qed. @@ -852,25 +839,6 @@ Proof. intros _. apply rem_opp_l'. Qed. Lemma rem_opp_r a b : b<>0 -> rem a (-b) = rem a b. Proof. intros _. apply rem_opp_r'. Qed. -(** ** Basic properties of divisibility *) - -Lemma divide_Zpos p q : (Zpos p|Zpos q) <-> (p|q)%positive. -Proof. - split. - intros ([ |r|r],H); simpl in *; destr_eq H. exists r; auto. - intros (r,H). exists (Zpos r); simpl; now f_equal. -Qed. - -Lemma divide_Zpos_Zneg_r n p : (n|Zpos p) <-> (n|Zneg p). -Proof. - split; intros (m,H); exists (-m); now rewrite mul_opp_l, <- H. -Qed. - -Lemma divide_Zpos_Zneg_l n p : (Zpos p|n) <-> (Zneg p|n). -Proof. - split; intros (m,H); exists (-m); now rewrite mul_opp_l, <- mul_opp_r. -Qed. - (** ** Correctness proofs for gcd *) Lemma ggcd_gcd a b : fst (ggcd a b) = gcd a b. @@ -905,7 +873,7 @@ Qed. Lemma gcd_greatest a b c : (c|a) -> (c|b) -> (c | gcd a b). Proof. - assert (H : forall p q r, (r|Zpos p) -> (r|Zpos q) -> (r|Zpos (Pos.gcd p q))). + assert (H : forall p q r, (r|pos p) -> (r|pos q) -> (r|pos (Pos.gcd p q))). { intros p q [|r|r] H H'. destruct H; now rewrite mul_comm in *. apply divide_Zpos, Pos.gcd_greatest; now apply divide_Zpos. @@ -930,38 +898,6 @@ Proof. destruct (Pos.ggcd a b) as (g,(aa,bb)); auto. Qed. -(** ** Conversions between [Z.testbit] and [N.testbit] *) - -Lemma testbit_of_N a n : - testbit (of_N a) (of_N n) = N.testbit a n. -Proof. - destruct a as [|a], n; simpl; trivial. now destruct a. -Qed. - -Lemma testbit_of_N' a n : 0<=n -> - testbit (of_N a) n = N.testbit a (to_N n). -Proof. - intro Hn. rewrite <- testbit_of_N. f_equal. - destruct n; trivial; now destruct Hn. -Qed. - -Lemma testbit_Zpos a n : 0<=n -> - testbit (Zpos a) n = N.testbit (Npos a) (to_N n). -Proof. - intro Hn. now rewrite <- testbit_of_N'. -Qed. - -Lemma testbit_Zneg a n : 0<=n -> - testbit (Zneg a) n = negb (N.testbit (Pos.pred_N a) (to_N n)). -Proof. - intro Hn. - rewrite <- testbit_of_N' by trivial. - destruct n as [ |n|n]; - [ | simpl; now destruct (Ppred_N a) | now destruct Hn]. - unfold testbit. - now destruct a as [|[ | | ]| ]. -Qed. - (** ** Proofs of specifications for bitwise operations *) Lemma div2_spec a : div2 a = shiftr a 1. @@ -994,9 +930,9 @@ Lemma testbit_odd_succ a n : 0<=n -> Proof. destruct n as [|n|n]; (now destruct 1) || intros _. destruct a as [|[a|a|]|[a|a|]]; simpl; trivial. now destruct a. - unfold testbit. rewrite succ_Zpos. + unfold testbit; simpl. destruct a as [|a|[a|a|]]; simpl; trivial; - rewrite ?Pos.pred_N_succ; now destruct n. + rewrite ?Pos.add_1_r, ?Pos.pred_N_succ; now destruct n. Qed. Lemma testbit_even_succ a n : 0<=n -> @@ -1004,9 +940,9 @@ Lemma testbit_even_succ a n : 0<=n -> Proof. destruct n as [|n|n]; (now destruct 1) || intros _. destruct a as [|[a|a|]|[a|a|]]; simpl; trivial. now destruct a. - unfold testbit. rewrite succ_Zpos. + unfold testbit; simpl. destruct a as [|a|[a|a|]]; simpl; trivial; - rewrite ?Pos.pred_N_succ; now destruct n. + rewrite ?Pos.add_1_r, ?Pos.pred_N_succ; now destruct n. Qed. (** Correctness proofs about [Z.shiftr] and [Z.shiftl] *) @@ -1017,9 +953,9 @@ Proof. intros Hn Hm. unfold shiftr. destruct n as [ |n|n]; (now destruct Hn) || clear Hn; simpl. now rewrite add_0_r. - assert (forall p, to_N (m + Zpos p) = (to_N m + Npos p)%N). + assert (forall p, to_N (m + pos p) = (to_N m + N.pos p)%N). destruct m; trivial; now destruct Hm. - assert (forall p, 0 <= m + Zpos p). + assert (forall p, 0 <= m + pos p). destruct m; easy || now destruct Hm. destruct a as [ |a|a]. (* a = 0 *) @@ -1027,15 +963,15 @@ Proof. by (apply Pos.iter_invariant; intros; subst; trivial). now rewrite 2 testbit_0_l. (* a > 0 *) - change (Zpos a) with (of_N (Npos a)) at 1. - rewrite <- (Pos.iter_swap_gen _ _ _ Ndiv2) by now intros [|[ | | ]]. + change (pos a) with (of_N (N.pos a)) at 1. + rewrite <- (Pos.iter_swap_gen _ _ _ N.div2) by now intros [|[ | | ]]. rewrite testbit_Zpos, testbit_of_N', H; trivial. - exact (N.shiftr_spec' (Npos a) (Npos n) (to_N m)). + exact (N.shiftr_spec' (N.pos a) (N.pos n) (to_N m)). (* a < 0 *) - rewrite <- (Pos.iter_swap_gen _ _ _ Pdiv2_up) by trivial. + rewrite <- (Pos.iter_swap_gen _ _ _ Pos.div2_up) by trivial. rewrite 2 testbit_Zneg, H; trivial. f_equal. - rewrite (Pos.iter_swap_gen _ _ _ _ Ndiv2) by exact N.pred_div2_up. - exact (N.shiftr_spec' (Ppred_N a) (Npos n) (to_N m)). + rewrite (Pos.iter_swap_gen _ _ _ _ N.div2) by exact N.pred_div2_up. + exact (N.shiftr_spec' (Pos.pred_N a) (N.pos n) (to_N m)). Qed. Lemma shiftl_spec_low a n m : m<n -> @@ -1052,11 +988,11 @@ Proof. (* a > 0 *) rewrite <- (Pos.iter_swap_gen _ _ _ xO) by trivial. rewrite testbit_Zpos by easy. - exact (N.shiftl_spec_low (Npos a) (Npos n) (Npos m) H). + exact (N.shiftl_spec_low (N.pos a) (N.pos n) (N.pos m) H). (* a < 0 *) rewrite <- (Pos.iter_swap_gen _ _ _ xO) by trivial. rewrite testbit_Zneg by easy. - now rewrite (N.pos_pred_shiftl_low a (Npos n)). + now rewrite (N.pos_pred_shiftl_low a (N.pos n)). Qed. Lemma shiftl_spec_high a n m : 0<=m -> n<=m -> @@ -1066,9 +1002,9 @@ Proof. destruct n as [ |n|n]. simpl. now rewrite sub_0_r. (* n > 0 *) destruct m as [ |m|m]; try (now destruct H). - assert (0 <= Zpos m - Zpos n). + assert (0 <= pos m - pos n). red. now rewrite compare_antisym, <- compare_sub, <- compare_antisym. - assert (EQ : to_N (Zpos m - Zpos n) = (Npos m - Npos n)%N). + assert (EQ : to_N (pos m - pos n) = (N.pos m - N.pos n)%N). red in H. simpl in H. simpl to_N. rewrite pos_sub_spec, Pos.compare_antisym. destruct (Pos.compare_spec n m) as [H'|H'|H']; try (now destruct H). @@ -1083,16 +1019,16 @@ Proof. (* ... a > 0 *) rewrite <- (Pos.iter_swap_gen _ _ _ xO) by trivial. rewrite 2 testbit_Zpos, EQ by easy. - exact (N.shiftl_spec_high' (Npos p) (Npos n) (Npos m) H). + exact (N.shiftl_spec_high' (N.pos p) (N.pos n) (N.pos m) H). (* ... a < 0 *) rewrite <- (Pos.iter_swap_gen _ _ _ xO) by trivial. rewrite 2 testbit_Zneg, EQ by easy. f_equal. simpl to_N. rewrite <- N.shiftl_spec_high by easy. - now apply (N.pos_pred_shiftl_high p (Npos n)). + now apply (N.pos_pred_shiftl_high p (N.pos n)). (* n < 0 *) unfold sub. simpl. - now apply (shiftr_spec_aux a (Zpos n) m). + now apply (shiftr_spec_aux a (pos n) m). Qed. Lemma shiftr_spec a n m : 0<=m -> @@ -1180,11 +1116,11 @@ Proof. induction p using Pos.peano_ind. now apply (Hs 0). rewrite <- Pos.add_1_r. - now apply (Hs (Zpos p)). + now apply (Hs (pos p)). induction p using Pos.peano_ind. now apply (Hp 0). rewrite <- Pos.add_1_r. - now apply (Hp (Zneg p)). + now apply (Hp (neg p)). Qed. Lemma bi_induction (P : Z -> Prop) : @@ -1217,11 +1153,11 @@ Program Definition rem_wd : Proper (eq==>eq==>eq) rem := _. Program Definition pow_wd : Proper (eq==>eq==>eq) pow := _. Program Definition testbit_wd : Proper (eq==>eq==>Logic.eq) testbit := _. -Include ZProp - <+ UsualMinMaxLogicalProperties <+ UsualMinMaxDecProperties. +(** The Bind Scope prevents Z to stay associated with abstract_scope. + (TODO FIX) *) -(** Otherwise Z stays associated with abstract_scope : (TODO FIX) *) -Bind Scope Z_scope with Z. +Include ZProp. Bind Scope Z_scope with Z. +Include UsualMinMaxLogicalProperties <+ UsualMinMaxDecProperties. (** In generic statements, the predicates [lt] and [le] have been favored, whereas [gt] and [ge] don't even exist in the abstract @@ -1341,7 +1277,7 @@ Qed. End Z. -(** Export Notations *) +(** Re-export Notations *) Infix "+" := Z.add : Z_scope. Notation "- x" := (Z.opp x) : Z_scope. @@ -1351,111 +1287,362 @@ Infix "^" := Z.pow : Z_scope. Infix "/" := Z.div : Z_scope. Infix "mod" := Z.modulo (at level 40, no associativity) : Z_scope. Infix "÷" := Z.quot (at level 40, left associativity) : Z_scope. - -(* TODO : transition from Zdivide *) -Notation "( x | y )" := (Z.divide x y) (at level 0). - Infix "?=" := Z.compare (at level 70, no associativity) : Z_scope. - +Infix "=?" := Z.eqb (at level 70, no associativity) : Z_scope. +Infix "<=?" := Z.leb (at level 70, no associativity) : Z_scope. +Infix "<?" := Z.ltb (at level 70, no associativity) : Z_scope. +Infix ">=?" := Z.geb (at level 70, no associativity) : Z_scope. +Infix ">?" := Z.gtb (at level 70, no associativity) : Z_scope. +Notation "( x | y )" := (Z.divide x y) (at level 0) : Z_scope. Infix "<=" := Z.le : Z_scope. Infix "<" := Z.lt : Z_scope. Infix ">=" := Z.ge : Z_scope. Infix ">" := Z.gt : Z_scope. - Notation "x <= y <= z" := (x <= y /\ y <= z) : Z_scope. Notation "x <= y < z" := (x <= y /\ y < z) : Z_scope. Notation "x < y < z" := (x < y /\ y < z) : Z_scope. Notation "x < y <= z" := (x < y /\ y <= z) : Z_scope. -Infix "=?" := Z.eqb (at level 70, no associativity) : Z_scope. -Infix "<=?" := Z.leb (at level 70, no associativity) : Z_scope. -Infix "<?" := Z.ltb (at level 70, no associativity) : Z_scope. -Infix ">=?" := Z.geb (at level 70, no associativity) : Z_scope. -Infix ">?" := Z.gtb (at level 70, no associativity) : Z_scope. +(** Conversions from / to positive numbers *) + +Module Pos2Z. + +Lemma id p : Z.to_pos (Z.pos p) = p. +Proof. reflexivity. Qed. + +Lemma inj p q : Z.pos p = Z.pos q -> p = q. +Proof. now injection 1. Qed. + +Lemma inj_iff p q : Z.pos p = Z.pos q <-> p = q. +Proof. split. apply inj. intros; now f_equal. Qed. + +Lemma is_pos p : 0 < Z.pos p. +Proof. reflexivity. Qed. + +Lemma is_nonneg p : 0 <= Z.pos p. +Proof. easy. Qed. + +Lemma inj_1 : Z.pos 1 = 1. +Proof. reflexivity. Qed. + +Lemma inj_xO p : Z.pos p~0 = 2 * Z.pos p. +Proof. reflexivity. Qed. + +Lemma inj_xI p : Z.pos p~1 = 2 * Z.pos p + 1. +Proof. reflexivity. Qed. + +Lemma inj_succ p : Z.pos (Pos.succ p) = Z.succ (Z.pos p). +Proof. simpl. now rewrite Pos.add_1_r. Qed. + +Lemma inj_add p q : Z.pos (p+q) = Z.pos p + Z.pos q. +Proof. reflexivity. Qed. + +Lemma inj_sub p q : (p < q)%positive -> + Z.pos (q-p) = Z.pos q - Z.pos p. +Proof. intros. simpl. now rewrite Z.pos_sub_gt. Qed. + +Lemma inj_sub_max p q : Z.pos (p - q) = Z.max 1 (Z.pos p - Z.pos q). +Proof. + simpl. rewrite Z.pos_sub_spec. case Pos.compare_spec; intros. + - subst; now rewrite Pos.sub_diag. + - now rewrite Pos.sub_lt. + - now destruct (p-q)%positive. +Qed. + +Lemma inj_pred p : p <> 1%positive -> + Z.pos (Pos.pred p) = Z.pred (Z.pos p). +Proof. destruct p; easy || now destruct 1. Qed. + +Lemma inj_mul p q : Z.pos (p*q) = Z.pos p * Z.pos q. +Proof. reflexivity. Qed. + +Lemma inj_pow_pos p q : Z.pos (p^q) = Z.pow_pos (Z.pos p) q. +Proof. now apply Pos.iter_swap_gen. Qed. + +Lemma inj_pow p q : Z.pos (p^q) = (Z.pos p)^(Z.pos q). +Proof. apply inj_pow_pos. Qed. + +Lemma inj_square p : Z.pos (Pos.square p) = Z.square (Z.pos p). +Proof. reflexivity. Qed. + +Lemma inj_compare p q : (p ?= q)%positive = (Z.pos p ?= Z.pos q). +Proof. reflexivity. Qed. + +Lemma inj_leb p q : (p <=? q)%positive = (Z.pos p <=? Z.pos q). +Proof. reflexivity. Qed. + +Lemma inj_ltb p q : (p <? q)%positive = (Z.pos p <? Z.pos q). +Proof. reflexivity. Qed. + +Lemma inj_eqb p q : (p =? q)%positive = (Z.pos p =? Z.pos q). +Proof. reflexivity. Qed. + +Lemma inj_max p q : Z.pos (Pos.max p q) = Z.max (Z.pos p) (Z.pos q). +Proof. + unfold Z.max, Pos.max. rewrite inj_compare. now case Z.compare_spec. +Qed. + +Lemma inj_min p q : Z.pos (Pos.min p q) = Z.min (Z.pos p) (Z.pos q). +Proof. + unfold Z.min, Pos.min. rewrite inj_compare. now case Z.compare_spec. +Qed. + +Lemma inj_sqrt p : Z.pos (Pos.sqrt p) = Z.sqrt (Z.pos p). +Proof. reflexivity. Qed. + +Lemma inj_gcd p q : Z.pos (Pos.gcd p q) = Z.gcd (Z.pos p) (Z.pos q). +Proof. reflexivity. Qed. + +Definition inj_divide p q : (Z.pos p|Z.pos q) <-> (p|q)%positive. +Proof. apply Z.Private_BootStrap.divide_Zpos. Qed. + +Lemma inj_testbit a n : 0<=n -> + Z.testbit (Z.pos a) n = N.testbit (N.pos a) (Z.to_N n). +Proof. apply Z.Private_BootStrap.testbit_Zpos. Qed. + +(** Some results concerning Z.neg *) + +Lemma inj_neg p q : Z.neg p = Z.neg q -> p = q. +Proof. now injection 1. Qed. + +Lemma inj_neg_iff p q : Z.neg p = Z.neg q <-> p = q. +Proof. split. apply inj_neg. intros; now f_equal. Qed. + +Lemma neg_is_neg p : Z.neg p < 0. +Proof. reflexivity. Qed. + +Lemma neg_is_nonpos p : Z.neg p <= 0. +Proof. easy. Qed. + +Lemma neg_xO p : Z.neg p~0 = 2 * Z.neg p. +Proof. reflexivity. Qed. + +Lemma neg_xI p : Z.neg p~1 = 2 * Z.neg p - 1. +Proof. reflexivity. Qed. + +Lemma opp_neg p : - Z.neg p = Z.pos p. +Proof. reflexivity. Qed. + +Lemma opp_pos p : - Z.pos p = Z.neg p. +Proof. reflexivity. Qed. + +Lemma add_neg_neg p q : Z.neg p + Z.neg q = Z.neg (p+q). +Proof. reflexivity. Qed. + +Lemma add_pos_neg p q : Z.pos p + Z.neg q = Z.pos_sub p q. +Proof. reflexivity. Qed. + +Lemma add_neg_pos p q : Z.neg p + Z.pos q = Z.pos_sub q p. +Proof. reflexivity. Qed. + +Lemma divide_pos_neg_r n p : (n|Z.pos p) <-> (n|Z.neg p). +Proof. apply Z.Private_BootStrap.divide_Zpos_Zneg_r. Qed. + +Lemma divide_pos_neg_l n p : (Z.pos p|n) <-> (Z.neg p|n). +Proof. apply Z.Private_BootStrap.divide_Zpos_Zneg_l. Qed. + +Lemma testbit_neg a n : 0<=n -> + Z.testbit (Z.neg a) n = negb (N.testbit (Pos.pred_N a) (Z.to_N n)). +Proof. apply Z.Private_BootStrap.testbit_Zneg. Qed. + +End Pos2Z. + +Module Z2Pos. + +Lemma id x : 0 < x -> Z.pos (Z.to_pos x) = x. +Proof. now destruct x. Qed. + +Lemma inj x y : 0 < x -> 0 < y -> Z.to_pos x = Z.to_pos y -> x = y. +Proof. + destruct x; simpl; try easy. intros _ H ->. now apply id. +Qed. + +Lemma inj_iff x y : 0 < x -> 0 < y -> (Z.to_pos x = Z.to_pos y <-> x = y). +Proof. split. now apply inj. intros; now f_equal. Qed. + +Lemma to_pos_nonpos x : x <= 0 -> Z.to_pos x = 1%positive. +Proof. destruct x; trivial. now destruct 1. Qed. + +Lemma inj_1 : Z.to_pos 1 = 1%positive. +Proof. reflexivity. Qed. + +Lemma inj_double x : 0 < x -> + Z.to_pos (Z.double x) = (Z.to_pos x)~0%positive. +Proof. now destruct x. Qed. + +Lemma inj_succ_double x : 0 < x -> + Z.to_pos (Z.succ_double x) = (Z.to_pos x)~1%positive. +Proof. now destruct x. Qed. + +Lemma inj_succ x : 0 < x -> Z.to_pos (Z.succ x) = Pos.succ (Z.to_pos x). +Proof. + destruct x; try easy. simpl. now rewrite Pos.add_1_r. +Qed. + +Lemma inj_add x y : 0 < x -> 0 < y -> + Z.to_pos (x+y) = (Z.to_pos x + Z.to_pos y)%positive. +Proof. destruct x; easy || now destruct y. Qed. + +Lemma inj_sub x y : 0 < x < y -> + Z.to_pos (y-x) = (Z.to_pos y - Z.to_pos x)%positive. +Proof. + destruct x; try easy. destruct y; try easy. simpl. + intros. now rewrite Z.pos_sub_gt. +Qed. + +Lemma inj_pred x : 1 < x -> Z.to_pos (Z.pred x) = Pos.pred (Z.to_pos x). +Proof. now destruct x as [|[x|x|]|]. Qed. + +Lemma inj_mul x y : 0 < x -> 0 < y -> + Z.to_pos (x*y) = (Z.to_pos x * Z.to_pos y)%positive. +Proof. destruct x; easy || now destruct y. Qed. + +Lemma inj_pow x y : 0 < x -> 0 < y -> + Z.to_pos (x^y) = (Z.to_pos x ^ Z.to_pos y)%positive. +Proof. + intros. apply Pos2Z.inj. rewrite Pos2Z.inj_pow, !id; trivial. + apply Z.pow_pos_nonneg. trivial. now apply Z.lt_le_incl. +Qed. + +Lemma inj_pow_pos x p : 0 < x -> + Z.to_pos (Z.pow_pos x p) = ((Z.to_pos x)^p)%positive. +Proof. intros. now apply (inj_pow x (Z.pos p)). Qed. + +Lemma inj_compare x y : 0 < x -> 0 < y -> + (x ?= y) = (Z.to_pos x ?= Z.to_pos y)%positive. +Proof. destruct x; easy || now destruct y. Qed. + +Lemma inj_leb x y : 0 < x -> 0 < y -> + (x <=? y) = (Z.to_pos x <=? Z.to_pos y)%positive. +Proof. destruct x; easy || now destruct y. Qed. + +Lemma inj_ltb x y : 0 < x -> 0 < y -> + (x <? y) = (Z.to_pos x <? Z.to_pos y)%positive. +Proof. destruct x; easy || now destruct y. Qed. + +Lemma inj_eqb x y : 0 < x -> 0 < y -> + (x =? y) = (Z.to_pos x =? Z.to_pos y)%positive. +Proof. destruct x; easy || now destruct y. Qed. + +Lemma inj_max x y : + Z.to_pos (Z.max x y) = Pos.max (Z.to_pos x) (Z.to_pos y). +Proof. + destruct x; simpl; try rewrite Pos.max_1_l. + - now destruct y. + - destruct y; simpl; now rewrite ?Pos.max_1_r, <- ?Pos2Z.inj_max. + - destruct y; simpl; rewrite ?Pos.max_1_r; trivial. + apply to_pos_nonpos. now apply Z.max_lub. +Qed. + +Lemma inj_min x y : + Z.to_pos (Z.min x y) = Pos.min (Z.to_pos x) (Z.to_pos y). +Proof. + destruct x; simpl; try rewrite Pos.min_1_l. + - now destruct y. + - destruct y; simpl; now rewrite ?Pos.min_1_r, <- ?Pos2Z.inj_min. + - destruct y; simpl; rewrite ?Pos.min_1_r; trivial. + apply to_pos_nonpos. apply Z.min_le_iff. now left. +Qed. + +Lemma inj_sqrt x : Z.to_pos (Z.sqrt x) = Pos.sqrt (Z.to_pos x). +Proof. now destruct x. Qed. + +Lemma inj_gcd x y : 0 < x -> 0 < y -> + Z.to_pos (Z.gcd x y) = Pos.gcd (Z.to_pos x) (Z.to_pos y). +Proof. destruct x; easy || now destruct y. Qed. + +End Z2Pos. (** Compatibility Notations *) -Notation Zdouble_plus_one := Z.succ_double (only parsing). -Notation Zdouble_minus_one := Z.pred_double (only parsing). -Notation Zdouble := Z.double (only parsing). -Notation ZPminus := Z.pos_sub (only parsing). -Notation Zsucc' := Z.succ (only parsing). -Notation Zpred' := Z.pred (only parsing). -Notation Zplus' := Z.add (only parsing). -Notation Zplus := Z.add (only parsing). (* Slightly incompatible *) -Notation Zopp := Z.opp (only parsing). -Notation Zsucc := Z.succ (only parsing). -Notation Zpred := Z.pred (only parsing). -Notation Zminus := Z.sub (only parsing). -Notation Zmult := Z.mul (only parsing). -Notation Zcompare := Z.compare (only parsing). -Notation Zsgn := Z.sgn (only parsing). -Notation Zle := Z.le (only parsing). -Notation Zge := Z.ge (only parsing). -Notation Zlt := Z.lt (only parsing). -Notation Zgt := Z.gt (only parsing). -Notation Zmax := Z.max (only parsing). -Notation Zmin := Z.min (only parsing). -Notation Zabs := Z.abs (only parsing). -Notation Zabs_nat := Z.abs_nat (only parsing). -Notation Zabs_N := Z.abs_N (only parsing). -Notation Z_of_nat := Z.of_nat (only parsing). -Notation Z_of_N := Z.of_N (only parsing). - -Notation Zind := Z.peano_ind (only parsing). -Notation Zopp_0 := Z.opp_0 (only parsing). -Notation Zopp_neg := Z.opp_Zneg (only parsing). -Notation Zopp_involutive := Z.opp_involutive (only parsing). -Notation Zopp_inj := Z.opp_inj (only parsing). -Notation Zplus_0_l := Z.add_0_l (only parsing). -Notation Zplus_0_r := Z.add_0_r (only parsing). -Notation Zplus_comm := Z.add_comm (only parsing). -Notation Zopp_plus_distr := Z.opp_add_distr (only parsing). -Notation Zopp_succ := Z.opp_succ (only parsing). -Notation Zplus_opp_r := Z.add_opp_diag_r (only parsing). -Notation Zplus_opp_l := Z.add_opp_diag_l (only parsing). -Notation Zplus_assoc := Z.add_assoc (only parsing). -Notation Zplus_permute := Z.add_shuffle3 (only parsing). -Notation Zplus_reg_l := Z.add_reg_l (only parsing). -Notation Zplus_succ_l := Z.add_succ_l (only parsing). -Notation Zplus_succ_comm := Z.add_succ_comm (only parsing). -Notation Zsucc_discr := Z.neq_succ_diag_r (only parsing). -Notation Zsucc_inj := Z.succ_inj (only parsing). -Notation Zsucc'_inj := Z.succ_inj (only parsing). -Notation Zsucc'_pred' := Z.succ_pred (only parsing). -Notation Zpred'_succ' := Z.pred_succ (only parsing). -Notation Zpred'_inj := Z.pred_inj (only parsing). -Notation Zsucc'_discr := Z.neq_succ_diag_r (only parsing). -Notation Zminus_0_r := Z.sub_0_r (only parsing). -Notation Zminus_diag := Z.sub_diag (only parsing). -Notation Zminus_plus_distr := Z.sub_add_distr (only parsing). -Notation Zminus_succ_r := Z.sub_succ_r (only parsing). -Notation Zminus_plus := Z.add_simpl_l (only parsing). -Notation Zmult_0_l := Z.mul_0_l (only parsing). -Notation Zmult_0_r := Z.mul_0_r (only parsing). -Notation Zmult_1_l := Z.mul_1_l (only parsing). -Notation Zmult_1_r := Z.mul_1_r (only parsing). -Notation Zmult_comm := Z.mul_comm (only parsing). -Notation Zmult_assoc := Z.mul_assoc (only parsing). -Notation Zmult_permute := Z.mul_shuffle3 (only parsing). -Notation Zmult_1_inversion_l := Z.mul_eq_1 (only parsing). -Notation Zdouble_mult := Z.double_spec (only parsing). -Notation Zdouble_plus_one_mult := Z.succ_double_spec (only parsing). -Notation Zopp_mult_distr_l_reverse := Z.mul_opp_l (only parsing). -Notation Zmult_opp_opp := Z.mul_opp_opp (only parsing). -Notation Zmult_opp_comm := Z.mul_opp_comm (only parsing). -Notation Zopp_eq_mult_neg_1 := Z.opp_eq_mul_m1 (only parsing). -Notation Zmult_plus_distr_r := Z.mul_add_distr_l (only parsing). -Notation Zmult_plus_distr_l := Z.mul_add_distr_r (only parsing). -Notation Zmult_minus_distr_r := Z.mul_sub_distr_r (only parsing). -Notation Zmult_reg_l := Z.mul_reg_l (only parsing). -Notation Zmult_reg_r := Z.mul_reg_r (only parsing). -Notation Zmult_succ_l := Z.mul_succ_l (only parsing). -Notation Zmult_succ_r := Z.mul_succ_r (only parsing). -Notation Zpos_xI := Z.pos_xI (only parsing). -Notation Zpos_xO := Z.pos_xO (only parsing). -Notation Zneg_xI := Z.neg_xI (only parsing). -Notation Zneg_xO := Z.neg_xO (only parsing). +Notation Zdouble_plus_one := Z.succ_double (compat "8.3"). +Notation Zdouble_minus_one := Z.pred_double (compat "8.3"). +Notation Zdouble := Z.double (compat "8.3"). +Notation ZPminus := Z.pos_sub (compat "8.3"). +Notation Zsucc' := Z.succ (compat "8.3"). +Notation Zpred' := Z.pred (compat "8.3"). +Notation Zplus' := Z.add (compat "8.3"). +Notation Zplus := Z.add (compat "8.3"). (* Slightly incompatible *) +Notation Zopp := Z.opp (compat "8.3"). +Notation Zsucc := Z.succ (compat "8.3"). +Notation Zpred := Z.pred (compat "8.3"). +Notation Zminus := Z.sub (compat "8.3"). +Notation Zmult := Z.mul (compat "8.3"). +Notation Zcompare := Z.compare (compat "8.3"). +Notation Zsgn := Z.sgn (compat "8.3"). +Notation Zle := Z.le (compat "8.3"). +Notation Zge := Z.ge (compat "8.3"). +Notation Zlt := Z.lt (compat "8.3"). +Notation Zgt := Z.gt (compat "8.3"). +Notation Zmax := Z.max (compat "8.3"). +Notation Zmin := Z.min (compat "8.3"). +Notation Zabs := Z.abs (compat "8.3"). +Notation Zabs_nat := Z.abs_nat (compat "8.3"). +Notation Zabs_N := Z.abs_N (compat "8.3"). +Notation Z_of_nat := Z.of_nat (compat "8.3"). +Notation Z_of_N := Z.of_N (compat "8.3"). + +Notation Zind := Z.peano_ind (compat "8.3"). +Notation Zopp_0 := Z.opp_0 (compat "8.3"). +Notation Zopp_involutive := Z.opp_involutive (compat "8.3"). +Notation Zopp_inj := Z.opp_inj (compat "8.3"). +Notation Zplus_0_l := Z.add_0_l (compat "8.3"). +Notation Zplus_0_r := Z.add_0_r (compat "8.3"). +Notation Zplus_comm := Z.add_comm (compat "8.3"). +Notation Zopp_plus_distr := Z.opp_add_distr (compat "8.3"). +Notation Zopp_succ := Z.opp_succ (compat "8.3"). +Notation Zplus_opp_r := Z.add_opp_diag_r (compat "8.3"). +Notation Zplus_opp_l := Z.add_opp_diag_l (compat "8.3"). +Notation Zplus_assoc := Z.add_assoc (compat "8.3"). +Notation Zplus_permute := Z.add_shuffle3 (compat "8.3"). +Notation Zplus_reg_l := Z.add_reg_l (compat "8.3"). +Notation Zplus_succ_l := Z.add_succ_l (compat "8.3"). +Notation Zplus_succ_comm := Z.add_succ_comm (compat "8.3"). +Notation Zsucc_discr := Z.neq_succ_diag_r (compat "8.3"). +Notation Zsucc_inj := Z.succ_inj (compat "8.3"). +Notation Zsucc'_inj := Z.succ_inj (compat "8.3"). +Notation Zsucc'_pred' := Z.succ_pred (compat "8.3"). +Notation Zpred'_succ' := Z.pred_succ (compat "8.3"). +Notation Zpred'_inj := Z.pred_inj (compat "8.3"). +Notation Zsucc'_discr := Z.neq_succ_diag_r (compat "8.3"). +Notation Zminus_0_r := Z.sub_0_r (compat "8.3"). +Notation Zminus_diag := Z.sub_diag (compat "8.3"). +Notation Zminus_plus_distr := Z.sub_add_distr (compat "8.3"). +Notation Zminus_succ_r := Z.sub_succ_r (compat "8.3"). +Notation Zminus_plus := Z.add_simpl_l (compat "8.3"). +Notation Zmult_0_l := Z.mul_0_l (compat "8.3"). +Notation Zmult_0_r := Z.mul_0_r (compat "8.3"). +Notation Zmult_1_l := Z.mul_1_l (compat "8.3"). +Notation Zmult_1_r := Z.mul_1_r (compat "8.3"). +Notation Zmult_comm := Z.mul_comm (compat "8.3"). +Notation Zmult_assoc := Z.mul_assoc (compat "8.3"). +Notation Zmult_permute := Z.mul_shuffle3 (compat "8.3"). +Notation Zmult_1_inversion_l := Z.mul_eq_1 (compat "8.3"). +Notation Zdouble_mult := Z.double_spec (compat "8.3"). +Notation Zdouble_plus_one_mult := Z.succ_double_spec (compat "8.3"). +Notation Zopp_mult_distr_l_reverse := Z.mul_opp_l (compat "8.3"). +Notation Zmult_opp_opp := Z.mul_opp_opp (compat "8.3"). +Notation Zmult_opp_comm := Z.mul_opp_comm (compat "8.3"). +Notation Zopp_eq_mult_neg_1 := Z.opp_eq_mul_m1 (compat "8.3"). +Notation Zmult_plus_distr_r := Z.mul_add_distr_l (compat "8.3"). +Notation Zmult_plus_distr_l := Z.mul_add_distr_r (compat "8.3"). +Notation Zmult_minus_distr_r := Z.mul_sub_distr_r (compat "8.3"). +Notation Zmult_reg_l := Z.mul_reg_l (compat "8.3"). +Notation Zmult_reg_r := Z.mul_reg_r (compat "8.3"). +Notation Zmult_succ_l := Z.mul_succ_l (compat "8.3"). +Notation Zmult_succ_r := Z.mul_succ_r (compat "8.3"). + +Notation Zpos_xI := Pos2Z.inj_xI (compat "8.3"). +Notation Zpos_xO := Pos2Z.inj_xO (compat "8.3"). +Notation Zneg_xI := Pos2Z.neg_xI (compat "8.3"). +Notation Zneg_xO := Pos2Z.neg_xO (compat "8.3"). +Notation Zopp_neg := Pos2Z.opp_neg (compat "8.3"). +Notation Zpos_succ_morphism := Pos2Z.inj_succ (compat "8.3"). +Notation Zpos_mult_morphism := Pos2Z.inj_mul (compat "8.3"). +Notation Zpos_minus_morphism := Pos2Z.inj_sub (compat "8.3"). +Notation Zpos_eq_rev := Pos2Z.inj (compat "8.3"). +Notation Zpos_plus_distr := Pos2Z.inj_add (compat "8.3"). +Notation Zneg_plus_distr := Pos2Z.add_neg_neg (compat "8.3"). Notation Z := Z (only parsing). Notation Z_rect := Z_rect (only parsing). @@ -1482,8 +1669,6 @@ Lemma Zplus_0_r_reverse : forall n, n = n + 0. Proof (SYM1 Z.add_0_r). Lemma Zplus_eq_compat : forall n m p q, n=m -> p=q -> n+p=m+q. Proof (f_equal2 Z.add). -Lemma Zpos_succ_morphism : forall p, Zpos (Psucc p) = Zsucc (Zpos p). -Proof (SYM1 Z.succ_Zpos). Lemma Zsucc_pred : forall n, n = Z.succ (Z.pred n). Proof (SYM1 Z.succ_pred). Lemma Zpred_succ : forall n, n = Z.pred (Z.succ n). @@ -1506,15 +1691,10 @@ Lemma Zminus_plus_simpl_l_reverse : forall n m p, n - m = p + n - (p + m). Proof (SYM3 Zminus_plus_simpl_l). Lemma Zminus_plus_simpl_r : forall n m p, n + p - (m + p) = n - m. Proof (fun n m p => Z.add_add_simpl_r_r n p m). -Lemma Zpos_minus_morphism : forall a b, - Pcompare a b Eq = Lt -> Zpos (b - a) = Zpos b - Zpos a. -Proof. intros. now rewrite Z.sub_Zpos. Qed. Lemma Zeq_minus : forall n m, n = m -> n - m = 0. Proof (fun n m => proj2 (Z.sub_move_0_r n m)). Lemma Zminus_eq : forall n m, n - m = 0 -> n = m. Proof (fun n m => proj1 (Z.sub_move_0_r n m)). -Lemma Zpos_mult_morphism : forall p q, Zpos (p * q) = Zpos p * Zpos q. -Proof (SYM2 Z.mul_Zpos). Lemma Zmult_0_r_reverse : forall n, 0 = n * 0. Proof (SYM1 Z.mul_0_r). Lemma Zmult_assoc_reverse : forall n m p, n * m * p = n * (m * p). @@ -1529,20 +1709,14 @@ Lemma Zopp_mult_distr_r : forall n m, - (n * m) = n * - m. Proof (SYM2 Z.mul_opp_r). Lemma Zmult_minus_distr_l : forall n m p, p * (n - m) = p * n - p * m. Proof (fun n m p => Z.mul_sub_distr_l p n m). -Lemma Zmult_succ_r_reverse : forall n m, n * m + n = n * Zsucc m. +Lemma Zmult_succ_r_reverse : forall n m, n * m + n = n * Z.succ m. Proof (SYM2 Z.mul_succ_r). -Lemma Zmult_succ_l_reverse : forall n m, n * m + m = Zsucc n * m. +Lemma Zmult_succ_l_reverse : forall n m, n * m + m = Z.succ n * m. Proof (SYM2 Z.mul_succ_l). -Lemma Zpos_eq : forall p q, p = q -> Zpos p = Zpos q. -Proof (fun p q => proj2 (Z.inj_Zpos p q)). -Lemma Zpos_eq_rev : forall p q, Zpos p = Zpos q -> p = q. -Proof (fun p q => proj1 (Z.inj_Zpos p q)). -Lemma Zpos_eq_iff : forall p q, p = q <-> Zpos p = Zpos q. -Proof (fun p q => iff_sym (Z.inj_Zpos p q)). -Lemma Zpos_plus_distr : forall p q, Zpos (p + q) = Zpos p + Zpos q. -Proof (SYM2 Z.add_Zpos). -Lemma Zneg_plus_distr : forall p q, Zneg (p + q) = Zneg p + Zneg q. -Proof (SYM2 Z.add_Zneg). +Lemma Zpos_eq : forall p q, p = q -> Z.pos p = Z.pos q. +Proof. congruence. Qed. +Lemma Zpos_eq_iff : forall p q, p = q <-> Z.pos p = Z.pos q. +Proof (fun p q => iff_sym (Pos2Z.inj_iff p q)). Hint Immediate Zsucc_pred: zarith. diff --git a/theories/ZArith/BinIntDef.v b/theories/ZArith/BinIntDef.v index d96d20fb..958ce2ef 100644 --- a/theories/ZArith/BinIntDef.v +++ b/theories/ZArith/BinIntDef.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -22,6 +22,11 @@ Module Z. Definition t := Z. +(** ** Nicer names [Z.pos] and [Z.neg] for contructors *) + +Notation pos := Zpos. +Notation neg := Zneg. + (** ** Constants *) Definition zero := 0. @@ -33,22 +38,22 @@ Definition two := 2. Definition double x := match x with | 0 => 0 - | Zpos p => Zpos p~0 - | Zneg p => Zneg p~0 + | pos p => pos p~0 + | neg p => neg p~0 end. Definition succ_double x := match x with | 0 => 1 - | Zpos p => Zpos p~1 - | Zneg p => Zneg (Pos.pred_double p) + | pos p => pos p~1 + | neg p => neg (Pos.pred_double p) end. Definition pred_double x := match x with | 0 => -1 - | Zneg p => Zneg p~1 - | Zpos p => Zpos (Pos.pred_double p) + | neg p => neg p~1 + | pos p => pos (Pos.pred_double p) end. (** ** Subtraction of positive into Z *) @@ -57,12 +62,12 @@ Fixpoint pos_sub (x y:positive) {struct y} : Z := match x, y with | p~1, q~1 => double (pos_sub p q) | p~1, q~0 => succ_double (pos_sub p q) - | p~1, 1 => Zpos p~0 + | p~1, 1 => pos p~0 | p~0, q~1 => pred_double (pos_sub p q) | p~0, q~0 => double (pos_sub p q) - | p~0, 1 => Zpos (Pos.pred_double p) - | 1, q~1 => Zneg q~0 - | 1, q~0 => Zneg (Pos.pred_double q) + | p~0, 1 => pos (Pos.pred_double p) + | 1, q~1 => neg q~0 + | 1, q~0 => neg (Pos.pred_double q) | 1, 1 => Z0 end%positive. @@ -72,10 +77,10 @@ Definition add x y := match x, y with | 0, y => y | x, 0 => x - | Zpos x', Zpos y' => Zpos (x' + y') - | Zpos x', Zneg y' => pos_sub x' y' - | Zneg x', Zpos y' => pos_sub y' x' - | Zneg x', Zneg y' => Zneg (x' + y') + | pos x', pos y' => pos (x' + y') + | pos x', neg y' => pos_sub x' y' + | neg x', pos y' => pos_sub y' x' + | neg x', neg y' => neg (x' + y') end. Infix "+" := add : Z_scope. @@ -85,8 +90,8 @@ Infix "+" := add : Z_scope. Definition opp x := match x with | 0 => 0 - | Zpos x => Zneg x - | Zneg x => Zpos x + | pos x => neg x + | neg x => pos x end. Notation "- x" := (opp x) : Z_scope. @@ -111,10 +116,10 @@ Definition mul x y := match x, y with | 0, _ => 0 | _, 0 => 0 - | 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') + | pos x', pos y' => pos (x' * y') + | pos x', neg y' => neg (x' * y') + | neg x', pos y' => neg (x' * y') + | neg x', neg y' => pos (x' * y') end. Infix "*" := mul : Z_scope. @@ -125,9 +130,9 @@ Definition pow_pos (z:Z) (n:positive) := Pos.iter n (mul z) 1. Definition pow x y := match y with - | Zpos p => pow_pos x p + | pos p => pow_pos x p | 0 => 1 - | Zneg _ => 0 + | neg _ => 0 end. Infix "^" := pow : Z_scope. @@ -137,8 +142,8 @@ Infix "^" := pow : Z_scope. Definition square x := match x with | 0 => 0 - | Zpos p => Zpos (Pos.square p) - | Zneg p => Zpos (Pos.square p) + | pos p => pos (Pos.square p) + | neg p => pos (Pos.square p) end. (** ** Comparison *) @@ -146,14 +151,14 @@ Definition square x := Definition compare x y := match x, y with | 0, 0 => Eq - | 0, Zpos y' => Lt - | 0, Zneg y' => Gt - | Zpos x', 0 => Gt - | Zpos x', Zpos y' => (x' ?= y')%positive - | Zpos x', Zneg y' => Gt - | Zneg x', 0 => Lt - | Zneg x', Zpos y' => Lt - | Zneg x', Zneg y' => CompOpp ((x' ?= y')%positive) + | 0, pos y' => Lt + | 0, neg y' => Gt + | pos x', 0 => Gt + | pos x', pos y' => (x' ?= y')%positive + | pos x', neg y' => Gt + | neg x', 0 => Lt + | neg x', pos y' => Lt + | neg x', neg y' => CompOpp ((x' ?= y')%positive) end. Infix "?=" := compare (at level 70, no associativity) : Z_scope. @@ -163,8 +168,8 @@ Infix "?=" := compare (at level 70, no associativity) : Z_scope. Definition sgn z := match z with | 0 => 0 - | Zpos p => 1 - | Zneg p => -1 + | pos p => 1 + | neg p => -1 end. (** Boolean equality and comparisons *) @@ -183,7 +188,7 @@ Definition ltb x y := (** Nota: [geb] and [gtb] are provided for compatibility, but [leb] and [ltb] should rather be used instead, since - more results we be available on them. *) + more results will be available on them. *) Definition geb x y := match x ?= y with @@ -197,15 +202,11 @@ Definition gtb x y := | _ => false end. -(** Nota: this [eqb] is not convertible with the generated [Z_beq], - since the underlying [Pos.eqb] differs from [positive_beq] - (cf BinIntDef). *) - Fixpoint eqb x y := match x, y with | 0, 0 => true - | Zpos p, Zpos q => Pos.eqb p q - | Zneg p, Zneg q => Pos.eqb p q + | pos p, pos q => Pos.eqb p q + | neg p, neg q => Pos.eqb p q | _, _ => false end. @@ -234,8 +235,8 @@ Definition min n m := Definition abs z := match z with | 0 => 0 - | Zpos p => Zpos p - | Zneg p => Zpos p + | pos p => pos p + | neg p => pos p end. (** ** Conversions *) @@ -245,24 +246,24 @@ Definition abs z := Definition abs_nat (z:Z) : nat := match z with | 0 => 0%nat - | Zpos p => Pos.to_nat p - | Zneg p => Pos.to_nat p + | pos p => Pos.to_nat p + | neg p => Pos.to_nat p end. (** From [Z] to [N] via absolute value *) Definition abs_N (z:Z) : N := match z with - | Z0 => 0%N - | Zpos p => Npos p - | Zneg p => Npos p + | 0 => 0%N + | pos p => N.pos p + | neg p => N.pos p end. (** From [Z] to [nat] by rounding negative numbers to 0 *) Definition to_nat (z:Z) : nat := match z with - | Zpos p => Pos.to_nat p + | pos p => Pos.to_nat p | _ => O end. @@ -270,7 +271,7 @@ Definition to_nat (z:Z) : nat := Definition to_N (z:Z) : N := match z with - | Zpos p => Npos p + | pos p => N.pos p | _ => 0%N end. @@ -279,15 +280,23 @@ Definition to_N (z:Z) : N := Definition of_nat (n:nat) : Z := match n with | O => 0 - | S n => Zpos (Pos.of_succ_nat n) + | S n => pos (Pos.of_succ_nat n) end. (** From [N] to [Z] *) Definition of_N (n:N) : Z := match n with - | N0 => 0 - | Npos p => Zpos p + | 0%N => 0 + | N.pos p => pos p + end. + +(** From [Z] to [positive] by rounding nonpositive numbers to 1 *) + +Definition to_pos (z:Z) : positive := + match z with + | pos p => p + | _ => 1%positive end. (** ** Iteration of a function @@ -297,7 +306,7 @@ Definition of_N (n:N) : Z := Definition iter (n:Z) {A} (f:A -> A) (x:A) := match n with - | Zpos p => Pos.iter p f x + | pos p => Pos.iter p f x | _ => x end. @@ -352,17 +361,17 @@ Definition div_eucl (a b:Z) : Z * Z := match a, b with | 0, _ => (0, 0) | _, 0 => (0, 0) - | Zpos a', Zpos _ => pos_div_eucl a' b - | Zneg a', Zpos _ => + | pos a', pos _ => pos_div_eucl a' b + | neg a', pos _ => let (q, r) := pos_div_eucl a' b in match r with | 0 => (- q, 0) | _ => (- (q + 1), b - r) end - | Zneg a', Zneg b' => - let (q, r) := pos_div_eucl a' (Zpos b') in (q, - r) - | Zpos a', Zneg b' => - let (q, r) := pos_div_eucl a' (Zpos b') in + | neg a', neg b' => + let (q, r) := pos_div_eucl a' (pos b') in (q, - r) + | pos a', neg b' => + let (q, r) := pos_div_eucl a' (pos b') in match r with | 0 => (- q, 0) | _ => (- (q + 1), b + r) @@ -396,14 +405,14 @@ Definition quotrem (a b:Z) : Z * Z := match a, b with | 0, _ => (0, 0) | _, 0 => (0, a) - | Zpos a, Zpos b => - let (q, r) := N.pos_div_eucl a (Npos b) in (of_N q, of_N r) - | Zneg a, Zpos b => - let (q, r) := N.pos_div_eucl a (Npos b) in (-of_N q, - of_N r) - | Zpos a, Zneg b => - let (q, r) := N.pos_div_eucl a (Npos b) in (-of_N q, of_N r) - | Zneg a, Zneg b => - let (q, r) := N.pos_div_eucl a (Npos b) in (of_N q, - of_N r) + | pos a, pos b => + let (q, r) := N.pos_div_eucl a (N.pos b) in (of_N q, of_N r) + | neg a, pos b => + let (q, r) := N.pos_div_eucl a (N.pos b) in (-of_N q, - of_N r) + | pos a, neg b => + let (q, r) := N.pos_div_eucl a (N.pos b) in (-of_N q, of_N r) + | neg a, neg b => + let (q, r) := N.pos_div_eucl a (N.pos b) in (of_N q, - of_N r) end. Definition quot a b := fst (quotrem a b). @@ -418,16 +427,16 @@ Infix "÷" := quot (at level 40, left associativity) : Z_scope. Definition even z := match z with | 0 => true - | Zpos (xO _) => true - | Zneg (xO _) => true + | pos (xO _) => true + | neg (xO _) => true | _ => false end. Definition odd z := match z with | 0 => false - | Zpos (xO _) => false - | Zneg (xO _) => false + | pos (xO _) => false + | neg (xO _) => false | _ => true end. @@ -441,9 +450,9 @@ Definition odd z := Definition div2 z := match z with | 0 => 0 - | Zpos 1 => 0 - | Zpos p => Zpos (Pos.div2 p) - | Zneg p => Zneg (Pos.div2_up p) + | pos 1 => 0 + | pos p => pos (Pos.div2 p) + | neg p => neg (Pos.div2_up p) end. (** [quot2] performs rounding toward zero, it is hence a particular @@ -453,21 +462,21 @@ Definition div2 z := Definition quot2 (z:Z) := match z with | 0 => 0 - | Zpos 1 => 0 - | Zpos p => Zpos (Pos.div2 p) - | Zneg 1 => 0 - | Zneg p => Zneg (Pos.div2 p) + | pos 1 => 0 + | pos p => pos (Pos.div2 p) + | neg 1 => 0 + | neg p => neg (Pos.div2 p) end. -(** NB: [Z.quot2] used to be named [Zdiv2] in Coq <= 8.3 *) +(** NB: [Z.quot2] used to be named [Z.div2] in Coq <= 8.3 *) (** * Base-2 logarithm *) Definition log2 z := match z with - | Zpos (p~1) => Zpos (Pos.size p) - | Zpos (p~0) => Zpos (Pos.size p) + | pos (p~1) => pos (Pos.size p) + | pos (p~0) => pos (Pos.size p) | _ => 0 end. @@ -477,17 +486,17 @@ Definition log2 z := Definition sqrtrem n := match n with | 0 => (0, 0) - | Zpos p => + | pos p => match Pos.sqrtrem p with - | (s, IsPos r) => (Zpos s, Zpos r) - | (s, _) => (Zpos s, 0) + | (s, IsPos r) => (pos s, pos r) + | (s, _) => (pos s, 0) end - | Zneg _ => (0,0) + | neg _ => (0,0) end. Definition sqrt n := match n with - | Zpos p => Zpos (Pos.sqrt p) + | pos p => pos (Pos.sqrt p) | _ => 0 end. @@ -498,10 +507,10 @@ Definition gcd a b := match a,b with | 0, _ => abs b | _, 0 => abs a - | Zpos a, Zpos b => Zpos (Pos.gcd a b) - | Zpos a, Zneg b => Zpos (Pos.gcd a b) - | Zneg a, Zpos b => Zpos (Pos.gcd a b) - | Zneg a, Zneg b => Zpos (Pos.gcd a b) + | pos a, pos b => pos (Pos.gcd a b) + | pos a, neg b => pos (Pos.gcd a b) + | neg a, pos b => pos (Pos.gcd a b) + | neg a, neg b => pos (Pos.gcd a b) end. (** A generalized gcd, also computing division of a and b by gcd. *) @@ -510,14 +519,14 @@ Definition ggcd a b : Z*(Z*Z) := match a,b with | 0, _ => (abs b,(0, sgn b)) | _, 0 => (abs a,(sgn a, 0)) - | Zpos a, Zpos b => - let '(g,(aa,bb)) := Pos.ggcd a b in (Zpos g, (Zpos aa, Zpos bb)) - | Zpos a, Zneg b => - let '(g,(aa,bb)) := Pos.ggcd a b in (Zpos g, (Zpos aa, Zneg bb)) - | Zneg a, Zpos b => - let '(g,(aa,bb)) := Pos.ggcd a b in (Zpos g, (Zneg aa, Zpos bb)) - | Zneg a, Zneg b => - let '(g,(aa,bb)) := Pos.ggcd a b in (Zpos g, (Zneg aa, Zneg bb)) + | pos a, pos b => + let '(g,(aa,bb)) := Pos.ggcd a b in (pos g, (pos aa, pos bb)) + | pos a, neg b => + let '(g,(aa,bb)) := Pos.ggcd a b in (pos g, (pos aa, neg bb)) + | neg a, pos b => + let '(g,(aa,bb)) := Pos.ggcd a b in (pos g, (neg aa, pos bb)) + | neg a, neg b => + let '(g,(aa,bb)) := Pos.ggcd a b in (pos g, (neg aa, neg bb)) end. @@ -536,13 +545,13 @@ Definition ggcd a b : Z*(Z*Z) := Definition testbit a n := match n with | 0 => odd a - | Zpos p => + | pos p => match a with | 0 => false - | Zpos a => Pos.testbit a (Npos p) - | Zneg a => negb (N.testbit (Pos.pred_N a) (Npos p)) + | pos a => Pos.testbit a (N.pos p) + | neg a => negb (N.testbit (Pos.pred_N a) (N.pos p)) end - | Zneg _ => false + | neg _ => false end. (** Shifts @@ -559,8 +568,8 @@ Definition testbit a n := Definition shiftl a n := match n with | 0 => a - | Zpos p => Pos.iter p (mul 2) a - | Zneg p => Pos.iter p div2 a + | pos p => Pos.iter p (mul 2) a + | neg p => Pos.iter p div2 a end. Definition shiftr a n := shiftl a (-n). @@ -571,40 +580,40 @@ Definition lor a b := match a, b with | 0, _ => b | _, 0 => a - | Zpos a, Zpos b => Zpos (Pos.lor a b) - | Zneg a, Zpos b => Zneg (N.succ_pos (N.ldiff (Pos.pred_N a) (Npos b))) - | Zpos a, Zneg b => Zneg (N.succ_pos (N.ldiff (Pos.pred_N b) (Npos a))) - | Zneg a, Zneg b => Zneg (N.succ_pos (N.land (Pos.pred_N a) (Pos.pred_N b))) + | pos a, pos b => pos (Pos.lor a b) + | neg a, pos b => neg (N.succ_pos (N.ldiff (Pos.pred_N a) (N.pos b))) + | pos a, neg b => neg (N.succ_pos (N.ldiff (Pos.pred_N b) (N.pos a))) + | neg a, neg b => neg (N.succ_pos (N.land (Pos.pred_N a) (Pos.pred_N b))) end. Definition land a b := match a, b with | 0, _ => 0 | _, 0 => 0 - | Zpos a, Zpos b => of_N (Pos.land a b) - | Zneg a, Zpos b => of_N (N.ldiff (Npos b) (Pos.pred_N a)) - | Zpos a, Zneg b => of_N (N.ldiff (Npos a) (Pos.pred_N b)) - | Zneg a, Zneg b => Zneg (N.succ_pos (N.lor (Pos.pred_N a) (Pos.pred_N b))) + | pos a, pos b => of_N (Pos.land a b) + | neg a, pos b => of_N (N.ldiff (N.pos b) (Pos.pred_N a)) + | pos a, neg b => of_N (N.ldiff (N.pos a) (Pos.pred_N b)) + | neg a, neg b => neg (N.succ_pos (N.lor (Pos.pred_N a) (Pos.pred_N b))) end. Definition ldiff a b := match a, b with | 0, _ => 0 | _, 0 => a - | Zpos a, Zpos b => of_N (Pos.ldiff a b) - | Zneg a, Zpos b => Zneg (N.succ_pos (N.lor (Pos.pred_N a) (Npos b))) - | Zpos a, Zneg b => of_N (N.land (Npos a) (Pos.pred_N b)) - | Zneg a, Zneg b => of_N (N.ldiff (Pos.pred_N b) (Pos.pred_N a)) + | pos a, pos b => of_N (Pos.ldiff a b) + | neg a, pos b => neg (N.succ_pos (N.lor (Pos.pred_N a) (N.pos b))) + | pos a, neg b => of_N (N.land (N.pos a) (Pos.pred_N b)) + | neg a, neg b => of_N (N.ldiff (Pos.pred_N b) (Pos.pred_N a)) end. Definition lxor a b := match a, b with | 0, _ => b | _, 0 => a - | Zpos a, Zpos b => of_N (Pos.lxor a b) - | Zneg a, Zpos b => Zneg (N.succ_pos (N.lxor (Pos.pred_N a) (Npos b))) - | Zpos a, Zneg b => Zneg (N.succ_pos (N.lxor (Npos a) (Pos.pred_N b))) - | Zneg a, Zneg b => of_N (N.lxor (Pos.pred_N a) (Pos.pred_N b)) + | pos a, pos b => of_N (Pos.lxor a b) + | neg a, pos b => neg (N.succ_pos (N.lxor (Pos.pred_N a) (N.pos b))) + | pos a, neg b => neg (N.succ_pos (N.lxor (N.pos a) (Pos.pred_N b))) + | neg a, neg b => of_N (N.lxor (Pos.pred_N a) (Pos.pred_N b)) end. End Z.
\ No newline at end of file diff --git a/theories/ZArith/Int.v b/theories/ZArith/Int.v index 7c840c56..384c046f 100644 --- a/theories/ZArith/Int.v +++ b/theories/ZArith/Int.v @@ -250,7 +250,7 @@ Module MoreInt (Import I:Int). | 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) + | EZmax e1 e2 => Z.max (ez2z e1) (ez2z e2) | EZopp e => (-(ez2z e))%Z | EZofI e => i2z (ei2i e) | EZraw z => z @@ -367,14 +367,14 @@ Module Z_as_Int <: Int. 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 plus := Z.add. + Definition opp := Z.opp. + Definition minus := Z.sub. + Definition mult := Z.mul. + Definition max := Z.max. Definition gt_le_dec := Z_gt_le_dec. Definition ge_lt_dec := Z_ge_lt_dec. - Definition eq_dec := Z_eq_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. @@ -385,5 +385,5 @@ Module Z_as_Int <: Int. Lemma i2z_opp n : i2z (- n) = - i2z n. Proof. auto. Qed. Lemma i2z_minus n p : i2z (n - p) = i2z n - i2z p. Proof. auto. Qed. Lemma i2z_mult n p : i2z (n * p) = i2z n * i2z p. Proof. auto. Qed. - Lemma i2z_max n p : i2z (max n p) = Zmax (i2z n) (i2z p). Proof. auto. Qed. + Lemma i2z_max n p : i2z (max n p) = Z.max (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 bcccc126..3935e124 100644 --- a/theories/ZArith/Wf_Z.v +++ b/theories/ZArith/Wf_Z.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -39,7 +39,7 @@ Proof. Qed. Lemma Z_of_nat_complete_inf (x : Z) : - 0 <= x -> {n : nat | x = Z_of_nat n}. + 0 <= x -> {n : nat | x = Z.of_nat n}. Proof. intros H. exists (Z.to_nat x). symmetry. now apply Z2Nat.id. Qed. @@ -53,7 +53,7 @@ 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. + (forall n:nat, P (Z.of_nat n)) -> forall x:Z, 0 <= x -> P x. Proof. intros P H x Hx. now destruct (Z_of_nat_complete_inf x Hx) as (n,->). Qed. @@ -129,7 +129,7 @@ Section Efficient_Rec. - now destruct Hz. Qed. - (** A more general induction principle on non-negative numbers using [Zlt]. *) + (** A more general induction principle on non-negative numbers using [Z.lt]. *) Lemma Zlt_0_rec : forall P:Z -> Type, @@ -155,7 +155,7 @@ Section Efficient_Rec. exact Zlt_0_rec. Qed. - (** Obsolete version of [Zlt] induction principle on non-negative numbers *) + (** Obsolete version of [Z.lt] induction principle on non-negative numbers *) Lemma Z_lt_rec : forall P:Z -> Type, @@ -173,7 +173,7 @@ Section Efficient_Rec. exact Z_lt_rec. Qed. - (** An even more general induction principle using [Zlt]. *) + (** An even more general induction principle using [Z.lt]. *) Lemma Zlt_lower_bound_rec : forall P:Z -> Type, forall z:Z, diff --git a/theories/ZArith/ZArith.v b/theories/ZArith/ZArith.v index 265e62f0..033dc11f 100644 --- a/theories/ZArith/ZArith.v +++ b/theories/ZArith/ZArith.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/ZArith_base.v b/theories/ZArith/ZArith_base.v index 8eeca3b9..38b6c44d 100644 --- a/theories/ZArith/ZArith_base.v +++ b/theories/ZArith/ZArith_base.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/ZArith_dec.v b/theories/ZArith/ZArith_dec.v index 76308e60..ff4f5e7b 100644 --- a/theories/ZArith/ZArith_dec.v +++ b/theories/ZArith/ZArith_dec.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -11,7 +11,7 @@ Require Import Sumbool. Require Import BinInt. Require Import Zorder. Require Import Zcompare. -Open Local Scope Z_scope. +Local Open Scope Z_scope. (* begin hide *) (* Trivial, to deprecate? *) @@ -21,22 +21,18 @@ Proof. Defined. (* end hide *) -Lemma Zcompare_rect : - forall (P:Type) (n m:Z), - ((n ?= m) = Eq -> P) -> ((n ?= m) = Lt -> P) -> ((n ?= m) = Gt -> P) -> P. +Lemma Zcompare_rect (P:Type) (n m:Z) : + ((n ?= m) = Eq -> P) -> ((n ?= m) = Lt -> P) -> ((n ?= m) = Gt -> P) -> P. Proof. - intros * H1 H2 H3. + intros H1 H2 H3. destruct (n ?= m); auto. Defined. -Lemma Zcompare_rec : - forall (P:Set) (n m:Z), - ((n ?= m) = Eq -> P) -> ((n ?= m) = Lt -> P) -> ((n ?= m) = Gt -> P) -> P. -Proof. - intro; apply Zcompare_rect. -Defined. +Lemma Zcompare_rec (P:Set) (n m:Z) : + ((n ?= m) = Eq -> P) -> ((n ?= m) = Lt -> P) -> ((n ?= m) = Gt -> P) -> P. +Proof. apply Zcompare_rect. Defined. -Notation Z_eq_dec := Z.eq_dec (only parsing). +Notation Z_eq_dec := Z.eq_dec (compat "8.3"). Section decidability. @@ -46,38 +42,22 @@ Section decidability. 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. + unfold Z.lt; case Z.compare; (now left) || (now right). 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. + unfold Z.le; case Z.compare; (now left) || (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. + unfold Z.gt; case Z.compare; (now left) || (now right). 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. + unfold Z.ge; case Z.compare; (now left) || (right; tauto). Defined. Definition Z_lt_ge_dec : {x < y} + {x >= y}. @@ -87,16 +67,15 @@ Section decidability. 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. + * now left. + * right; now apply Z.ge_le. Defined. 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. + intro. right. Z.swap_greater. now apply Z.nle_gt. Defined. Definition Z_gt_le_dec : {x > y} + {x <= y}. @@ -107,15 +86,15 @@ Section decidability. 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. + intro. right. Z.swap_greater. now apply Z.lt_nge. 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. right. elim (Z.compare_eq_iff x y); auto with arith. + intro. left. elim (Z.compare_eq_iff x y); auto with arith. intro H1. absurd (x > y); auto with arith. Defined. @@ -132,8 +111,8 @@ Proof. assumption. intro. right. - apply Zle_lt_trans with (m := x). - apply Zge_le. + apply Z.le_lt_trans with (m := x). + apply Z.ge_le. assumption. assumption. Defined. @@ -142,20 +121,16 @@ 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. + - now left. + - right. + apply Z.add_lt_mono_l with (p := x). + now rewrite Z.add_0_r. 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 ]; + [ right; apply Z.add_lt_mono_l with (p := x); rewrite Z.add_0_r | left ]; assumption. Defined. @@ -167,7 +142,7 @@ Proof. left. assumption. intro H0. - generalize (Zge_le _ _ H0). + generalize (Z.ge_le _ _ H0). intro. case (Z_le_lt_eq_dec _ _ H1). intro. @@ -176,7 +151,7 @@ Proof. intro. apply False_rec. apply H. - symmetry in |- *. + symmetry . assumption. Defined. @@ -189,17 +164,17 @@ Proof. left. assumption. intro H. - generalize (Zge_le _ _ H). + generalize (Z.ge_le _ _ H). intro H0. case (Z_le_lt_eq_dec y x H0). intro H1. left. right. - apply Zlt_gt. + apply Z.lt_gt. assumption. intro. right. - symmetry in |- *. + symmetry . assumption. Defined. @@ -207,7 +182,7 @@ 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; + case (Z.eq_dec x y); intro H; [ right; assumption | left; apply (not_Zeq_inf _ _ H) ]. Defined. @@ -215,12 +190,12 @@ Defined. (* To deprecate ? *) Corollary 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. Corollary Z_notzerop : forall (x:Z), {x <> 0} + {x = 0}. Proof (fun x => sumbool_not _ _ (Z_zerop x)). Corollary Z_noteq_dec : forall (x y:Z), {x <> y} + {x = y}. -Proof (fun x y => sumbool_not _ _ (Z_eq_dec x y)). +Proof (fun x y => sumbool_not _ _ (Z.eq_dec x y)). (* end hide *) diff --git a/theories/ZArith/Zabs.v b/theories/ZArith/Zabs.v index 23473e93..08d1a931 100644 --- a/theories/ZArith/Zabs.v +++ b/theories/ZArith/Zabs.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -27,17 +27,17 @@ Local Open Scope Z_scope. (**********************************************************************) (** * Properties of absolute value *) -Notation Zabs_eq := Z.abs_eq (only parsing). -Notation Zabs_non_eq := Z.abs_neq (only parsing). -Notation Zabs_Zopp := Z.abs_opp (only parsing). -Notation Zabs_pos := Z.abs_nonneg (only parsing). -Notation Zabs_involutive := Z.abs_involutive (only parsing). -Notation Zabs_eq_case := Z.abs_eq_cases (only parsing). -Notation Zabs_triangle := Z.abs_triangle (only parsing). -Notation Zsgn_Zabs := Z.sgn_abs (only parsing). -Notation Zabs_Zsgn := Z.abs_sgn (only parsing). -Notation Zabs_Zmult := Z.abs_mul (only parsing). -Notation Zabs_square := Z.abs_square (only parsing). +Notation Zabs_eq := Z.abs_eq (compat "8.3"). +Notation Zabs_non_eq := Z.abs_neq (compat "8.3"). +Notation Zabs_Zopp := Z.abs_opp (compat "8.3"). +Notation Zabs_pos := Z.abs_nonneg (compat "8.3"). +Notation Zabs_involutive := Z.abs_involutive (compat "8.3"). +Notation Zabs_eq_case := Z.abs_eq_cases (compat "8.3"). +Notation Zabs_triangle := Z.abs_triangle (compat "8.3"). +Notation Zsgn_Zabs := Z.sgn_abs (compat "8.3"). +Notation Zabs_Zsgn := Z.abs_sgn (compat "8.3"). +Notation Zabs_Zmult := Z.abs_mul (compat "8.3"). +Notation Zabs_square := Z.abs_square (compat "8.3"). (** * Proving a property of the absolute value by cases *) @@ -68,38 +68,38 @@ Qed. (** * Some results about the sign function. *) -Notation Zsgn_Zmult := Z.sgn_mul (only parsing). -Notation Zsgn_Zopp := Z.sgn_opp (only parsing). -Notation Zsgn_pos := Z.sgn_pos_iff (only parsing). -Notation Zsgn_neg := Z.sgn_neg_iff (only parsing). -Notation Zsgn_null := Z.sgn_null_iff (only parsing). +Notation Zsgn_Zmult := Z.sgn_mul (compat "8.3"). +Notation Zsgn_Zopp := Z.sgn_opp (compat "8.3"). +Notation Zsgn_pos := Z.sgn_pos_iff (compat "8.3"). +Notation Zsgn_neg := Z.sgn_neg_iff (compat "8.3"). +Notation Zsgn_null := Z.sgn_null_iff (compat "8.3"). (** A characterization of the sign function: *) Lemma Zsgn_spec x : - 0 < x /\ Zsgn x = 1 \/ - 0 = x /\ Zsgn x = 0 \/ - 0 > x /\ Zsgn x = -1. + 0 < x /\ Z.sgn x = 1 \/ + 0 = x /\ Z.sgn x = 0 \/ + 0 > x /\ Z.sgn x = -1. Proof. intros. Z.swap_greater. apply Z.sgn_spec. Qed. (** Compatibility *) -Notation inj_Zabs_nat := Zabs2Nat.id_abs (only parsing). -Notation Zabs_nat_Z_of_nat := Zabs2Nat.id (only parsing). -Notation Zabs_nat_mult := Zabs2Nat.inj_mul (only parsing). -Notation Zabs_nat_Zsucc := Zabs2Nat.inj_succ (only parsing). -Notation Zabs_nat_Zplus := Zabs2Nat.inj_add (only parsing). -Notation Zabs_nat_Zminus := (fun n m => Zabs2Nat.inj_sub m n) (only parsing). -Notation Zabs_nat_compare := Zabs2Nat.inj_compare (only parsing). +Notation inj_Zabs_nat := Zabs2Nat.id_abs (compat "8.3"). +Notation Zabs_nat_Z_of_nat := Zabs2Nat.id (compat "8.3"). +Notation Zabs_nat_mult := Zabs2Nat.inj_mul (compat "8.3"). +Notation Zabs_nat_Zsucc := Zabs2Nat.inj_succ (compat "8.3"). +Notation Zabs_nat_Zplus := Zabs2Nat.inj_add (compat "8.3"). +Notation Zabs_nat_Zminus := (fun n m => Zabs2Nat.inj_sub m n) (compat "8.3"). +Notation Zabs_nat_compare := Zabs2Nat.inj_compare (compat "8.3"). Lemma Zabs_nat_le n m : 0 <= n <= m -> (Z.abs_nat n <= Z.abs_nat m)%nat. Proof. intros (H,H'). apply Zabs2Nat.inj_le; trivial. now transitivity n. Qed. -Lemma Zabs_nat_lt n m : 0 <= n < m -> (Zabs_nat n < Zabs_nat m)%nat. +Lemma Zabs_nat_lt n m : 0 <= n < m -> (Z.abs_nat n < Z.abs_nat m)%nat. Proof. intros (H,H'). apply Zabs2Nat.inj_lt; trivial. transitivity n; trivial. now apply Z.lt_le_incl. diff --git a/theories/ZArith/Zbool.v b/theories/ZArith/Zbool.v index d0901282..f20bc4bb 100644 --- a/theories/ZArith/Zbool.v +++ b/theories/ZArith/Zbool.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -13,7 +13,7 @@ Require Import Zcompare. Require Import ZArith_dec. Require Import Sumbool. -Open Local Scope Z_scope. +Local Open Scope Z_scope. (** * Boolean operations from decidability of order *) (** The decidability of equality and order relations over @@ -25,7 +25,7 @@ Definition Z_ge_lt_bool (x y:Z) := bool_of_sumbool (Z_ge_lt_dec x y). Definition Z_le_gt_bool (x y:Z) := bool_of_sumbool (Z_le_gt_dec x y). Definition Z_gt_le_bool (x y:Z) := bool_of_sumbool (Z_gt_le_dec x y). -Definition Z_eq_bool (x y:Z) := bool_of_sumbool (Z_eq_dec x y). +Definition Z_eq_bool (x y:Z) := bool_of_sumbool (Z.eq_dec x y). 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). @@ -33,10 +33,10 @@ Definition Zeven_odd_bool (x:Z) := bool_of_sumbool (Zeven_odd_dec x). (**********************************************************************) (** * Boolean comparisons of binary integers *) -Notation Zle_bool := Z.leb (only parsing). -Notation Zge_bool := Z.geb (only parsing). -Notation Zlt_bool := Z.ltb (only parsing). -Notation Zgt_bool := Z.gtb (only parsing). +Notation Zle_bool := Z.leb (compat "8.3"). +Notation Zge_bool := Z.geb (compat "8.3"). +Notation Zlt_bool := Z.ltb (compat "8.3"). +Notation Zgt_bool := Z.gtb (compat "8.3"). (** We now provide a direct [Z.eqb] that doesn't refer to [Z.compare]. The old [Zeq_bool] is kept for compatibility. *) @@ -87,7 +87,7 @@ Proof. apply Z.leb_le. Qed. -Notation Zle_bool_refl := Z.leb_refl (only parsing). +Notation Zle_bool_refl := Z.leb_refl (compat "8.3"). Lemma Zle_bool_antisym n m : (n <=? m) = true -> (m <=? n) = true -> n = m. diff --git a/theories/ZArith/Zcompare.v b/theories/ZArith/Zcompare.v index 20e1b006..fe91698f 100644 --- a/theories/ZArith/Zcompare.v +++ b/theories/ZArith/Zcompare.v @@ -1,13 +1,13 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(** Binary Integers : results about Zcompare *) +(** Binary Integers : results about Z.compare *) (** Initial author: Pierre Crégut (CNET, Lannion, France *) (** THIS FILE IS DEPRECATED. @@ -85,7 +85,7 @@ Qed. Lemma Zcompare_succ_compat n m : (Z.succ n ?= Z.succ m) = (n ?= m). Proof. - rewrite <- 2 Z.add_1_l. apply Zcompare_plus_compat. + rewrite <- 2 Z.add_1_l. apply Z.add_compare_mono_l. Qed. (** * Multiplication and comparison *) @@ -106,7 +106,7 @@ Qed. Lemma Zmult_compare_compat_r n m p : p > 0 -> (n ?= m) = (n * p ?= m * p). Proof. - intros; rewrite 2 (Zmult_comm _ p); now apply Zmult_compare_compat_l. + intros; rewrite 2 (Z.mul_comm _ p); now apply Zmult_compare_compat_l. Qed. (** * Relating [x ?= y] to [=], [<=], [<], [>=] or [>] *) @@ -181,18 +181,18 @@ Qed. (** Compatibility notations *) -Notation Zcompare_refl := Z.compare_refl (only parsing). -Notation Zcompare_Eq_eq := Z.compare_eq (only parsing). -Notation Zcompare_Eq_iff_eq := Z.compare_eq_iff (only parsing). -Notation Zcompare_spec := Z.compare_spec (only parsing). -Notation Zmin_l := Z.min_l (only parsing). -Notation Zmin_r := Z.min_r (only parsing). -Notation Zmax_l := Z.max_l (only parsing). -Notation Zmax_r := Z.max_r (only parsing). -Notation Zabs_eq := Z.abs_eq (only parsing). -Notation Zabs_non_eq := Z.abs_neq (only parsing). -Notation Zsgn_0 := Z.sgn_null (only parsing). -Notation Zsgn_1 := Z.sgn_pos (only parsing). -Notation Zsgn_m1 := Z.sgn_neg (only parsing). +Notation Zcompare_refl := Z.compare_refl (compat "8.3"). +Notation Zcompare_Eq_eq := Z.compare_eq (compat "8.3"). +Notation Zcompare_Eq_iff_eq := Z.compare_eq_iff (compat "8.3"). +Notation Zcompare_spec := Z.compare_spec (compat "8.3"). +Notation Zmin_l := Z.min_l (compat "8.3"). +Notation Zmin_r := Z.min_r (compat "8.3"). +Notation Zmax_l := Z.max_l (compat "8.3"). +Notation Zmax_r := Z.max_r (compat "8.3"). +Notation Zabs_eq := Z.abs_eq (compat "8.3"). +Notation Zabs_non_eq := Z.abs_neq (compat "8.3"). +Notation Zsgn_0 := Z.sgn_null (compat "8.3"). +Notation Zsgn_1 := Z.sgn_pos (compat "8.3"). +Notation Zsgn_m1 := Z.sgn_neg (compat "8.3"). (** Not kept: Zcompare_egal_dec *) diff --git a/theories/ZArith/Zcomplements.v b/theories/ZArith/Zcomplements.v index 5a2c3cc3..b4163ef9 100644 --- a/theories/ZArith/Zcomplements.v +++ b/theories/ZArith/Zcomplements.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -10,7 +10,7 @@ Require Import ZArithRing. Require Import ZArith_base. Require Export Omega. Require Import Wf_nat. -Open Local Scope Z_scope. +Local Open Scope Z_scope. (**********************************************************************) @@ -39,8 +39,8 @@ Proof. reflexivity. Qed. Lemma floor_ok : forall p:positive, floor p <= Zpos p < 2 * floor p. Proof. unfold floor. induction p; simpl. - - rewrite !Z.pos_xI, (Z.pos_xO (xO _)), Z.pos_xO. omega. - - rewrite (Z.pos_xO (xO _)), (Z.pos_xO p), Z.pos_xO. omega. + - rewrite !Pos2Z.inj_xI, (Pos2Z.inj_xO (xO _)), Pos2Z.inj_xO. omega. + - rewrite (Pos2Z.inj_xO (xO _)), (Pos2Z.inj_xO p), Pos2Z.inj_xO. omega. - omega. Qed. @@ -56,7 +56,7 @@ Proof. set (Q := fun z => 0 <= z -> P z * P (- z)) in *. cut (Q (Z.abs 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. + unfold Q; clear Q; intros. split; apply HP. rewrite Z.abs_eq; auto; intros. elim (H (Z.abs m)); intros; auto with zarith. @@ -75,7 +75,7 @@ Proof. set (Q := fun z => 0 <= z -> P z /\ P (- z)) in *. cut (Q (Z.abs 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. + unfold Q; clear Q; intros. split; apply HP. rewrite Z.abs_eq; auto; intros. elim (H (Z.abs m)); intros; auto with zarith. @@ -107,7 +107,7 @@ Require Import List. Fixpoint Zlength_aux (acc:Z) (A:Type) (l:list A) : Z := match l with | nil => acc - | _ :: l => Zlength_aux (Zsucc acc) A l + | _ :: l => Zlength_aux (Z.succ acc) A l end. Definition Zlength := Zlength_aux 0. diff --git a/theories/ZArith/Zdigits.v b/theories/ZArith/Zdigits.v index ff1d96df..fa8f5c27 100644 --- a/theories/ZArith/Zdigits.v +++ b/theories/ZArith/Zdigits.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -64,7 +64,7 @@ Section ENCODING_VALUE. (** We compute the binary value via a Horner scheme. Computation stops at the vector length without checks. - We define a function Zmod2 similar to Zdiv2 returning the + We define a function Zmod2 similar to Z.div2 returning the quotient of division z=2q+r with 0<=r<=1. The two's complement value is also computed via a Horner scheme with Zmod2, the parameter is the size minus one. @@ -88,16 +88,16 @@ Section ENCODING_VALUE. Lemma Zmod2_twice : - forall z:Z, z = (2 * Zmod2 z + bit_value (Zeven.Zodd_bool z))%Z. + forall z:Z, z = (2 * Zmod2 z + bit_value (Z.odd z))%Z. Proof. - destruct z; simpl in |- *. + destruct z; simpl. trivial. - destruct p; simpl in |- *; trivial. + destruct p; simpl; trivial. - destruct p; simpl in |- *. - destruct p as [p| p| ]; simpl in |- *. - rewrite <- (Pdouble_minus_one_o_succ_eq_xI p); trivial. + destruct p; simpl. + destruct p as [p| p| ]; simpl. + rewrite <- (Pos.pred_double_succ p); trivial. trivial. @@ -113,15 +113,15 @@ Section ENCODING_VALUE. simple induction n; intros. exact Bnil. - exact (Bcons (Zeven.Zodd_bool H0) n0 (H (Zeven.Zdiv2 H0))). + exact (Bcons (Z.odd H0) n0 (H (Z.div2 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 (Z.odd H) 0 Bnil). - exact (Bcons (Zeven.Zodd_bool H0) (S n0) (H (Zmod2 H0))). + exact (Bcons (Z.odd H0) (S n0) (H (Zmod2 H0))). Defined. End ENCODING_VALUE. @@ -145,17 +145,17 @@ Section Z_BRIC_A_BRAC. (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. + destruct b; destruct z; simpl; 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 |- *. + induction bv as [| a n v IHbv]; simpl. omega. - destruct a; destruct (binary_value n v); simpl in |- *; auto. + destruct a; destruct (binary_value n v); simpl; auto. auto with zarith. Qed. @@ -174,34 +174,34 @@ Section Z_BRIC_A_BRAC. 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. + destruct p as [p| p| ]; simpl; auto. + intros; rewrite (Pos.succ_pred_double 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)). + Bcons (Z.odd z) n (Z_to_binary n (Z.div2 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. + (z >= 0)%Z -> (bit_value (Z.odd z) + 2 * Z.div2 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. + Lemma Pdiv2 : forall z:Z, (z >= 0)%Z -> (Z.div2 z >= 0)%Z. Proof. destruct z as [| p| p]. auto. destruct p; auto. - simpl in |- *; intros; omega. + simpl; intros; omega. intro H; elim H; trivial. Qed. @@ -209,10 +209,10 @@ Section Z_BRIC_A_BRAC. 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. + (z < two_power_nat (S n))%Z -> (Z.div2 z < two_power_nat n)%Z. Proof. intros. - cut (2 * Zeven.Zdiv2 z < 2 * two_power_nat n)%Z; intros. + cut (2 * Z.div2 z < 2 * two_power_nat n)%Z; intros. omega. rewrite <- two_power_nat_S. @@ -225,23 +225,23 @@ Section Z_BRIC_A_BRAC. 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)). + Bcons (Z.odd 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. + forall z:Z, Zeven.Zeven z -> bit_value (Z.odd z) = 0%Z. Proof. - destruct z; unfold bit_value in |- *; auto. + destruct z; unfold bit_value; 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. + forall z:Z, Zeven.Zodd z -> bit_value (Z.odd z) = 1%Z. Proof. - destruct z; unfold bit_value in |- *; auto. + destruct z; unfold bit_value; auto. intros; elim H. destruct p; tauto || (intros; elim H). destruct p; tauto || (intros; elim H). @@ -310,7 +310,7 @@ Section COHERENT_VALUE. (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. + unfold two_power_nat, shift_nat; simpl; intros; omega. intros; rewrite Z_to_binary_Sn_z. rewrite binary_value_Sn. @@ -328,7 +328,7 @@ Section COHERENT_VALUE. (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. + unfold two_power_nat, shift_nat; simpl; intros. assert (z = (-1)%Z \/ z = 0%Z). omega. intuition; subst z; trivial. diff --git a/theories/ZArith/Zdiv.v b/theories/ZArith/Zdiv.v index 314f696a..27fb21bc 100644 --- a/theories/ZArith/Zdiv.v +++ b/theories/ZArith/Zdiv.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -18,16 +18,16 @@ Local Open Scope Z_scope. (** The definition of the division is now in [BinIntDef], the initial specifications and properties are in [BinInt]. *) -Notation Zdiv_eucl_POS := Z.pos_div_eucl (only parsing). -Notation Zdiv_eucl := Z.div_eucl (only parsing). -Notation Zdiv := Z.div (only parsing). -Notation Zmod := Z.modulo (only parsing). +Notation Zdiv_eucl_POS := Z.pos_div_eucl (compat "8.3"). +Notation Zdiv_eucl := Z.div_eucl (compat "8.3"). +Notation Zdiv := Z.div (compat "8.3"). +Notation Zmod := Z.modulo (compat "8.3"). -Notation Zdiv_eucl_eq := Z.div_eucl_eq (only parsing). -Notation Z_div_mod_eq_full := Z.div_mod (only parsing). -Notation Zmod_POS_bound := Z.pos_div_eucl_bound (only parsing). -Notation Zmod_pos_bound := Z.mod_pos_bound (only parsing). -Notation Zmod_neg_bound := Z.mod_neg_bound (only parsing). +Notation Zdiv_eucl_eq := Z.div_eucl_eq (compat "8.3"). +Notation Z_div_mod_eq_full := Z.div_mod (compat "8.3"). +Notation Zmod_POS_bound := Z.pos_div_eucl_bound (compat "8.3"). +Notation Zmod_pos_bound := Z.mod_pos_bound (compat "8.3"). +Notation Zmod_neg_bound := Z.mod_neg_bound (compat "8.3"). (** * Main division theorems *) @@ -63,8 +63,8 @@ Definition Remainder r b := 0 <= r < b \/ b < r <= 0. Definition Remainder_alt r b := Z.abs r < Z.abs b /\ Z.sgn r <> - Z.sgn b. -(* In the last formulation, [ Zsgn r <> - Zsgn b ] is less nice than saying - [ Zsgn r = Zsgn b ], but at least it works even when [r] is null. *) +(* In the last formulation, [ Z.sgn r <> - Z.sgn b ] is less nice than saying + [ Z.sgn r = Z.sgn b ], but at least it works even when [r] is null. *) Lemma Remainder_equiv : forall r b, Remainder r b <-> Remainder_alt r b. Proof. @@ -89,7 +89,7 @@ Proof. now destruct Hb. left; now apply POS. right; now apply NEG. Qed. -(** The same results as before, stated separately in terms of Zdiv and Zmod *) +(** The same results as before, stated separately in terms of Z.div and Z.modulo *) Lemma Z_mod_remainder a b : b<>0 -> Remainder (a mod b) b. Proof. @@ -98,7 +98,7 @@ Proof. Qed. Lemma Z_mod_lt a b : b > 0 -> 0 <= a mod b < b. -Proof (fun Hb => Z.mod_pos_bound a b (Zgt_lt _ _ Hb)). +Proof (fun Hb => Z.mod_pos_bound a b (Z.gt_lt _ _ Hb)). Lemma Z_mod_neg a b : b < 0 -> b < a mod b <= 0. Proof (Z.mod_neg_bound a b). @@ -220,7 +220,7 @@ Proof. intros. zero_or_not b. apply Z.mod_mul. auto. Qed. Lemma Z_div_mult_full : forall a b:Z, b <> 0 -> (a*b)/b = a. Proof Z.div_mul. -(** * Order results about Zmod and Zdiv *) +(** * Order results about Z.modulo and Z.div *) (* Division of positive numbers is positive. *) @@ -248,12 +248,12 @@ Proof Z.div_small. Theorem Zmod_small: forall a n, 0 <= a < n -> a mod n = a. Proof Z.mod_small. -(** [Zge] is compatible with a positive division. *) +(** [Z.ge] is compatible with a positive division. *) Lemma Z_div_ge : forall a b c:Z, c > 0 -> a >= b -> a/c >= b/c. -Proof. intros. apply Zle_ge. apply Z.div_le_mono; auto with zarith. Qed. +Proof. intros. apply Z.le_ge. apply Z.div_le_mono; auto with zarith. Qed. -(** Same, with [Zle]. *) +(** Same, with [Z.le]. *) Lemma Z_div_le : forall a b c:Z, c > 0 -> a <= b -> a/c <= b/c. Proof. intros. apply Z.div_le_mono; auto with zarith. Qed. @@ -264,7 +264,7 @@ Lemma Z_mult_div_ge : forall a b:Z, b > 0 -> b*(a/b) <= a. Proof. intros. apply Z.mul_div_le; auto with zarith. Qed. Lemma Z_mult_div_ge_neg : forall a b:Z, b < 0 -> b*(a/b) >= a. -Proof. intros. apply Zle_ge. apply Z.mul_div_ge; auto with zarith. Qed. +Proof. intros. apply Z.le_ge. apply Z.mul_div_ge; auto with zarith. Qed. (** The previous inequalities are exact iff the modulo is zero. *) @@ -279,7 +279,7 @@ Proof. intros; rewrite Z.div_exact; auto. Qed. Theorem Zmod_le: forall a b, 0 < b -> 0 <= a -> a mod b <= a. Proof. intros. apply Z.mod_le; auto. Qed. -(** Some additionnal inequalities about Zdiv. *) +(** Some additionnal inequalities about Z.div. *) Theorem Zdiv_lt_upper_bound: forall a b q, 0 < b -> a < q*b -> a/b < q. @@ -307,7 +307,7 @@ Proof. destruct Z.pos_div_eucl as (q,r); destruct r; omega with *. Qed. -(** * Relations between usual operations and Zmod and Zdiv *) +(** * Relations between usual operations and Z.modulo and Z.div *) Lemma Z_mod_plus_full : forall a b c:Z, (a + b * c) mod c = a mod c. Proof. intros. zero_or_not c. apply Z.mod_add; auto. Qed. @@ -318,9 +318,9 @@ Proof Z.div_add. Theorem Z_div_plus_full_l: forall a b c : Z, b <> 0 -> (a * b + c) / b = a + c / b. Proof Z.div_add_l. -(** [Zopp] and [Zdiv], [Zmod]. +(** [Z.opp] and [Z.div], [Z.modulo]. Due to the choice of convention for our Euclidean division, - some of the relations about [Zopp] and divisions are rather complex. *) + some of the relations about [Z.opp] and divisions are rather complex. *) Lemma Zdiv_opp_opp : forall a b:Z, (-a)/(-b) = a/b. Proof. intros. zero_or_not b. apply Z.div_opp_opp; auto. Qed. @@ -365,22 +365,22 @@ Proof. intros. zero_or_not b. apply Z.div_mul_cancel_r; auto. Qed. Lemma Zdiv_mult_cancel_l : forall a b c:Z, c<>0 -> (c*a)/(c*b) = a/b. Proof. - intros. rewrite (Zmult_comm c b); zero_or_not b. - rewrite (Zmult_comm b c). apply Z.div_mul_cancel_l; auto. + intros. rewrite (Z.mul_comm c b); zero_or_not b. + rewrite (Z.mul_comm b c). apply Z.div_mul_cancel_l; auto. Qed. Lemma Zmult_mod_distr_l: forall a b c, (c*a) mod (c*b) = c * (a mod b). Proof. - intros. zero_or_not c. rewrite (Zmult_comm c b); zero_or_not b. - rewrite (Zmult_comm b c). apply Z.mul_mod_distr_l; auto. + intros. zero_or_not c. rewrite (Z.mul_comm c b); zero_or_not b. + rewrite (Z.mul_comm b c). apply Z.mul_mod_distr_l; auto. Qed. Lemma Zmult_mod_distr_r: forall a b c, (a*c) mod (b*c) = (a mod b) * c. Proof. - intros. zero_or_not b. rewrite (Zmult_comm b c); zero_or_not c. - rewrite (Zmult_comm c b). apply Z.mul_mod_distr_r; auto. + intros. zero_or_not b. rewrite (Z.mul_comm b c); zero_or_not c. + rewrite (Z.mul_comm c b). apply Z.mul_mod_distr_r; auto. Qed. (** Operations modulo. *) @@ -464,22 +464,22 @@ Proof. constructor; [exact eqm_refl | exact eqm_sym | exact eqm_trans]. Qed. -Instance Zplus_eqm : Proper (eqm ==> eqm ==> eqm) Zplus. +Instance Zplus_eqm : Proper (eqm ==> eqm ==> eqm) Z.add. Proof. unfold eqm; repeat red; intros. rewrite Zplus_mod, H, H0, <- Zplus_mod; auto. Qed. -Instance Zminus_eqm : Proper (eqm ==> eqm ==> eqm) Zminus. +Instance Zminus_eqm : Proper (eqm ==> eqm ==> eqm) Z.sub. Proof. unfold eqm; repeat red; intros. rewrite Zminus_mod, H, H0, <- Zminus_mod; auto. Qed. -Instance Zmult_eqm : Proper (eqm ==> eqm ==> eqm) Zmult. +Instance Zmult_eqm : Proper (eqm ==> eqm ==> eqm) Z.mul. Proof. unfold eqm; repeat red; intros. rewrite Zmult_mod, H, H0, <- Zmult_mod; auto. Qed. -Instance Zopp_eqm : Proper (eqm ==> eqm) Zopp. +Instance Zopp_eqm : Proper (eqm ==> eqm) Z.opp. Proof. intros x y H. change ((-x)==(-y)) with ((0-x)==(0-y)). now rewrite H. Qed. @@ -489,7 +489,7 @@ Proof. intros; exact (Zmod_mod a N). Qed. -(* NB: Zmod and Zdiv are not morphisms with respect to eqm. +(* NB: Z.modulo and Z.div are not morphisms with respect to eqm. For instance, let (==) be (eqm 2). Then we have (3 == 1) but: ~ (3 mod 3 == 1 mod 3) ~ (1 mod 3 == 1 mod 1) @@ -501,7 +501,7 @@ End EqualityModulo. Lemma Zdiv_Zdiv : forall a b c, 0<=b -> 0<=c -> (a/b)/c = a/(b*c). Proof. - intros. zero_or_not b. rewrite Zmult_comm. zero_or_not c. + intros. zero_or_not b. rewrite Z.mul_comm. zero_or_not c. rewrite Z.mul_comm. apply Z.div_div; auto with zarith. Qed. @@ -515,7 +515,7 @@ Theorem Zdiv_mult_le: Proof. intros. zero_or_not b. apply Z.div_mul_le; auto with zarith. Qed. -(** Zmod is related to divisibility (see more in Znumtheory) *) +(** Z.modulo is related to divisibility (see more in Znumtheory) *) Lemma Zmod_divides : forall a b, b<>0 -> (a mod b = 0 <-> exists c, a = b*c). @@ -536,17 +536,17 @@ Qed. Lemma Zmod_even : forall a, a mod 2 = if Z.even a then 0 else 1. Proof. - intros a. rewrite Zmod_odd, Zodd_even_bool. now destruct Zeven_bool. + intros a. rewrite Zmod_odd, Zodd_even_bool. now destruct Z.even. Qed. Lemma Zodd_mod : forall a, Z.odd a = Zeq_bool (a mod 2) 1. Proof. - intros a. rewrite Zmod_odd. now destruct Zodd_bool. + intros a. rewrite Zmod_odd. now destruct Z.odd. Qed. Lemma Zeven_mod : forall a, Z.even a = Zeq_bool (a mod 2) 0. Proof. - intros a. rewrite Zmod_even. now destruct Zeven_bool. + intros a. rewrite Zmod_even. now destruct Z.even. Qed. (** * Compatibility *) @@ -593,7 +593,7 @@ Proof. intros; apply Z_mod_zero_opp_full; auto with zarith. Qed. -(** * A direct way to compute Zmod *) +(** * A direct way to compute Z.modulo *) Fixpoint Zmod_POS (a : positive) (b : Z) : Z := match a with @@ -675,7 +675,7 @@ Proof. exists (- q, r). elim Hqr; intros. split. - rewrite <- Zmult_opp_comm; assumption. + rewrite <- Z.mul_opp_comm; assumption. rewrite Z.abs_neq; [ assumption | omega ]. Qed. @@ -692,7 +692,7 @@ Proof. apply (Zdiv_unique _ _ _ (Z.of_nat (n mod m))). split. auto with zarith. now apply inj_lt, Nat.mod_upper_bound. - rewrite <- inj_mult, <- inj_plus. + rewrite <- Nat2Z.inj_mul, <- Nat2Z.inj_add. now apply inj_eq, Nat.div_mod. Qed. @@ -703,6 +703,6 @@ Proof. apply (Zmod_unique _ _ (Z.of_nat n / Z.of_nat m)). split. auto with zarith. now apply inj_lt, Nat.mod_upper_bound. - rewrite <- div_Zdiv, <- inj_mult, <- inj_plus by trivial. + rewrite <- div_Zdiv, <- Nat2Z.inj_mul, <- Nat2Z.inj_add by trivial. now apply inj_eq, Nat.div_mod. Qed. diff --git a/theories/ZArith/Zeuclid.v b/theories/ZArith/Zeuclid.v index f1b59749..1dfe2fb3 100644 --- a/theories/ZArith/Zeuclid.v +++ b/theories/ZArith/Zeuclid.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/Zeven.v b/theories/ZArith/Zeven.v index f4d702b2..dd48e84f 100644 --- a/theories/ZArith/Zeven.v +++ b/theories/ZArith/Zeven.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -58,8 +58,8 @@ Proof (Zodd_equiv n). (** Boolean tests of parity (now in BinInt.Z) *) -Notation Zeven_bool := Z.even (only parsing). -Notation Zodd_bool := Z.odd (only parsing). +Notation Zeven_bool := Z.even (compat "8.3"). +Notation Zodd_bool := Z.odd (compat "8.3"). Lemma Zeven_bool_iff n : Z.even n = true <-> Zeven n. Proof. @@ -130,17 +130,17 @@ Qed. Hint Unfold Zeven Zodd: zarith. -Notation Zeven_bool_succ := Z.even_succ (only parsing). -Notation Zeven_bool_pred := Z.even_pred (only parsing). -Notation Zodd_bool_succ := Z.odd_succ (only parsing). -Notation Zodd_bool_pred := Z.odd_pred (only parsing). +Notation Zeven_bool_succ := Z.even_succ (compat "8.3"). +Notation Zeven_bool_pred := Z.even_pred (compat "8.3"). +Notation Zodd_bool_succ := Z.odd_succ (compat "8.3"). +Notation Zodd_bool_pred := Z.odd_pred (compat "8.3"). (******************************************************************) -(** * Definition of [Zquot2], [Zdiv2] and properties wrt [Zeven] +(** * Definition of [Z.quot2], [Z.div2] and properties wrt [Zeven] and [Zodd] *) -Notation Zdiv2 := Z.div2 (only parsing). -Notation Zquot2 := Z.quot2 (only parsing). +Notation Zdiv2 := Z.div2 (compat "8.3"). +Notation Zquot2 := Z.quot2 (compat "8.3"). (** Properties of [Z.div2] *) @@ -223,7 +223,7 @@ Lemma Zsplit2 n : {p : Z * Z | let (x1, x2) := p in n = x1 + x2 /\ (x1 = x2 \/ x2 = x1 + 1)}. Proof. destruct (Z_modulo_2 n) as [(y,Hy)|(y,Hy)]; - rewrite Z.mul_comm, <- Zplus_diag_eq_mult_2 in Hy. + rewrite <- Z.add_diag in Hy. - exists (y, y). split. assumption. now left. - exists (y, y + 1). split. now rewrite Z.add_assoc. now right. Qed. diff --git a/theories/ZArith/Zgcd_alt.v b/theories/ZArith/Zgcd_alt.v index ebf3d024..40d2b129 100644 --- a/theories/ZArith/Zgcd_alt.v +++ b/theories/ZArith/Zgcd_alt.v @@ -1,19 +1,19 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(** * Zgcd_alt : an alternate version of Zgcd, based on Euclid's algorithm *) +(** * Zgcd_alt : an alternate version of Z.gcd, based on Euclid's algorithm *) (** Author: Pierre Letouzey *) -(** The alternate [Zgcd_alt] given here used to be the main [Zgcd] - function (see file [Znumtheory]), but this main [Zgcd] is now +(** The alternate [Zgcd_alt] given here used to be the main [Z.gcd] + function (see file [Znumtheory]), but this main [Z.gcd] is now based on a modern binary-efficient algorithm. This earlier version, based on Euclid's algorithm of iterated modulo, is kept here due to both its intrinsic interest and its use as reference @@ -35,22 +35,22 @@ Open Scope Z_scope. match n with | O => 1 (* arbitrary, since n should be big enough *) | S n => match a with - | Z0 => Zabs b - | Zpos _ => Zgcdn n (Zmod b a) a - | Zneg a => Zgcdn n (Zmod b (Zpos a)) (Zpos a) + | Z0 => Z.abs b + | Zpos _ => Zgcdn n (Z.modulo b a) a + | Zneg a => Zgcdn n (Z.modulo b (Zpos a)) (Zpos a) end end. Definition Zgcd_bound (a:Z) := match a with | Z0 => S O - | Zpos p => let n := Psize p in (n+n)%nat - | Zneg p => let n := Psize p in (n+n)%nat + | Zpos p => let n := Pos.size_nat p in (n+n)%nat + | Zneg p => let n := Pos.size_nat p in (n+n)%nat end. Definition Zgcd_alt a b := Zgcdn (Zgcd_bound a) a b. - (** A first obvious fact : [Zgcd a b] is positive. *) + (** A first obvious fact : [Z.gcd a b] is positive. *) Lemma Zgcdn_pos : forall n a b, 0 <= Zgcdn n a b. @@ -62,28 +62,28 @@ Open Scope Z_scope. Lemma Zgcd_alt_pos : forall a b, 0 <= Zgcd_alt a b. Proof. - intros; unfold Zgcd; apply Zgcdn_pos; auto. + intros; unfold Z.gcd; apply Zgcdn_pos; auto. Qed. - (** We now prove that Zgcd is indeed a gcd. *) + (** We now prove that Z.gcd is indeed a gcd. *) (** 1) We prove a weaker & easier bound. *) Lemma Zgcdn_linear_bound : forall n a b, - Zabs a < Z_of_nat n -> Zis_gcd a b (Zgcdn n a b). + Z.abs a < Z.of_nat n -> Zis_gcd a b (Zgcdn n a b). Proof. induction n. simpl; intros. - exfalso; generalize (Zabs_pos a); omega. + exfalso; generalize (Z.abs_nonneg a); omega. destruct a; intros; simpl; [ generalize (Zis_gcd_0_abs b); intuition | | ]; - unfold Zmod; - generalize (Z_div_mod b (Zpos p) (refl_equal Gt)); - destruct (Zdiv_eucl b (Zpos p)) as (q,r); + unfold Z.modulo; + generalize (Z_div_mod b (Zpos p) (eq_refl Gt)); + destruct (Z.div_eucl b (Zpos p)) as (q,r); intros (H0,H1); - rewrite inj_S in H; simpl Zabs in H; - (assert (H2: Zabs r < Z_of_nat n) by - (rewrite Zabs_eq; auto with zarith)); + rewrite Nat2Z.inj_succ in H; simpl Z.abs in H; + (assert (H2: Z.abs r < Z.of_nat n) by + (rewrite Z.abs_eq; auto with zarith)); assert (IH:=IHn r (Zpos p) H2); clear IHn; simpl in IH |- *; rewrite H0. @@ -122,7 +122,7 @@ Open Scope Z_scope. Proof. induction 1. auto with zarith. - apply Zle_trans with (fibonacci m); auto. + apply Z.le_trans with (fibonacci m); auto. clear. destruct m. simpl; auto with zarith. @@ -142,53 +142,38 @@ Open Scope Z_scope. fibonacci (S (S n)) <= b. Proof. induction n. - simpl; intros. - destruct a; omega. - intros. - destruct a; [simpl in *; omega| | destruct H; discriminate]. - revert H1; revert H0. - set (m:=S n) in *; (assert (m=S n) by auto); clearbody m. - pattern m at 2; rewrite H0. - simpl Zgcdn. - unfold Zmod; generalize (Z_div_mod b (Zpos p) (refl_equal Gt)). - destruct (Zdiv_eucl b (Zpos p)) as (q,r). - intros (H1,H2). - destruct H2. - destruct (Zle_lt_or_eq _ _ H2). - generalize (IHn _ _ (conj H4 H3)). - intros H5 H6 H7. - replace (fibonacci (S (S m))) with (fibonacci (S m) + fibonacci m) by auto. - assert (r = Zpos p * (-q) + b) by (rewrite H1; ring). - destruct H5; auto. - pattern r at 1; rewrite H8. - apply Zis_gcd_sym. - apply Zis_gcd_for_euclid2; auto. - apply Zis_gcd_sym; auto. - split; auto. - rewrite H1. - apply Zplus_le_compat; auto. - apply Zle_trans with (Zpos p * 1); auto. - ring_simplify (Zpos p * 1); auto. - apply Zmult_le_compat_l. - destruct q. - omega. - assert (0 < Zpos p0) by (compute; auto). - omega. - assert (Zpos p * Zneg p0 < 0) by (compute; auto). - omega. - compute; intros; discriminate. - (* r=0 *) - subst r. - simpl; rewrite H0. - intros. - simpl in H4. - simpl in H5. - destruct n. - simpl in H5. - simpl. - omega. - simpl in H5. - elim H5; auto. + intros [|a|a]; intros; simpl; omega. + intros [|a|a] b (Ha,Ha'); [simpl; omega | | easy ]. + remember (S n) as m. + rewrite Heqm at 2. simpl Zgcdn. + unfold Z.modulo; generalize (Z_div_mod b (Zpos a) eq_refl). + destruct (Z.div_eucl b (Zpos a)) as (q,r). + intros (EQ,(Hr,Hr')). + Z.le_elim Hr. + - (* r > 0 *) + replace (fibonacci (S (S m))) with (fibonacci (S m) + fibonacci m) by auto. + intros. + destruct (IHn r (Zpos a) (conj Hr Hr')); auto. + + assert (EQ' : r = Zpos a * (-q) + b) by (rewrite EQ; ring). + rewrite EQ' at 1. + apply Zis_gcd_sym. + apply Zis_gcd_for_euclid2; auto. + apply Zis_gcd_sym; auto. + + split; auto. + rewrite EQ. + apply Z.add_le_mono; auto. + apply Z.le_trans with (Zpos a * 1); auto. + now rewrite Z.mul_1_r. + apply Z.mul_le_mono_nonneg_l; auto with zarith. + change 1 with (Z.succ 0). apply Z.le_succ_l. + destruct q; auto with zarith. + assert (Zpos a * Zneg p < 0) by now compute. omega. + - (* r = 0 *) + clear IHn EQ Hr'; intros _. + subst r; simpl; rewrite Heqm. + destruct n. + + simpl. omega. + + now destruct 1. Qed. (** 3b) We reformulate the previous result in a more positive way. *) @@ -199,18 +184,18 @@ Open Scope Z_scope. Proof. destruct a; [ destruct 1; exfalso; omega | | destruct 1; discriminate]. cut (forall k n b, - k = (S (nat_of_P p) - n)%nat -> + k = (S (Pos.to_nat p) - n)%nat -> 0 < Zpos p < b -> Zpos p < fibonacci (S n) -> Zis_gcd (Zpos p) b (Zgcdn n (Zpos p) b)). destruct 2; eauto. clear n; induction k. intros. - assert (nat_of_P p < n)%nat by omega. + assert (Pos.to_nat p < n)%nat by omega. apply Zgcdn_linear_bound. simpl. generalize (inj_le _ _ H2). - rewrite inj_S. - rewrite <- Zpos_eq_Z_of_nat_o_nat_of_P; auto. + rewrite Nat2Z.inj_succ. + rewrite positive_nat_Z; auto. omega. intros. generalize (Zgcdn_worst_is_fibonacci n (Zpos p) b H0); intros. @@ -233,77 +218,69 @@ Open Scope Z_scope. induction p; [ | | compute; auto ]; simpl Zgcd_bound in *; rewrite plus_comm; simpl plus; - set (n:= (Psize p+Psize p)%nat) in *; simpl; + set (n:= (Pos.size_nat p+Pos.size_nat p)%nat) in *; simpl; assert (n <> O) by (unfold n; destruct p; simpl; auto). destruct n as [ |m]; [elim H; auto| ]. - generalize (fibonacci_pos m); rewrite Zpos_xI; omega. + generalize (fibonacci_pos m); rewrite Pos2Z.inj_xI; omega. destruct n as [ |m]; [elim H; auto| ]. - generalize (fibonacci_pos m); rewrite Zpos_xO; omega. + generalize (fibonacci_pos m); rewrite Pos2Z.inj_xO; omega. Qed. (* 5) the end: we glue everything together and take care of situations not corresponding to [0<a<b]. *) - Lemma Zgcdn_is_gcd : - forall n a b, (Zgcd_bound a <= n)%nat -> - Zis_gcd a b (Zgcdn n a b). + Lemma Zgcd_bound_opp a : Zgcd_bound (-a) = Zgcd_bound a. + Proof. + now destruct a. + Qed. + + Lemma Zgcdn_opp n a b : Zgcdn n (-a) b = Zgcdn n a b. + Proof. + induction n; simpl; auto. + destruct a; simpl; auto. + Qed. + + Lemma Zgcdn_is_gcd_pos n a b : (Zgcd_bound (Zpos a) <= n)%nat -> + Zis_gcd (Zpos a) b (Zgcdn n (Zpos a) b). + Proof. + intros. + generalize (Zgcd_bound_fibonacci (Zpos a)). + simpl Zgcd_bound in *. + remember (Pos.size_nat a+Pos.size_nat a)%nat as m. + assert (1 < m)%nat. + { rewrite Heqm; destruct a; simpl; rewrite 1?plus_comm; + auto with arith. } + destruct m as [ |m]; [inversion H0; auto| ]. + destruct n as [ |n]; [inversion H; auto| ]. + simpl Zgcdn. + unfold Z.modulo. + generalize (Z_div_mod b (Zpos a) (eq_refl Gt)). + destruct (Z.div_eucl b (Zpos a)) as (q,r). + intros (->,(H1,H2)) H3. + apply Zis_gcd_for_euclid2. + Z.le_elim H1. + + apply Zgcdn_ok_before_fibonacci; auto. + apply Z.lt_le_trans with (fibonacci (S m)); + [ omega | apply fibonacci_incr; auto]. + + subst r; simpl. + destruct m as [ |m]; [exfalso; omega| ]. + destruct n as [ |n]; [exfalso; omega| ]. + simpl; apply Zis_gcd_sym; apply Zis_gcd_0. + Qed. + + Lemma Zgcdn_is_gcd n a b : + (Zgcd_bound a <= n)%nat -> Zis_gcd a b (Zgcdn n a b). Proof. - destruct a; intros. - simpl in H. - destruct n; [exfalso; omega | ]. - simpl; generalize (Zis_gcd_0_abs b); intuition. - (*Zpos*) - generalize (Zgcd_bound_fibonacci (Zpos p)). - simpl Zgcd_bound in *. - remember (Psize p+Psize p)%nat as m. - assert (1 < m)%nat. - rewrite Heqm; destruct p; simpl; rewrite 1? plus_comm; - auto with arith. - destruct m as [ |m]; [inversion H0; auto| ]. - destruct n as [ |n]; [inversion H; auto| ]. - simpl Zgcdn. - unfold Zmod. - generalize (Z_div_mod b (Zpos p) (refl_equal Gt)). - destruct (Zdiv_eucl b (Zpos p)) as (q,r). - intros (H2,H3) H4. - rewrite H2. - apply Zis_gcd_for_euclid2. - destruct H3. - destruct (Zle_lt_or_eq _ _ H1). - apply Zgcdn_ok_before_fibonacci; auto. - apply Zlt_le_trans with (fibonacci (S m)); [ omega | apply fibonacci_incr; auto]. - subst r; simpl. - destruct m as [ |m]; [exfalso; omega| ]. - destruct n as [ |n]; [exfalso; omega| ]. - simpl; apply Zis_gcd_sym; apply Zis_gcd_0. - (*Zneg*) - generalize (Zgcd_bound_fibonacci (Zpos p)). - simpl Zgcd_bound in *. - remember (Psize p+Psize p)%nat as m. - assert (1 < m)%nat. - rewrite Heqm; destruct p; simpl; rewrite 1? plus_comm; - auto with arith. - destruct m as [ |m]; [inversion H0; auto| ]. - destruct n as [ |n]; [inversion H; auto| ]. - simpl Zgcdn. - unfold Zmod. - generalize (Z_div_mod b (Zpos p) (refl_equal Gt)). - destruct (Zdiv_eucl b (Zpos p)) as (q,r). - intros (H1,H2) H3. - rewrite H1. - apply Zis_gcd_minus. - apply Zis_gcd_sym. - apply Zis_gcd_for_euclid2. - destruct H2. - destruct (Zle_lt_or_eq _ _ H2). - apply Zgcdn_ok_before_fibonacci; auto. - apply Zlt_le_trans with (fibonacci (S m)); [ omega | apply fibonacci_incr; auto]. - subst r; simpl. - destruct m as [ |m]; [exfalso; omega| ]. - destruct n as [ |n]; [exfalso; omega| ]. - simpl; apply Zis_gcd_sym; apply Zis_gcd_0. + destruct a. + - simpl; intros. + destruct n; [exfalso; omega | ]. + simpl; generalize (Zis_gcd_0_abs b); intuition. + - apply Zgcdn_is_gcd_pos. + - rewrite <- Zgcd_bound_opp, <- Zgcdn_opp. + intros. apply Zis_gcd_minus, Zis_gcd_sym. simpl Z.opp. + now apply Zgcdn_is_gcd_pos. Qed. Lemma Zgcd_is_gcd : diff --git a/theories/ZArith/Zhints.v b/theories/ZArith/Zhints.v index 6a14d693..8b879fbe 100644 --- a/theories/ZArith/Zhints.v +++ b/theories/ZArith/Zhints.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -43,58 +43,59 @@ Hint Resolve (** Should clearly be declared as hints *) (** Lemmas ending by eq *) - Zsucc_eq_compat (* :(n,m:Z)`n = m`->`(Zs n) = (Zs m)` *) - - (** 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 *) - 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 *) - Zle_0_nat (* :(n:nat)`0 <= (inject_nat n)` *) - Zorder.Zle_0_pos (* :(p:positive)`0 <= (POS p)` *) - Zle_refl (* :(n:Z)`n <= n` *) - Zle_succ (* :(n:Z)`n <= (Zs n)` *) - Zsucc_le_compat (* :(n,m:Z)`m <= n`->`(Zs m) <= (Zs n)` *) - Zle_pred (* :(n:Z)`(Zpred n) <= n` *) - Zle_min_l (* :(n,m:Z)`(Zmin n m) <= n` *) - Zle_min_r (* :(n,m:Z)`(Zmin n m) <= m` *) - Zplus_le_compat_l (* :(n,m,p:Z)`n <= m`->`p+n <= p+m` *) - Zplus_le_compat_r (* :(a,b,c:Z)`a <= b`->`a+c <= b+c` *) - Zabs_pos (* :(x:Z)`0 <= |x|` *) + Zsucc_eq_compat (* n = m -> Z.succ n = Z.succ m *) + + (** Lemmas ending by Z.gt *) + Zsucc_gt_compat (* m > n -> Z.succ m > Z.succ n *) + Zgt_succ (* Z.succ n > n *) + Zorder.Zgt_pos_0 (* Z.pos p > 0 *) + Zplus_gt_compat_l (* n > m -> p+n > p+m *) + Zplus_gt_compat_r (* n > m -> n+p > m+p *) + + (** Lemmas ending by Z.lt *) + Pos2Z.is_pos (* 0 < Z.pos p *) + Z.lt_succ_diag_r (* n < Z.succ n *) + Zsucc_lt_compat (* n < m -> Z.succ n < Z.succ m *) + Z.lt_pred_l (* Z.pred n < n *) + Zplus_lt_compat_l (* n < m -> p+n < p+m *) + Zplus_lt_compat_r (* n < m -> n+p < m+p *) + + (** Lemmas ending by Z.le *) + Nat2Z.is_nonneg (* 0 <= Z.of_nat n *) + Pos2Z.is_nonneg (* 0 <= Z.pos p *) + Z.le_refl (* n <= n *) + Z.le_succ_diag_r (* n <= Z.succ n *) + Zsucc_le_compat (* m <= n -> Z.succ m <= Z.succ n *) + Z.le_pred_l (* Z.pred n <= n *) + Z.le_min_l (* Z.min n m <= n *) + Z.le_min_r (* Z.min n m <= m *) + Zplus_le_compat_l (* n <= m -> p+n <= p+m *) + Zplus_le_compat_r (* a <= b -> a+c <= b+c *) + Z.abs_nonneg (* 0 <= |x| *) (** ** Irreversible simplification lemmas *) (** Probably to be declared as hints, when no other simplification is possible *) (** 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` *) + Z_eq_mult (* y = 0 -> y*x = 0 *) + Zplus_eq_compat (* n = m -> p = q -> n+p = m+q *) - (** 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` *) + (** Lemmas ending by Z.ge *) + Zorder.Zmult_ge_compat_r (* a >= b -> c >= 0 -> a*c >= b*c *) + Zorder.Zmult_ge_compat_l (* 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 *) - 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 *) - 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` *) - Zplus_le_0_compat (* :(x,y:Z)`0 <= x`->`0 <= y`->`0 <= x+y` *) - Zle_le_succ (* :(x,y:Z)`x <= y`->`x <= (Zs y)` *) - Zplus_le_compat (* :(n,m,p,q:Z)`n <= m`->`p <= q`->`n+p <= m+q` *) + a >= c -> b >= d -> c >= 0 -> d >= 0 -> a*b >= c*d *) + + (** Lemmas ending by Z.lt *) + Zorder.Zmult_gt_0_compat (* a > 0 -> b > 0 -> a*b > 0 *) + Z.lt_lt_succ_r (* n < m -> n < Z.succ m *) + + (** Lemmas ending by Z.le *) + Z.mul_nonneg_nonneg (* 0 <= x -> 0 <= y -> 0 <= x*y *) + Zorder.Zmult_le_compat_r (* a <= b -> 0 <= c -> a*c <= b*c *) + Zorder.Zmult_le_compat_l (* a <= b -> 0 <= c -> c*a <= c*b *) + Z.add_nonneg_nonneg (* 0 <= x -> 0 <= y -> 0 <= x+y *) + Z.le_le_succ_r (* x <= y -> x <= Z.succ y *) + Z.add_le_mono (* n <= m -> p <= q -> n+p <= m+q *) : zarith. diff --git a/theories/ZArith/Zlogarithm.v b/theories/ZArith/Zlogarithm.v index 30948ca7..319e2c26 100644 --- a/theories/ZArith/Zlogarithm.v +++ b/theories/ZArith/Zlogarithm.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -34,22 +34,22 @@ Section Log_pos. (* Log of positive integers *) 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 *) + | xO q => Z.succ (log_inf q) (* 2n *) + | xI q => Z.succ (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 *) + | xO n => Z.succ (log_sup n) (* 2n *) + | xI n => Z.succ (Z.succ (log_inf n)) (* 2n+1 *) end. Hint Unfold log_inf log_sup. Lemma Psize_log_inf : forall p, Zpos (Pos.size p) = Z.succ (log_inf p). Proof. - induction p; simpl; now rewrite <- ?Z.succ_Zpos, ?IHp. + induction p; simpl; now rewrite ?Pos2Z.inj_succ, ?IHp. Qed. Lemma Zlog2_log_inf : forall p, Z.log2 (Zpos p) = log_inf p. @@ -71,26 +71,26 @@ Section Log_pos. (* Log of positive integers *) (** Then we give the specifications of [log_inf] and [log_sup] and prove their validity *) - Hint Resolve Zle_trans: zarith. + Hint Resolve Z.le_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)). + 0 <= log_inf x /\ two_p (log_inf x) <= Zpos x < two_p (Z.succ (log_inf x)). Proof. - simple induction x; intros; simpl in |- *; + simple induction x; intros; simpl; [ elim H; intros Hp HR; clear H; split; [ auto with zarith - | rewrite two_p_S with (x := Zsucc (log_inf p)) by (apply Zle_le_succ; trivial); + | rewrite two_p_S with (x := Z.succ (log_inf p)) by (apply Z.le_le_succ_r; trivial); rewrite two_p_S by trivial; - rewrite two_p_S in HR by trivial; rewrite (BinInt.Zpos_xI p); + rewrite two_p_S in HR by trivial; rewrite (BinInt.Pos2Z.inj_xI p); omega ] | elim H; intros Hp HR; clear H; split; [ auto with zarith - | rewrite two_p_S with (x := Zsucc (log_inf p)) by (apply Zle_le_succ; trivial); + | rewrite two_p_S with (x := Z.succ (log_inf p)) by (apply Z.le_le_succ_r; trivial); rewrite two_p_S by trivial; - rewrite two_p_S in HR by trivial; rewrite (BinInt.Zpos_xO p); + rewrite two_p_S in HR by trivial; rewrite (BinInt.Pos2Z.inj_xO p); omega ] - | unfold two_power_pos in |- *; unfold shift_pos in |- *; simpl in |- *; + | unfold two_power_pos; unfold shift_pos; simpl; omega ]. Qed. @@ -103,7 +103,7 @@ Section Log_pos. (* Log of positive integers *) Lemma log_sup_correct1 : forall p:positive, 0 <= log_sup p. Proof. - simple induction p; intros; simpl in |- *; auto with zarith. + simple induction p; intros; simpl; auto with zarith. Qed. (** For every [p], either [p] is a power of two and [(log_inf p)=(log_sup p)] @@ -112,46 +112,46 @@ Section Log_pos. (* Log of positive integers *) 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). + else log_sup p = Z.succ (log_inf p). Proof. simple induction p; intros; - [ elim H; right; simpl in |- *; + [ elim H; right; simpl; rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0)); - rewrite BinInt.Zpos_xI; unfold Zsucc in |- *; omega + rewrite BinInt.Pos2Z.inj_xI; unfold Z.succ; omega | elim H; clear H; intro Hif; - [ left; simpl in |- *; + [ left; simpl; 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 |- *; + | right; simpl; rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0)); - rewrite BinInt.Zpos_xO; unfold Zsucc in |- *; + rewrite BinInt.Pos2Z.inj_xO; unfold Z.succ; omega ] | left; auto ]. Qed. Theorem log_sup_correct2 : - forall x:positive, two_p (Zpred (log_sup x)) < Zpos x <= two_p (log_sup x). + forall x:positive, two_p (Z.pred (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 ]. + split; [ apply two_p_pred; apply log_sup_correct1 | apply Z.le_refl ]. intros [E1 E2]; rewrite E2. - rewrite <- (Zpred_succ (log_inf x)). + rewrite (Z.pred_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. + simple induction p; simpl; intros; omega. Qed. - Lemma log_sup_le_Slog_inf : forall p:positive, log_sup p <= Zsucc (log_inf p). + Lemma log_sup_le_Slog_inf : forall p:positive, log_sup p <= Z.succ (log_inf p). Proof. - simple induction p; simpl in |- *; intros; omega. + simple induction p; simpl; intros; omega. Qed. (** Now it's possible to specify and build the [Log] rounded to the nearest *) @@ -161,22 +161,20 @@ Section Log_pos. (* Log of positive integers *) | xH => 0 | xO xH => 1 | xI xH => 2 - | xO y => Zsucc (log_near y) - | xI y => Zsucc (log_near y) + | xO y => Z.succ (log_near y) + | xI y => Z.succ (log_near y) end. Theorem log_near_correct1 : forall p:positive, 0 <= log_near p. Proof. - simple induction p; simpl in |- *; intros; + simple induction p; simpl; 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 ]. + intros; apply Z.le_le_succ_r. + generalize H0; now elim p1. + intros; apply Z.le_le_succ_r. + generalize H0; now elim p1. Qed. Theorem log_near_correct2 : @@ -184,9 +182,9 @@ Section Log_pos. (* Log of positive integers *) Proof. simple induction p. intros p0 [Einf| Esup]. - simpl in |- *. rewrite Einf. + simpl. rewrite Einf. case p0; [ left | left | right ]; reflexivity. - simpl in |- *; rewrite Esup. + simpl; rewrite Esup. elim (log_sup_log_inf p0). generalize (log_inf_le_log_sup p0). generalize (log_sup_le_Slog_inf p0). @@ -194,10 +192,10 @@ Section Log_pos. (* Log of positive integers *) intros; omega. case p0; intros; auto with zarith. intros p0 [Einf| Esup]. - simpl in |- *. + simpl. repeat rewrite Einf. case p0; intros; auto with zarith. - simpl in |- *. + simpl. repeat rewrite Esup. case p0; intros; auto with zarith. auto. @@ -218,20 +216,20 @@ Section divers. 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 ]. + simple induction x; simpl; + [ apply Z.le_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. + 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 ]. + [ try trivial | rewrite Nat2Z.inj_succ; rewrite <- H; reflexivity ]. Qed. - Lemma log_sup_shift_nat : forall n:nat, log_sup (shift_nat n 1) = Z_of_nat n. + 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 ]. + [ try trivial | rewrite Nat2Z.inj_succ; rewrite <- H; reflexivity ]. Qed. (** [Is_power p] means that p is a power of two *) @@ -247,21 +245,21 @@ Section divers. Proof. split; [ elim p; - [ simpl in |- *; tauto - | simpl in |- *; intros; generalize (H H0); intro H1; elim H1; + [ simpl; tauto + | simpl; 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 ]. + | intros; elim H; intros; rewrite H0; elim x; intros; simpl; 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; right; simpl; tauto | intros; elim H; - [ intros; left; simpl in |- *; exact H0 - | intros; right; simpl in |- *; exact H0 ] - | left; simpl in |- *; trivial ]. + [ intros; left; simpl; exact H0 + | intros; right; simpl; exact H0 ] + | left; simpl; trivial ]. Qed. End divers. diff --git a/theories/ZArith/Zmax.v b/theories/ZArith/Zmax.v index 999564f0..31880c17 100644 --- a/theories/ZArith/Zmax.v +++ b/theories/ZArith/Zmax.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -12,12 +12,38 @@ Require Export BinInt Zcompare Zorder. Local Open Scope Z_scope. -(** Definition [Zmax] is now [BinInt.Z.max]. *) - -(** * Characterization of maximum on binary integer numbers *) - -Definition Zmax_case := Z.max_case. -Definition Zmax_case_strong := Z.max_case_strong. +(** Definition [Z.max] is now [BinInt.Z.max]. *) + +(** Exact compatibility *) + +Notation Zmax_case := Z.max_case (compat "8.3"). +Notation Zmax_case_strong := Z.max_case_strong (compat "8.3"). +Notation Zmax_right := Z.max_r (compat "8.3"). +Notation Zle_max_l := Z.le_max_l (compat "8.3"). +Notation Zle_max_r := Z.le_max_r (compat "8.3"). +Notation Zmax_lub := Z.max_lub (compat "8.3"). +Notation Zmax_lub_lt := Z.max_lub_lt (compat "8.3"). +Notation Zle_max_compat_r := Z.max_le_compat_r (compat "8.3"). +Notation Zle_max_compat_l := Z.max_le_compat_l (compat "8.3"). +Notation Zmax_idempotent := Z.max_id (compat "8.3"). +Notation Zmax_n_n := Z.max_id (compat "8.3"). +Notation Zmax_comm := Z.max_comm (compat "8.3"). +Notation Zmax_assoc := Z.max_assoc (compat "8.3"). +Notation Zmax_irreducible_dec := Z.max_dec (compat "8.3"). +Notation Zmax_le_prime := Z.max_le (compat "8.3"). +Notation Zsucc_max_distr := Z.succ_max_distr (compat "8.3"). +Notation Zmax_SS := Z.succ_max_distr (compat "8.3"). +Notation Zplus_max_distr_l := Z.add_max_distr_l (compat "8.3"). +Notation Zplus_max_distr_r := Z.add_max_distr_r (compat "8.3"). +Notation Zmax_plus := Z.add_max_distr_r (compat "8.3"). +Notation Zmax1 := Z.le_max_l (compat "8.3"). +Notation Zmax2 := Z.le_max_r (compat "8.3"). +Notation Zmax_irreducible_inf := Z.max_dec (compat "8.3"). +Notation Zmax_le_prime_inf := Z.max_le (compat "8.3"). +Notation Zpos_max := Pos2Z.inj_max (compat "8.3"). +Notation Zpos_minus := Pos2Z.inj_sub_max (compat "8.3"). + +(** Slightly different lemmas *) Lemma Zmax_spec x y : x >= y /\ Z.max x y = x \/ x < y /\ Z.max x y = y. @@ -26,86 +52,9 @@ Proof. Qed. Lemma Zmax_left n m : n>=m -> Z.max n m = n. -Proof. Z.swap_greater. apply Zmax_l. Qed. - -Lemma Zmax_right : forall n m, n<=m -> Z.max n m = m. Proof Zmax_r. - -(** * Least upper bound properties of max *) - -Lemma Zle_max_l : forall n m, n <= Z.max n m. Proof Z.le_max_l. -Lemma Zle_max_r : forall n m, m <= Z.max n m. Proof Z.le_max_r. - -Lemma Zmax_lub : forall n m p, n <= p -> m <= p -> Z.max n m <= p. -Proof Z.max_lub. - -Lemma Zmax_lub_lt : forall n m p:Z, n < p -> m < p -> Z.max n m < p. -Proof Z.max_lub_lt. - - -(** * Compatibility with order *) - -Lemma Zle_max_compat_r : forall n m p, n <= m -> Z.max n p <= Z.max m p. -Proof Z.max_le_compat_r. - -Lemma Zle_max_compat_l : forall n m p, n <= m -> Z.max p n <= Z.max p m. -Proof Z.max_le_compat_l. - - -(** * Semi-lattice properties of max *) - -Lemma Zmax_idempotent : forall n, Z.max n n = n. Proof Z.max_id. -Lemma Zmax_comm : forall n m, Z.max n m = Z.max m n. Proof Z.max_comm. -Lemma Zmax_assoc : forall n m p, Z.max n (Z.max m p) = Z.max (Z.max n m) p. -Proof Z.max_assoc. - -(** * Additional properties of max *) - -Lemma Zmax_irreducible_dec : forall n m, {Z.max n m = n} + {Z.max n m = m}. -Proof Z.max_dec. +Proof. Z.swap_greater. apply Z.max_l. Qed. -Lemma Zmax_le_prime : forall n m p, p <= Z.max n m -> p <= n \/ p <= m. -Proof Z.max_le. - - -(** * Operations preserving max *) - -Lemma Zsucc_max_distr : - forall n m, Z.succ (Z.max n m) = Z.max (Z.succ n) (Z.succ m). -Proof Z.succ_max_distr. - -Lemma Zplus_max_distr_l : forall n m p, Z.max (p + n) (p + m) = p + Z.max n m. -Proof Z.add_max_distr_l. - -Lemma Zplus_max_distr_r : forall n m p, Z.max (n + p) (m + p) = Z.max n m + p. -Proof Z.add_max_distr_r. - -(** * Maximum and Zpos *) - -Lemma Zpos_max p q : Zpos (Pos.max p q) = Z.max (Zpos p) (Zpos q). -Proof. - unfold Zmax, Pmax. simpl. - case Pos.compare_spec; auto; congruence. -Qed. - -Lemma Zpos_max_1 p : Z.max 1 (Zpos p) = Zpos p. +Lemma Zpos_max_1 p : Z.max 1 (Z.pos p) = Z.pos p. Proof. now destruct p. Qed. - -(** * Characterization of Pos.sub in term of Z.sub and Z.max *) - -Lemma Zpos_minus p q : Zpos (p - q) = Z.max 1 (Zpos p - Zpos q). -Proof. - simpl. rewrite Z.pos_sub_spec. case Pos.compare_spec; intros H. - subst; now rewrite Pos.sub_diag. - now rewrite Pos.sub_lt. - symmetry. apply Zpos_max_1. -Qed. - -(* begin hide *) -(* Compatibility *) -Notation Zmax1 := Z.le_max_l (only parsing). -Notation Zmax2 := Z.le_max_r (only parsing). -Notation Zmax_irreducible_inf := Z.max_dec (only parsing). -Notation Zmax_le_prime_inf := Z.max_le (only parsing). -(* end hide *) diff --git a/theories/ZArith/Zmin.v b/theories/ZArith/Zmin.v index 2c5003a6..30b88d8f 100644 --- a/theories/ZArith/Zmin.v +++ b/theories/ZArith/Zmin.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -12,12 +12,30 @@ Require Import BinInt Zcompare Zorder. Local Open Scope Z_scope. -(** Definition [Zmin] is now [BinInt.Z.min]. *) - -(** * Characterization of the minimum on binary integer numbers *) - -Definition Zmin_case := Z.min_case. -Definition Zmin_case_strong := Z.min_case_strong. +(** Definition [Z.min] is now [BinInt.Z.min]. *) + +(** Exact compatibility *) + +Notation Zmin_case := Z.min_case (compat "8.3"). +Notation Zmin_case_strong := Z.min_case_strong (compat "8.3"). +Notation Zle_min_l := Z.le_min_l (compat "8.3"). +Notation Zle_min_r := Z.le_min_r (compat "8.3"). +Notation Zmin_glb := Z.min_glb (compat "8.3"). +Notation Zmin_glb_lt := Z.min_glb_lt (compat "8.3"). +Notation Zle_min_compat_r := Z.min_le_compat_r (compat "8.3"). +Notation Zle_min_compat_l := Z.min_le_compat_l (compat "8.3"). +Notation Zmin_idempotent := Z.min_id (compat "8.3"). +Notation Zmin_n_n := Z.min_id (compat "8.3"). +Notation Zmin_comm := Z.min_comm (compat "8.3"). +Notation Zmin_assoc := Z.min_assoc (compat "8.3"). +Notation Zmin_irreducible_inf := Z.min_dec (compat "8.3"). +Notation Zsucc_min_distr := Z.succ_min_distr (compat "8.3"). +Notation Zmin_SS := Z.succ_min_distr (compat "8.3"). +Notation Zplus_min_distr_r := Z.add_min_distr_r (compat "8.3"). +Notation Zmin_plus := Z.add_min_distr_r (compat "8.3"). +Notation Zpos_min := Pos2Z.inj_min (compat "8.3"). + +(** Slightly different lemmas *) Lemma Zmin_spec x y : x <= y /\ Z.min x y = x \/ x > y /\ Z.min x y = y. @@ -25,71 +43,15 @@ Proof. Z.swap_greater. rewrite Z.min_comm. destruct (Z.min_spec y x); auto. Qed. -(** * Greatest lower bound properties of min *) - -Lemma Zle_min_l : forall n m, Z.min n m <= n. Proof Z.le_min_l. -Lemma Zle_min_r : forall n m, Z.min n m <= m. Proof Z.le_min_r. - -Lemma Zmin_glb : forall n m p, p <= n -> p <= m -> p <= Z.min n m. -Proof Z.min_glb. -Lemma Zmin_glb_lt : forall n m p, p < n -> p < m -> p < Z.min n m. -Proof Z.min_glb_lt. - -(** * Compatibility with order *) - -Lemma Zle_min_compat_r : forall n m p, n <= m -> Z.min n p <= Z.min m p. -Proof Z.min_le_compat_r. -Lemma Zle_min_compat_l : forall n m p, n <= m -> Z.min p n <= Z.min p m. -Proof Z.min_le_compat_l. - -(** * Semi-lattice properties of min *) - -Lemma Zmin_idempotent : forall n, Z.min n n = n. Proof Z.min_id. -Notation Zmin_n_n := Z.min_id (only parsing). -Lemma Zmin_comm : forall n m, Z.min n m = Z.min m n. Proof Z.min_comm. -Lemma Zmin_assoc : forall n m p, Z.min n (Z.min m p) = Z.min (Z.min n m) p. -Proof Z.min_assoc. - -(** * Additional properties of min *) - -Lemma Zmin_irreducible_inf : forall n m, {Z.min n m = n} + {Z.min n m = m}. -Proof Z.min_dec. - Lemma Zmin_irreducible n m : Z.min n m = n \/ Z.min n m = m. Proof. destruct (Z.min_dec n m); auto. Qed. -Notation Zmin_or := Zmin_irreducible (only parsing). +Notation Zmin_or := Zmin_irreducible (compat "8.3"). Lemma Zmin_le_prime_inf n m p : Z.min n m <= p -> {n <= p} + {m <= p}. -Proof. apply Zmin_case; auto. Qed. - -(** * Operations preserving min *) - -Lemma Zsucc_min_distr : - forall n m, Z.succ (Z.min n m) = Z.min (Z.succ n) (Z.succ m). -Proof Z.succ_min_distr. - -Notation Zmin_SS := Z.succ_min_distr (only parsing). - -Lemma Zplus_min_distr_r : - forall n m p, Z.min (n + p) (m + p) = Z.min n m + p. -Proof Z.add_min_distr_r. - -Notation Zmin_plus := Z.add_min_distr_r (only parsing). - -(** * Minimum and Zpos *) - -Lemma Zpos_min p q : Zpos (Pos.min p q) = Z.min (Zpos p) (Zpos q). -Proof. - unfold Z.min, Pos.min; simpl. destruct Pos.compare; auto. -Qed. +Proof. apply Z.min_case; auto. Qed. Lemma Zpos_min_1 p : Z.min 1 (Zpos p) = 1. Proof. now destruct p. Qed. - - - - - diff --git a/theories/ZArith/Zminmax.v b/theories/ZArith/Zminmax.v index 8908175f..ce589e28 100644 --- a/theories/ZArith/Zminmax.v +++ b/theories/ZArith/Zminmax.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -12,11 +12,11 @@ Require Import Orders BinInt Zcompare Zorder. (*begin hide*) (* Compatibility with names of the old Zminmax file *) -Notation Zmin_max_absorption_r_r := Z.min_max_absorption (only parsing). -Notation Zmax_min_absorption_r_r := Z.max_min_absorption (only parsing). -Notation Zmax_min_distr_r := Z.max_min_distr (only parsing). -Notation Zmin_max_distr_r := Z.min_max_distr (only parsing). -Notation Zmax_min_modular_r := Z.max_min_modular (only parsing). -Notation Zmin_max_modular_r := Z.min_max_modular (only parsing). -Notation max_min_disassoc := Z.max_min_disassoc (only parsing). +Notation Zmin_max_absorption_r_r := Z.min_max_absorption (compat "8.3"). +Notation Zmax_min_absorption_r_r := Z.max_min_absorption (compat "8.3"). +Notation Zmax_min_distr_r := Z.max_min_distr (compat "8.3"). +Notation Zmin_max_distr_r := Z.min_max_distr (compat "8.3"). +Notation Zmax_min_modular_r := Z.max_min_modular (compat "8.3"). +Notation Zmin_max_modular_r := Z.min_max_modular (compat "8.3"). +Notation max_min_disassoc := Z.max_min_disassoc (compat "8.3"). (*end hide*) diff --git a/theories/ZArith/Zmisc.v b/theories/ZArith/Zmisc.v index ff844ec2..d0ec1916 100644 --- a/theories/ZArith/Zmisc.v +++ b/theories/ZArith/Zmisc.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -11,18 +11,19 @@ Require Import BinInt. Require Import Zcompare. Require Import Zorder. Require Import Bool. -Open Local Scope Z_scope. +Local Open Scope Z_scope. (**********************************************************************) (** Iterators *) (** [n]th iteration of the function [f] *) -Notation iter := @Z.iter (only parsing). +Notation iter := @Z.iter (compat "8.3"). Lemma iter_nat_of_Z : forall n A f x, 0 <= n -> - iter n A f x = iter_nat (Z.abs_nat n) A f x. + Z.iter n f x = iter_nat (Z.abs_nat n) A f x. +Proof. intros n A f x; case n; auto. -intros p _; unfold Z.iter, Z.abs_nat; apply iter_nat_of_P. +intros p _; unfold Z.iter, Z.abs_nat; apply Pos2Nat.inj_iter. intros p abs; case abs; trivial. Qed. diff --git a/theories/ZArith/Znat.v b/theories/ZArith/Znat.v index e3843990..27b7e6a0 100644 --- a/theories/ZArith/Znat.v +++ b/theories/ZArith/Znat.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -14,6 +14,18 @@ Require Import BinPos BinInt BinNat Pnat Nnat. Local Open Scope Z_scope. +(** Conversions between integers and natural numbers + + Seven sections: + - chains of conversions (combining two conversions) + - module N2Z : from N to Z + - module Z2N : from Z to N (negative numbers rounded to 0) + - module Zabs2N : from Z to N (via the absolute value) + - module Nat2Z : from nat to Z + - module Z2Nat : from Z to nat (negative numbers rounded to 0) + - module Zabs2Nat : from Z to nat (via the absolute value) +*) + (** * Chains of conversions *) (** When combining successive conversions, we have the following @@ -254,9 +266,13 @@ Qed. Lemma inj_pow n m : Z.of_N (n^m) = (Z.of_N n)^(Z.of_N m). Proof. - symmetry. destruct n, m; trivial. now apply Z.pow_0_l. apply Z.pow_Zpos. + destruct n, m; trivial. now rewrite Z.pow_0_l. apply Pos2Z.inj_pow. Qed. +Lemma inj_testbit a n : + Z.testbit (Z.of_N a) (Z.of_N n) = N.testbit a n. +Proof. apply Z.Private_BootStrap.testbit_of_N. Qed. + End N2Z. Module Z2N. @@ -408,6 +424,10 @@ Proof. - now destruct 2. Qed. +Lemma inj_testbit a n : 0<=n -> + Z.testbit (Z.of_N a) n = N.testbit a (Z.to_N n). +Proof. apply Z.Private_BootStrap.testbit_of_N'. Qed. + End Z2N. Module Zabs2N. @@ -526,9 +546,9 @@ Proof. intros. rewrite abs_N_nonneg. now apply Z2N.inj_quot. now apply Z.quot_pos. destruct n, m; trivial; simpl. - trivial. - - now rewrite <- Z.opp_Zpos, Z.quot_opp_r, inj_opp. - - now rewrite <- Z.opp_Zpos, Z.quot_opp_l, inj_opp. - - now rewrite <- 2 Z.opp_Zpos, Z.quot_opp_opp. + - now rewrite <- Pos2Z.opp_pos, Z.quot_opp_r, inj_opp. + - now rewrite <- Pos2Z.opp_pos, Z.quot_opp_l, inj_opp. + - now rewrite <- 2 Pos2Z.opp_pos, Z.quot_opp_opp. Qed. Lemma inj_rem n m : Z.abs_N (Z.rem n m) = ((Z.abs_N n) mod (Z.abs_N m))%N. @@ -538,9 +558,9 @@ Proof. intros. rewrite abs_N_nonneg. now apply Z2N.inj_rem. now apply Z.rem_nonneg. destruct n, m; trivial; simpl. - trivial. - - now rewrite <- Z.opp_Zpos, Z.rem_opp_r. - - now rewrite <- Z.opp_Zpos, Z.rem_opp_l, inj_opp. - - now rewrite <- 2 Z.opp_Zpos, Z.rem_opp_opp, inj_opp. + - now rewrite <- Pos2Z.opp_pos, Z.rem_opp_r. + - now rewrite <- Pos2Z.opp_pos, Z.rem_opp_l, inj_opp. + - now rewrite <- 2 Pos2Z.opp_pos, Z.rem_opp_opp, inj_opp. Qed. Lemma inj_pow n m : 0<=m -> Z.abs_N (n^m) = ((Z.abs_N n)^(Z.abs_N m))%N. @@ -584,7 +604,7 @@ Qed. Lemma inj_succ n : Z.of_nat (S n) = Z.succ (Z.of_nat n). Proof. - destruct n. trivial. simpl. symmetry. apply Z.succ_Zpos. + destruct n. trivial. simpl. apply Pos2Z.inj_succ. Qed. (** [Z.of_N] produce non-negative integers *) @@ -915,10 +935,10 @@ End Zabs2Nat. Definition neq (x y:nat) := x <> y. -Lemma inj_neq n m : neq n m -> Zne (Z_of_nat n) (Z_of_nat m). +Lemma inj_neq n m : neq n m -> Zne (Z.of_nat n) (Z.of_nat m). Proof. intros H H'. now apply H, Nat2Z.inj. Qed. -Lemma Zpos_P_of_succ_nat n : Zpos (P_of_succ_nat n) = Zsucc (Z_of_nat n). +Lemma Zpos_P_of_succ_nat n : Zpos (Pos.of_succ_nat n) = Z.succ (Z.of_nat n). Proof (Nat2Z.inj_succ n). (** For these one, used in omega, a Definition is necessary *) @@ -931,67 +951,67 @@ Definition inj_gt n m := proj1 (Nat2Z.inj_gt n m). (** For the others, a Notation is fine *) -Notation inj_0 := Nat2Z.inj_0 (only parsing). -Notation inj_S := Nat2Z.inj_succ (only parsing). -Notation inj_compare := Nat2Z.inj_compare (only parsing). -Notation inj_eq_rev := Nat2Z.inj (only parsing). -Notation inj_eq_iff := (fun n m => iff_sym (Nat2Z.inj_iff n m)) (only parsing). -Notation inj_le_iff := Nat2Z.inj_le (only parsing). -Notation inj_lt_iff := Nat2Z.inj_lt (only parsing). -Notation inj_ge_iff := Nat2Z.inj_ge (only parsing). -Notation inj_gt_iff := Nat2Z.inj_gt (only parsing). -Notation inj_le_rev := (fun n m => proj2 (Nat2Z.inj_le n m)) (only parsing). -Notation inj_lt_rev := (fun n m => proj2 (Nat2Z.inj_lt n m)) (only parsing). -Notation inj_ge_rev := (fun n m => proj2 (Nat2Z.inj_ge n m)) (only parsing). -Notation inj_gt_rev := (fun n m => proj2 (Nat2Z.inj_gt n m)) (only parsing). -Notation inj_plus := Nat2Z.inj_add (only parsing). -Notation inj_mult := Nat2Z.inj_mul (only parsing). -Notation inj_minus1 := Nat2Z.inj_sub (only parsing). -Notation inj_minus := Nat2Z.inj_sub_max (only parsing). -Notation inj_min := Nat2Z.inj_min (only parsing). -Notation inj_max := Nat2Z.inj_max (only parsing). - -Notation Z_of_nat_of_P := positive_nat_Z (only parsing). +Notation inj_0 := Nat2Z.inj_0 (compat "8.3"). +Notation inj_S := Nat2Z.inj_succ (compat "8.3"). +Notation inj_compare := Nat2Z.inj_compare (compat "8.3"). +Notation inj_eq_rev := Nat2Z.inj (compat "8.3"). +Notation inj_eq_iff := (fun n m => iff_sym (Nat2Z.inj_iff n m)) (compat "8.3"). +Notation inj_le_iff := Nat2Z.inj_le (compat "8.3"). +Notation inj_lt_iff := Nat2Z.inj_lt (compat "8.3"). +Notation inj_ge_iff := Nat2Z.inj_ge (compat "8.3"). +Notation inj_gt_iff := Nat2Z.inj_gt (compat "8.3"). +Notation inj_le_rev := (fun n m => proj2 (Nat2Z.inj_le n m)) (compat "8.3"). +Notation inj_lt_rev := (fun n m => proj2 (Nat2Z.inj_lt n m)) (compat "8.3"). +Notation inj_ge_rev := (fun n m => proj2 (Nat2Z.inj_ge n m)) (compat "8.3"). +Notation inj_gt_rev := (fun n m => proj2 (Nat2Z.inj_gt n m)) (compat "8.3"). +Notation inj_plus := Nat2Z.inj_add (compat "8.3"). +Notation inj_mult := Nat2Z.inj_mul (compat "8.3"). +Notation inj_minus1 := Nat2Z.inj_sub (compat "8.3"). +Notation inj_minus := Nat2Z.inj_sub_max (compat "8.3"). +Notation inj_min := Nat2Z.inj_min (compat "8.3"). +Notation inj_max := Nat2Z.inj_max (compat "8.3"). + +Notation Z_of_nat_of_P := positive_nat_Z (compat "8.3"). Notation Zpos_eq_Z_of_nat_o_nat_of_P := - (fun p => sym_eq (positive_nat_Z p)) (only parsing). - -Notation Z_of_nat_of_N := N_nat_Z (only parsing). -Notation Z_of_N_of_nat := nat_N_Z (only parsing). - -Notation Z_of_N_eq := (f_equal Z.of_N) (only parsing). -Notation Z_of_N_eq_rev := N2Z.inj (only parsing). -Notation Z_of_N_eq_iff := (fun n m => iff_sym (N2Z.inj_iff n m)) (only parsing). -Notation Z_of_N_compare := N2Z.inj_compare (only parsing). -Notation Z_of_N_le_iff := N2Z.inj_le (only parsing). -Notation Z_of_N_lt_iff := N2Z.inj_lt (only parsing). -Notation Z_of_N_ge_iff := N2Z.inj_ge (only parsing). -Notation Z_of_N_gt_iff := N2Z.inj_gt (only parsing). -Notation Z_of_N_le := (fun n m => proj1 (N2Z.inj_le n m)) (only parsing). -Notation Z_of_N_lt := (fun n m => proj1 (N2Z.inj_lt n m)) (only parsing). -Notation Z_of_N_ge := (fun n m => proj1 (N2Z.inj_ge n m)) (only parsing). -Notation Z_of_N_gt := (fun n m => proj1 (N2Z.inj_gt n m)) (only parsing). -Notation Z_of_N_le_rev := (fun n m => proj2 (N2Z.inj_le n m)) (only parsing). -Notation Z_of_N_lt_rev := (fun n m => proj2 (N2Z.inj_lt n m)) (only parsing). -Notation Z_of_N_ge_rev := (fun n m => proj2 (N2Z.inj_ge n m)) (only parsing). -Notation Z_of_N_gt_rev := (fun n m => proj2 (N2Z.inj_gt n m)) (only parsing). -Notation Z_of_N_pos := N2Z.inj_pos (only parsing). -Notation Z_of_N_abs := N2Z.inj_abs_N (only parsing). -Notation Z_of_N_le_0 := N2Z.is_nonneg (only parsing). -Notation Z_of_N_plus := N2Z.inj_add (only parsing). -Notation Z_of_N_mult := N2Z.inj_mul (only parsing). -Notation Z_of_N_minus := N2Z.inj_sub_max (only parsing). -Notation Z_of_N_succ := N2Z.inj_succ (only parsing). -Notation Z_of_N_min := N2Z.inj_min (only parsing). -Notation Z_of_N_max := N2Z.inj_max (only parsing). -Notation Zabs_of_N := Zabs2N.id (only parsing). -Notation Zabs_N_succ_abs := Zabs2N.inj_succ_abs (only parsing). -Notation Zabs_N_succ := Zabs2N.inj_succ (only parsing). -Notation Zabs_N_plus_abs := Zabs2N.inj_add_abs (only parsing). -Notation Zabs_N_plus := Zabs2N.inj_add (only parsing). -Notation Zabs_N_mult_abs := Zabs2N.inj_mul_abs (only parsing). -Notation Zabs_N_mult := Zabs2N.inj_mul (only parsing). - -Theorem inj_minus2 : forall n m:nat, (m > n)%nat -> Z_of_nat (n - m) = 0. + (fun p => eq_sym (positive_nat_Z p)) (compat "8.3"). + +Notation Z_of_nat_of_N := N_nat_Z (compat "8.3"). +Notation Z_of_N_of_nat := nat_N_Z (compat "8.3"). + +Notation Z_of_N_eq := (f_equal Z.of_N) (compat "8.3"). +Notation Z_of_N_eq_rev := N2Z.inj (compat "8.3"). +Notation Z_of_N_eq_iff := (fun n m => iff_sym (N2Z.inj_iff n m)) (compat "8.3"). +Notation Z_of_N_compare := N2Z.inj_compare (compat "8.3"). +Notation Z_of_N_le_iff := N2Z.inj_le (compat "8.3"). +Notation Z_of_N_lt_iff := N2Z.inj_lt (compat "8.3"). +Notation Z_of_N_ge_iff := N2Z.inj_ge (compat "8.3"). +Notation Z_of_N_gt_iff := N2Z.inj_gt (compat "8.3"). +Notation Z_of_N_le := (fun n m => proj1 (N2Z.inj_le n m)) (compat "8.3"). +Notation Z_of_N_lt := (fun n m => proj1 (N2Z.inj_lt n m)) (compat "8.3"). +Notation Z_of_N_ge := (fun n m => proj1 (N2Z.inj_ge n m)) (compat "8.3"). +Notation Z_of_N_gt := (fun n m => proj1 (N2Z.inj_gt n m)) (compat "8.3"). +Notation Z_of_N_le_rev := (fun n m => proj2 (N2Z.inj_le n m)) (compat "8.3"). +Notation Z_of_N_lt_rev := (fun n m => proj2 (N2Z.inj_lt n m)) (compat "8.3"). +Notation Z_of_N_ge_rev := (fun n m => proj2 (N2Z.inj_ge n m)) (compat "8.3"). +Notation Z_of_N_gt_rev := (fun n m => proj2 (N2Z.inj_gt n m)) (compat "8.3"). +Notation Z_of_N_pos := N2Z.inj_pos (compat "8.3"). +Notation Z_of_N_abs := N2Z.inj_abs_N (compat "8.3"). +Notation Z_of_N_le_0 := N2Z.is_nonneg (compat "8.3"). +Notation Z_of_N_plus := N2Z.inj_add (compat "8.3"). +Notation Z_of_N_mult := N2Z.inj_mul (compat "8.3"). +Notation Z_of_N_minus := N2Z.inj_sub_max (compat "8.3"). +Notation Z_of_N_succ := N2Z.inj_succ (compat "8.3"). +Notation Z_of_N_min := N2Z.inj_min (compat "8.3"). +Notation Z_of_N_max := N2Z.inj_max (compat "8.3"). +Notation Zabs_of_N := Zabs2N.id (compat "8.3"). +Notation Zabs_N_succ_abs := Zabs2N.inj_succ_abs (compat "8.3"). +Notation Zabs_N_succ := Zabs2N.inj_succ (compat "8.3"). +Notation Zabs_N_plus_abs := Zabs2N.inj_add_abs (compat "8.3"). +Notation Zabs_N_plus := Zabs2N.inj_add (compat "8.3"). +Notation Zabs_N_mult_abs := Zabs2N.inj_mul_abs (compat "8.3"). +Notation Zabs_N_mult := Zabs2N.inj_mul (compat "8.3"). + +Theorem inj_minus2 : forall n m:nat, (m > n)%nat -> Z.of_nat (n - m) = 0. Proof. intros. rewrite not_le_minus_0; auto with arith. Qed. diff --git a/theories/ZArith/Znumtheory.v b/theories/ZArith/Znumtheory.v index 6eb1a709..c1e01451 100644 --- a/theories/ZArith/Znumtheory.v +++ b/theories/ZArith/Znumtheory.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -17,7 +17,7 @@ Require Import Wf_nat. Open Scope Z_scope. (** This file contains some notions of number theory upon Z numbers: - - a divisibility predicate [Zdivide] + - a divisibility predicate [Z.divide] - a gcd predicate [gcd] - Euclid algorithm [euclid] - a relatively prime predicate [rel_prime] @@ -25,20 +25,20 @@ Open Scope Z_scope. - properties of the efficient [Z.gcd] function *) -Notation Zgcd := Z.gcd (only parsing). -Notation Zggcd := Z.ggcd (only parsing). -Notation Zggcd_gcd := Z.ggcd_gcd (only parsing). -Notation Zggcd_correct_divisors := Z.ggcd_correct_divisors (only parsing). -Notation Zgcd_divide_l := Z.gcd_divide_l (only parsing). -Notation Zgcd_divide_r := Z.gcd_divide_r (only parsing). -Notation Zgcd_greatest := Z.gcd_greatest (only parsing). -Notation Zgcd_nonneg := Z.gcd_nonneg (only parsing). -Notation Zggcd_opp := Z.ggcd_opp (only parsing). - -(** The former specialized inductive predicate [Zdivide] is now +Notation Zgcd := Z.gcd (compat "8.3"). +Notation Zggcd := Z.ggcd (compat "8.3"). +Notation Zggcd_gcd := Z.ggcd_gcd (compat "8.3"). +Notation Zggcd_correct_divisors := Z.ggcd_correct_divisors (compat "8.3"). +Notation Zgcd_divide_l := Z.gcd_divide_l (compat "8.3"). +Notation Zgcd_divide_r := Z.gcd_divide_r (compat "8.3"). +Notation Zgcd_greatest := Z.gcd_greatest (compat "8.3"). +Notation Zgcd_nonneg := Z.gcd_nonneg (compat "8.3"). +Notation Zggcd_opp := Z.ggcd_opp (compat "8.3"). + +(** The former specialized inductive predicate [Z.divide] is now a generic existential predicate. *) -Notation Zdivide := Z.divide (only parsing). +Notation Zdivide := Z.divide (compat "8.3"). (** Its former constructor is now a pseudo-constructor. *) @@ -46,17 +46,17 @@ Definition Zdivide_intro a b q (H:b=q*a) : Z.divide a b := ex_intro _ q H. (** Results concerning divisibility*) -Notation Zdivide_refl := Z.divide_refl (only parsing). -Notation Zone_divide := Z.divide_1_l (only parsing). -Notation Zdivide_0 := Z.divide_0_r (only parsing). -Notation Zmult_divide_compat_l := Z.mul_divide_mono_l (only parsing). -Notation Zmult_divide_compat_r := Z.mul_divide_mono_r (only parsing). -Notation Zdivide_plus_r := Z.divide_add_r (only parsing). -Notation Zdivide_minus_l := Z.divide_sub_r (only parsing). -Notation Zdivide_mult_l := Z.divide_mul_l (only parsing). -Notation Zdivide_mult_r := Z.divide_mul_r (only parsing). -Notation Zdivide_factor_r := Z.divide_factor_l (only parsing). -Notation Zdivide_factor_l := Z.divide_factor_r (only parsing). +Notation Zdivide_refl := Z.divide_refl (compat "8.3"). +Notation Zone_divide := Z.divide_1_l (compat "8.3"). +Notation Zdivide_0 := Z.divide_0_r (compat "8.3"). +Notation Zmult_divide_compat_l := Z.mul_divide_mono_l (compat "8.3"). +Notation Zmult_divide_compat_r := Z.mul_divide_mono_r (compat "8.3"). +Notation Zdivide_plus_r := Z.divide_add_r (compat "8.3"). +Notation Zdivide_minus_l := Z.divide_sub_r (compat "8.3"). +Notation Zdivide_mult_l := Z.divide_mul_l (compat "8.3"). +Notation Zdivide_mult_r := Z.divide_mul_r (compat "8.3"). +Notation Zdivide_factor_r := Z.divide_factor_l (compat "8.3"). +Notation Zdivide_factor_l := Z.divide_factor_r (compat "8.3"). Lemma Zdivide_opp_r a b : (a | b) -> (a | - b). Proof. apply Z.divide_opp_r. Qed. @@ -76,11 +76,11 @@ Proof. apply Z.divide_abs_l. Qed. Theorem Zdivide_Zabs_inv_l a b : (a | b) -> (Z.abs a | b). Proof. apply Z.divide_abs_l. Qed. -Hint Resolve Zdivide_refl Zone_divide Zdivide_0: zarith. -Hint Resolve Zmult_divide_compat_l Zmult_divide_compat_r: zarith. -Hint Resolve Zdivide_plus_r Zdivide_opp_r Zdivide_opp_r_rev Zdivide_opp_l - Zdivide_opp_l_rev Zdivide_minus_l Zdivide_mult_l Zdivide_mult_r - Zdivide_factor_r Zdivide_factor_l: zarith. +Hint Resolve Z.divide_refl Z.divide_1_l Z.divide_0_r: zarith. +Hint Resolve Z.mul_divide_mono_l Z.mul_divide_mono_r: zarith. +Hint Resolve Z.divide_add_r Zdivide_opp_r Zdivide_opp_r_rev Zdivide_opp_l + Zdivide_opp_l_rev Z.divide_sub_r Z.divide_mul_l Z.divide_mul_r + Z.divide_factor_l Z.divide_factor_r: zarith. (** Auxiliary result. *) @@ -91,12 +91,12 @@ Qed. (** Only [1] and [-1] divide [1]. *) -Notation Zdivide_1 := Z.divide_1_r (only parsing). +Notation Zdivide_1 := Z.divide_1_r (compat "8.3"). (** If [a] divides [b] and [b] divides [a] then [a] is [b] or [-b]. *) -Notation Zdivide_antisym := Z.divide_antisym (only parsing). -Notation Zdivide_trans := Z.divide_trans (only parsing). +Notation Zdivide_antisym := Z.divide_antisym (compat "8.3"). +Notation Zdivide_trans := Z.divide_trans (compat "8.3"). (** If [a] divides [b] and [b<>0] then [|a| <= |b|]. *) @@ -108,7 +108,7 @@ Proof. now apply Z.divide_pos_le. Qed. -(** [Zdivide] can be expressed using [Zmod]. *) +(** [Z.divide] can be expressed using [Z.modulo]. *) Lemma Zmod_divide : forall a b, b<>0 -> a mod b = 0 -> (b | a). Proof. @@ -120,7 +120,7 @@ Proof. intros a b (c,->); apply Z_mod_mult. Qed. -(** [Zdivide] is hence decidable *) +(** [Z.divide] is hence decidable *) Lemma Zdivide_dec a b : {(a | b)} + {~ (a | b)}. Proof. @@ -193,14 +193,16 @@ Qed. (** * Greatest common divisor (gcd). *) -(** There is no unicity of the gcd; hence we define the predicate [gcd a b d] - expressing that [d] is a gcd of [a] and [b]. - (We show later that the [gcd] is actually unique if we discard its sign.) *) +(** There is no unicity of the gcd; hence we define the predicate + [Zis_gcd a b g] expressing that [g] is a gcd of [a] and [b]. + (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. +Inductive Zis_gcd (a b g:Z) : Prop := + Zis_gcd_intro : + (g | a) -> + (g | b) -> + (forall x, (x | a) -> (x | b) -> (x | g)) -> + Zis_gcd a b g. (** Trivial properties of [gcd] *) @@ -246,12 +248,10 @@ Hint Resolve Zis_gcd_sym Zis_gcd_0 Zis_gcd_minus Zis_gcd_opp: zarith. Theorem Zis_gcd_unique: forall a b c d : Z, Zis_gcd a b c -> Zis_gcd a b d -> c = d \/ c = (- d). Proof. -intros a b c d H1 H2. -inversion_clear H1 as [Hc1 Hc2 Hc3]. -inversion_clear H2 as [Hd1 Hd2 Hd3]. -assert (H3: Zdivide c d); auto. -assert (H4: Zdivide d c); auto. -apply Zdivide_antisym; auto. +intros a b c d [Hc1 Hc2 Hc3] [Hd1 Hd2 Hd3]. +assert (c|d) by auto. +assert (d|c) by auto. +apply Z.divide_antisym; auto. Qed. @@ -305,7 +305,7 @@ Section extended_euclid_algorithm. 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 |- *. + intros v3 Hv3; generalize Hv3; pattern v3. apply Zlt_0_rec. clear v3 Hv3; intros. elim (Z_zerop x); intro. @@ -319,8 +319,8 @@ Section extended_euclid_algorithm. 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. + unfold q. + intro eq; pattern u3 at 2; 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 @@ -357,7 +357,7 @@ Proof. 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). + exact (Z.divide_antisym d d' Hdd' Hd'd). Qed. (** * Bezout's coefficients *) @@ -450,21 +450,21 @@ Lemma rel_prime_cross_prod : 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). + elim (Z.divide_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. + rewrite Z.mul_comm in H3. + apply Z.mul_reg_l with d; auto with zarith. intros; omega. apply Gauss with a. rewrite H3. auto with zarith. - red in |- *; auto with zarith. + red; auto with zarith. apply Gauss with c. - rewrite Zmult_comm. + rewrite Z.mul_comm. rewrite <- H3. auto with zarith. - red in |- *; auto with zarith. + red; auto with zarith. Qed. (** After factorization by a gcd, the original numbers are relatively prime. *) @@ -479,7 +479,7 @@ Proof. elim H1; intros. elim H4; intros. rewrite H2 in H6; subst b; omega. - unfold rel_prime in |- *. + unfold rel_prime. destruct H1. destruct H1 as (a',H1). destruct H3 as (b',H3). @@ -492,12 +492,12 @@ Proof. exists b'; auto with zarith. intros x (xa,H5) (xb,H6). destruct (H4 (x*g)) as (x',Hx'). - exists xa; rewrite Zmult_assoc; rewrite <- H5; auto. - exists xb; rewrite Zmult_assoc; rewrite <- H6; auto. + exists xa; rewrite Z.mul_assoc; rewrite <- H5; auto. + exists xb; rewrite Z.mul_assoc; rewrite <- H6; auto. replace g with (1*g) in Hx'; auto with zarith. - do 2 rewrite Zmult_assoc in Hx'. - apply Zmult_reg_r in Hx'; trivial. - rewrite Zmult_1_r in Hx'. + do 2 rewrite Z.mul_assoc in Hx'. + apply Z.mul_reg_r in Hx'; trivial. + rewrite Z.mul_1_r in Hx'. exists x'; auto with zarith. Qed. @@ -512,9 +512,9 @@ Theorem rel_prime_div: forall p q r, Proof. intros p q r H (u, H1); subst. inversion_clear H as [H1 H2 H3]. - red; apply Zis_gcd_intro; try apply Zone_divide. + red; apply Zis_gcd_intro; try apply Z.divide_1_l. intros x H4 H5; apply H3; auto. - apply Zdivide_mult_r; auto. + apply Z.divide_mul_r; auto. Qed. Theorem rel_prime_1: forall n, rel_prime 1 n. @@ -575,30 +575,29 @@ 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. + destruct 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. + { assert (Z.abs a <= Z.abs p) as H2. + apply Zdivide_bounds; [ assumption | omega ]. + revert H2. + pattern (Z.abs a); apply Zabs_ind; pattern (Z.abs p); 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. + - absurd (rel_prime (- a) p); intuition. + inversion H2. + assert (- a | - a) by auto with zarith. + assert (- a | p) by auto with zarith. + apply H7, Z.divide_1_r in H8; intuition. (* a = 0 *) - inversion H2. subst a; omega. + - inversion H1. 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. + - absurd (rel_prime a p); intuition. + inversion H2. + assert (a | a) by auto with zarith. + assert (a | p) by auto with zarith. + apply H7, Z.divide_1_r in H8; intuition. Qed. (** A prime number is relatively prime with any number it does not divide *) @@ -623,7 +622,7 @@ Proof. intros a p Hp [H1 H2]. apply rel_prime_sym; apply prime_rel_prime; auto. intros [q Hq]; subst a. - case (Zle_or_lt q 0); intros Hl. + case (Z.le_gt_cases q 0); intros Hl. absurd (q * p <= 0 * p); auto with zarith. absurd (1 * p <= q * p); auto with zarith. Qed. @@ -653,87 +652,79 @@ Qed. Lemma prime_2: prime 2. Proof. apply prime_intro; auto with zarith. - intros n [H1 H2]; case Zle_lt_or_eq with ( 1 := H1 ); auto with zarith; - clear H1; intros H1. - contradict H2; auto with zarith. - subst n; red; auto with zarith. - apply Zis_gcd_intro; auto with zarith. + intros n (H,H'); Z.le_elim H; auto with zarith. + - contradict H'; auto with zarith. + - subst n. constructor; auto with zarith. Qed. Theorem prime_3: prime 3. Proof. apply prime_intro; auto with zarith. - intros n [H1 H2]; case Zle_lt_or_eq with ( 1 := H1 ); auto with zarith; - clear H1; intros H1. - case (Zle_lt_or_eq 2 n); auto with zarith; clear H1; intros H1. - contradict H2; auto with zarith. - subst n; red; auto with zarith. - apply Zis_gcd_intro; auto with zarith. - intros x [q1 Hq1] [q2 Hq2]. - exists (q2 - q1). - apply trans_equal with (3 - 2); auto with zarith. - rewrite Hq1; rewrite Hq2; ring. - subst n; red; auto with zarith. - apply Zis_gcd_intro; auto with zarith. + intros n (H,H'); Z.le_elim H; auto with zarith. + - replace n with 2 by omega. + constructor; auto with zarith. + intros x (q,Hq) (q',Hq'). + exists (q' - q). ring_simplify. now rewrite <- Hq, <- Hq'. + - replace n with 1 by trivial. + constructor; auto with zarith. Qed. -Theorem prime_ge_2: forall p, prime p -> 2 <= p. +Theorem prime_ge_2 p : prime p -> 2 <= p. Proof. - intros p Hp; inversion Hp; auto with zarith. + intros (Hp,_); auto with zarith. Qed. Definition prime' p := 1<p /\ (forall n, 1<n<p -> ~ (n|p)). -Theorem prime_alt: - forall p, prime' p <-> prime p. -Proof. - split; destruct 1; intros. - (* prime -> prime' *) - constructor; auto; intros. - red; apply Zis_gcd_intro; auto with zarith; intros. - case (Zle_lt_or_eq 0 (Zabs x)); auto with zarith; intros H6. - case (Zle_lt_or_eq 1 (Zabs x)); auto with zarith; intros H7. - case (Zle_lt_or_eq (Zabs x) p); auto with zarith. - apply Zdivide_le; auto with zarith. - apply Zdivide_Zabs_inv_l; auto. - intros H8; case (H0 (Zabs x)); auto. - apply Zdivide_Zabs_inv_l; auto. - intros H8; subst p; absurd (Zabs x <= n); auto with zarith. - apply Zdivide_le; auto with zarith. - apply Zdivide_Zabs_inv_l; auto. - rewrite H7; pattern (Zabs x); apply Zabs_intro; auto with zarith. - absurd (0%Z = p); auto with zarith. - assert (x=0) by (destruct x; simpl in *; now auto). - subst x; elim H3; intro q; rewrite Zmult_0_r; auto. - (* prime' -> prime *) - split; auto; intros. - intros H2. - case (Zis_gcd_unique n p n 1); auto with zarith. - apply Zis_gcd_intro; auto with zarith. - apply H0; auto with zarith. +Lemma Z_0_1_more x : 0<=x -> x=0 \/ x=1 \/ 1<x. +Proof. + intros H. Z.le_elim H; auto. + apply Z.le_succ_l in H. change (1 <= x) in H. Z.le_elim H; auto. +Qed. + +Theorem prime_alt p : prime' p <-> prime p. +Proof. + split; intros (Hp,H). + - (* prime -> prime' *) + constructor; trivial; intros n Hn. + constructor; auto with zarith; intros x Hxn Hxp. + rewrite <- Z.divide_abs_l in Hxn, Hxp |- *. + assert (Hx := Z.abs_nonneg x). + set (y:=Z.abs x) in *; clearbody y; clear x; rename y into x. + destruct (Z_0_1_more x Hx) as [->|[->|Hx']]. + + exfalso. apply Z.divide_0_l in Hxn. omega. + + now exists 1. + + elim (H x); auto. + split; trivial. + apply Z.le_lt_trans with n; auto with zarith. + apply Z.divide_pos_le; auto with zarith. + - (* prime' -> prime *) + constructor; trivial. intros n Hn Hnp. + case (Zis_gcd_unique n p n 1); auto with zarith. + constructor; auto with zarith. + apply H; auto with zarith. Qed. Theorem square_not_prime: forall a, ~ prime (a * a). Proof. intros a Ha. - rewrite <- (Zabs_square a) in Ha. - assert (0 <= Zabs a) by auto with zarith. - set (b:=Zabs a) in *; clearbody b. - rewrite <- prime_alt in Ha; destruct Ha. - case (Zle_lt_or_eq 0 b); auto with zarith; intros Hza1; [ | subst; omega]. - case (Zle_lt_or_eq 1 b); auto with zarith; intros Hza2; [ | subst; omega]. - assert (Hza3 := Zmult_lt_compat_r 1 b b Hza1 Hza2). - rewrite Zmult_1_l in Hza3. - elim (H1 _ (conj Hza2 Hza3)). - exists b; auto. + rewrite <- (Z.abs_square a) in Ha. + assert (H:=Z.abs_nonneg a). + set (b:=Z.abs a) in *; clearbody b; clear a; rename b into a. + rewrite <- prime_alt in Ha; destruct Ha as (Ha,Ha'). + assert (H' : 1 < a) by now apply (Z.square_lt_simpl_nonneg 1). + apply (Ha' a). + + split; trivial. + rewrite <- (Z.mul_1_l a) at 1. apply Z.mul_lt_mono_pos_r; omega. + + exists a; auto. Qed. Theorem prime_div_prime: forall p q, prime p -> prime q -> (p | q) -> p = q. Proof. intros p q H H1 H2; - assert (Hp: 0 < p); try apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. - assert (Hq: 0 < q); try apply Zlt_le_trans with 2; try apply prime_ge_2; auto with zarith. + assert (Hp: 0 < p); try apply Z.lt_le_trans with 2; try apply prime_ge_2; auto with zarith. + assert (Hq: 0 < q); try apply Z.lt_le_trans with 2; try apply prime_ge_2; auto with zarith. case prime_divisors with (2 := H2); auto. intros H4; contradict Hp; subst; auto with zarith. intros [H4| [H4 | H4]]; subst; auto. @@ -744,7 +735,7 @@ Qed. (** we now prove that [Z.gcd] is indeed a gcd in the sense of [Zis_gcd]. *) -Notation Zgcd_is_pos := Z.gcd_nonneg (only parsing). +Notation Zgcd_is_pos := Z.gcd_nonneg (compat "8.3"). Lemma Zgcd_is_gcd : forall a b, Zis_gcd a b (Z.gcd a b). Proof. @@ -770,15 +761,15 @@ Theorem Zis_gcd_gcd: forall a b c : Z, 0 <= c -> Zis_gcd a b c -> Z.gcd a b = c. Proof. intros a b c H1 H2. - case (Zis_gcd_uniqueness_apart_sign a b c (Zgcd a b)); auto. + case (Zis_gcd_uniqueness_apart_sign a b c (Z.gcd a b)); auto. apply Zgcd_is_gcd; auto. Z.le_elim H1. - generalize (Z.gcd_nonneg a b); auto with zarith. - subst. now case (Z.gcd a b). + - generalize (Z.gcd_nonneg a b); auto with zarith. + - subst. now case (Z.gcd a b). Qed. -Notation Zgcd_inv_0_l := Z.gcd_eq_0_l (only parsing). -Notation Zgcd_inv_0_r := Z.gcd_eq_0_r (only parsing). +Notation Zgcd_inv_0_l := Z.gcd_eq_0_l (compat "8.3"). +Notation Zgcd_inv_0_r := Z.gcd_eq_0_r (compat "8.3"). Theorem Zgcd_div_swap0 : forall a b : Z, 0 < Z.gcd a b -> @@ -788,8 +779,8 @@ Proof. intros a b Hg Hb. assert (F := Zgcd_is_gcd a b); inversion F as [F1 F2 F3]. pattern b at 2; rewrite (Zdivide_Zdiv_eq (Z.gcd a b) b); auto. - repeat rewrite Zmult_assoc; f_equal. - rewrite Zmult_comm. + repeat rewrite Z.mul_assoc; f_equal. + rewrite Z.mul_comm. rewrite <- Zdivide_Zdiv_eq; auto. Qed. @@ -800,42 +791,42 @@ Theorem Zgcd_div_swap : forall a b c : Z, Proof. intros a b c Hg Hb. assert (F := Zgcd_is_gcd a b); inversion F as [F1 F2 F3]. - pattern b at 2; rewrite (Zdivide_Zdiv_eq (Zgcd a b) b); auto. - repeat rewrite Zmult_assoc; f_equal. + pattern b at 2; rewrite (Zdivide_Zdiv_eq (Z.gcd a b) b); auto. + repeat rewrite Z.mul_assoc; f_equal. rewrite Zdivide_Zdiv_eq_2; auto. - repeat rewrite <- Zmult_assoc; f_equal. - rewrite Zmult_comm. + repeat rewrite <- Z.mul_assoc; f_equal. + rewrite Z.mul_comm. rewrite <- Zdivide_Zdiv_eq; auto. Qed. -Notation Zgcd_comm := Z.gcd_comm (only parsing). +Notation Zgcd_comm := Z.gcd_comm (compat "8.3"). -Lemma Zgcd_ass a b c : Zgcd (Zgcd a b) c = Zgcd a (Zgcd b c). +Lemma Zgcd_ass a b c : Z.gcd (Z.gcd a b) c = Z.gcd a (Z.gcd b c). Proof. symmetry. apply Z.gcd_assoc. Qed. -Notation Zgcd_Zabs := Z.gcd_abs_l (only parsing). -Notation Zgcd_0 := Z.gcd_0_r (only parsing). -Notation Zgcd_1 := Z.gcd_1_r (only parsing). +Notation Zgcd_Zabs := Z.gcd_abs_l (compat "8.3"). +Notation Zgcd_0 := Z.gcd_0_r (compat "8.3"). +Notation Zgcd_1 := Z.gcd_1_r (compat "8.3"). -Hint Resolve Zgcd_0 Zgcd_1 : zarith. +Hint Resolve Z.gcd_0_r Z.gcd_1_r : zarith. Theorem Zgcd_1_rel_prime : forall a b, Z.gcd a b = 1 <-> rel_prime a b. Proof. unfold rel_prime; split; intro H. rewrite <- H; apply Zgcd_is_gcd. - case (Zis_gcd_unique a b (Zgcd a b) 1); auto. + case (Zis_gcd_unique a b (Z.gcd a b) 1); auto. apply Zgcd_is_gcd. - intros H2; absurd (0 <= Zgcd a b); auto with zarith. - generalize (Zgcd_is_pos a b); auto with zarith. + intros H2; absurd (0 <= Z.gcd a b); auto with zarith. + generalize (Z.gcd_nonneg a b); auto with zarith. Qed. Definition rel_prime_dec: forall a b, { rel_prime a b }+{ ~ rel_prime a b }. Proof. - intros a b; case (Z_eq_dec (Zgcd a b) 1); intros H1. + intros a b; case (Z.eq_dec (Z.gcd a b) 1); intros H1. left; apply -> Zgcd_1_rel_prime; auto. right; contradict H1; apply <- Zgcd_1_rel_prime; auto. Defined. @@ -853,25 +844,24 @@ Proof. intros x Hx IH; destruct IH as [F|E]. destruct (rel_prime_dec x p) as [Y|N]. left; intros n [HH1 HH2]. - case (Zgt_succ_gt_or_eq x n); auto with zarith. - intros HH3; subst x; auto. - case (Z_lt_dec 1 x); intros HH1. - right; exists x; split; auto with zarith. - left; intros n [HHH1 HHH2]; contradict HHH1; auto with zarith. - right; destruct E as (n,((H0,H2),H3)); exists n; auto with zarith. + rewrite Z.lt_succ_r in HH2. + Z.le_elim HH2; subst; auto with zarith. + - case (Z_lt_dec 1 x); intros HH1. + * right; exists x; split; auto with zarith. + * left; intros n [HHH1 HHH2]; contradict HHH1; auto with zarith. + - right; destruct E as (n,((H0,H2),H3)); exists n; auto with zarith. Defined. Definition prime_dec: forall p, { prime p }+{ ~ prime p }. Proof. intros p; case (Z_lt_dec 1 p); intros H1. - case (prime_dec_aux p p); intros H2. - left; apply prime_intro; auto. - intros n [Hn1 Hn2]; case Zle_lt_or_eq with ( 1 := Hn1 ); auto. - intros HH; subst n. - red; apply Zis_gcd_intro; auto with zarith. - right; intros H3; inversion_clear H3 as [Hp1 Hp2]. - case H2; intros n [Hn1 Hn2]; case Hn2; auto with zarith. - right; intros H3; inversion_clear H3 as [Hp1 Hp2]; case H1; auto. + + case (prime_dec_aux p p); intros H2. + * left; apply prime_intro; auto. + intros n (Hn1,Hn2). Z.le_elim Hn1; auto; subst n. + constructor; auto with zarith. + * right; intros H3; inversion_clear H3 as [Hp1 Hp2]. + case H2; intros n [Hn1 Hn2]; case Hn2; auto with zarith. + + right; intros H3; inversion_clear H3 as [Hp1 Hp2]; case H1; auto. Defined. Theorem not_prime_divide: @@ -879,29 +869,16 @@ Theorem not_prime_divide: Proof. intros p Hp Hp1. case (prime_dec_aux p p); intros H1. - elim Hp1; constructor; auto. - intros n [Hn1 Hn2]. - case Zle_lt_or_eq with ( 1 := Hn1 ); auto with zarith. - intros H2; subst n; red; apply Zis_gcd_intro; auto with zarith. - case H1; intros n [Hn1 Hn2]. - generalize (Zgcd_is_pos n p); intros Hpos. - case (Zle_lt_or_eq 0 (Zgcd n p)); auto with zarith; intros H3. - case (Zle_lt_or_eq 1 (Zgcd n p)); auto with zarith; intros H4. - exists (Zgcd n p); split; auto. - split; auto. - apply Zle_lt_trans with n; auto with zarith. - generalize (Zgcd_is_gcd n p); intros tmp; inversion_clear tmp as [Hr1 Hr2 Hr3]. - case Hr1; intros q Hq. - case (Zle_or_lt q 0); auto with zarith; intros Ht. - absurd (n <= 0 * Zgcd n p) ; auto with zarith. - pattern n at 1; rewrite Hq; auto with zarith. - apply Zle_trans with (1 * Zgcd n p); auto with zarith. - pattern n at 2; rewrite Hq; auto with zarith. - generalize (Zgcd_is_gcd n p); intros Ht; inversion Ht; auto. - case Hn2; red. - rewrite H4; apply Zgcd_is_gcd. - generalize (Zgcd_is_gcd n p); rewrite <- H3; intros tmp; - inversion_clear tmp as [Hr1 Hr2 Hr3]. - absurd (n = 0); auto with zarith. - case Hr1; auto with zarith. + - elim Hp1; constructor; auto. + intros n (Hn1,Hn2). + Z.le_elim Hn1; auto with zarith. + subst n; constructor; auto with zarith. + - case H1; intros n (Hn1,Hn2). + destruct (Z_0_1_more _ (Z.gcd_nonneg n p)) as [H|[H|H]]. + + exfalso. apply Z.gcd_eq_0_l in H. omega. + + elim Hn2. red. rewrite <- H. apply Zgcd_is_gcd. + + exists (Z.gcd n p); split; [ split; auto | apply Z.gcd_divide_r ]. + apply Z.le_lt_trans with n; auto with zarith. + apply Z.divide_pos_le; auto with zarith. + apply Z.gcd_divide_l. Qed. diff --git a/theories/ZArith/Zorder.v b/theories/ZArith/Zorder.v index a8cd69bb..b1d1f8b5 100644 --- a/theories/ZArith/Zorder.v +++ b/theories/ZArith/Zorder.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -38,9 +38,9 @@ Qed. (**********************************************************************) (** * Decidability of equality and order on Z *) -Notation dec_eq := Z.eq_decidable (only parsing). -Notation dec_Zle := Z.le_decidable (only parsing). -Notation dec_Zlt := Z.lt_decidable (only parsing). +Notation dec_eq := Z.eq_decidable (compat "8.3"). +Notation dec_Zle := Z.le_decidable (compat "8.3"). +Notation dec_Zlt := Z.lt_decidable (compat "8.3"). Theorem dec_Zne n m : decidable (Zne n m). Proof. @@ -64,12 +64,12 @@ Qed. (** * Relating strict and large orders *) -Notation Zgt_lt := Z.gt_lt (only parsing). -Notation Zlt_gt := Z.lt_gt (only parsing). -Notation Zge_le := Z.ge_le (only parsing). -Notation Zle_ge := Z.le_ge (only parsing). -Notation Zgt_iff_lt := Z.gt_lt_iff (only parsing). -Notation Zge_iff_le := Z.ge_le_iff (only parsing). +Notation Zgt_lt := Z.gt_lt (compat "8.3"). +Notation Zlt_gt := Z.lt_gt (compat "8.3"). +Notation Zge_le := Z.ge_le (compat "8.3"). +Notation Zle_ge := Z.le_ge (compat "8.3"). +Notation Zgt_iff_lt := Z.gt_lt_iff (compat "8.3"). +Notation Zge_iff_le := Z.ge_le_iff (compat "8.3"). Lemma Zle_not_lt n m : n <= m -> ~ m < n. Proof. @@ -121,18 +121,18 @@ Qed. (** Reflexivity *) -Notation Zle_refl := Z.le_refl (only parsing). -Notation Zeq_le := Z.eq_le_incl (only parsing). +Notation Zle_refl := Z.le_refl (compat "8.3"). +Notation Zeq_le := Z.eq_le_incl (compat "8.3"). Hint Resolve Z.le_refl: zarith. (** Antisymmetry *) -Notation Zle_antisym := Z.le_antisymm (only parsing). +Notation Zle_antisym := Z.le_antisymm (compat "8.3"). (** Asymmetry *) -Notation Zlt_asym := Z.lt_asymm (only parsing). +Notation Zlt_asym := Z.lt_asymm (compat "8.3"). Lemma Zgt_asym n m : n > m -> ~ m > n. Proof. @@ -141,8 +141,8 @@ Qed. (** Irreflexivity *) -Notation Zlt_irrefl := Z.lt_irrefl (only parsing). -Notation Zlt_not_eq := Z.lt_neq (only parsing). +Notation Zlt_irrefl := Z.lt_irrefl (compat "8.3"). +Notation Zlt_not_eq := Z.lt_neq (compat "8.3"). Lemma Zgt_irrefl n : ~ n > n. Proof. @@ -151,8 +151,8 @@ Qed. (** Large = strict or equal *) -Notation Zlt_le_weak := Z.lt_le_incl (only parsing). -Notation Zle_lt_or_eq_iff := Z.lt_eq_cases (only parsing). +Notation Zlt_le_weak := Z.lt_le_incl (compat "8.3"). +Notation Zle_lt_or_eq_iff := Z.lt_eq_cases (compat "8.3"). Lemma Zle_lt_or_eq n m : n <= m -> n < m \/ n = m. Proof. @@ -161,19 +161,21 @@ Qed. (** Dichotomy *) -Notation Zle_or_lt := Z.le_gt_cases (only parsing). +Notation Zle_or_lt := Z.le_gt_cases (compat "8.3"). (** Transitivity of strict orders *) -Notation Zlt_trans := Z.lt_trans (only parsing). +Notation Zlt_trans := Z.lt_trans (compat "8.3"). -Lemma Zgt_trans : forall n m p:Z, n > m -> m > p -> n > p. -Proof Zcompare_Gt_trans. +Lemma Zgt_trans n m p : n > m -> m > p -> n > p. +Proof. + Z.swap_greater. intros; now transitivity m. +Qed. (** Mixed transitivity *) -Notation Zlt_le_trans := Z.lt_le_trans (only parsing). -Notation Zle_lt_trans := Z.le_lt_trans (only parsing). +Notation Zlt_le_trans := Z.lt_le_trans (compat "8.3"). +Notation Zle_lt_trans := Z.le_lt_trans (compat "8.3"). Lemma Zle_gt_trans n m p : m <= n -> m > p -> n > p. Proof. @@ -187,7 +189,7 @@ Qed. (** Transitivity of large orders *) -Notation Zle_trans := Z.le_trans (only parsing). +Notation Zle_trans := Z.le_trans (compat "8.3"). Lemma Zge_trans n m p : n >= m -> m >= p -> n >= p. Proof. @@ -238,8 +240,8 @@ Qed. (** Special base instances of order *) -Notation Zlt_succ := Z.lt_succ_diag_r (only parsing). -Notation Zlt_pred := Z.lt_pred_l (only parsing). +Notation Zlt_succ := Z.lt_succ_diag_r (compat "8.3"). +Notation Zlt_pred := Z.lt_pred_l (compat "8.3"). Lemma Zgt_succ n : Z.succ n > n. Proof. @@ -253,8 +255,8 @@ Qed. (** Relating strict and large order using successor or predecessor *) -Notation Zlt_succ_r := Z.lt_succ_r (only parsing). -Notation Zle_succ_l := Z.le_succ_l (only parsing). +Notation Zlt_succ_r := Z.lt_succ_r (compat "8.3"). +Notation Zle_succ_l := Z.le_succ_l (compat "8.3"). Lemma Zgt_le_succ n m : m > n -> Z.succ n <= m. Proof. @@ -293,10 +295,10 @@ Qed. (** Weakening order *) -Notation Zle_succ := Z.le_succ_diag_r (only parsing). -Notation Zle_pred := Z.le_pred_l (only parsing). -Notation Zlt_lt_succ := Z.lt_lt_succ_r (only parsing). -Notation Zle_le_succ := Z.le_le_succ_r (only parsing). +Notation Zle_succ := Z.le_succ_diag_r (compat "8.3"). +Notation Zle_pred := Z.le_pred_l (compat "8.3"). +Notation Zlt_lt_succ := Z.lt_lt_succ_r (compat "8.3"). +Notation Zle_le_succ := Z.le_le_succ_r (compat "8.3"). Lemma Zle_succ_le n m : Z.succ n <= m -> n <= m. Proof. @@ -304,7 +306,7 @@ Proof. Qed. Hint Resolve Z.le_succ_diag_r: zarith. -Hint Resolve Zle_le_succ: zarith. +Hint Resolve Z.le_le_succ_r: zarith. (** Relating order wrt successor and order wrt predecessor *) @@ -332,8 +334,8 @@ Qed. (** Special cases of ordered integers *) -Notation Zlt_0_1 := Z.lt_0_1 (only parsing). -Notation Zle_0_1 := Z.le_0_1 (only parsing). +Notation Zlt_0_1 := Z.lt_0_1 (compat "8.3"). +Notation Zle_0_1 := Z.le_0_1 (compat "8.3"). Lemma Zle_neg_pos : forall p q:positive, Zneg p <= Zpos q. Proof. @@ -345,7 +347,7 @@ Proof. easy. Qed. -(* weaker but useful (in [Zpower] for instance) *) +(* weaker but useful (in [Z.pow] for instance) *) Lemma Zle_0_pos : forall p:positive, 0 <= Zpos p. Proof. easy. @@ -361,7 +363,7 @@ Proof. induction n; simpl; intros. apply Z.le_refl. easy. Qed. -Hint Immediate Zeq_le: zarith. +Hint Immediate Z.eq_le_incl: zarith. (** Derived lemma *) @@ -373,10 +375,10 @@ Qed. (** ** Addition *) (** Compatibility of addition wrt to order *) -Notation Zplus_lt_le_compat := Z.add_lt_le_mono (only parsing). -Notation Zplus_le_lt_compat := Z.add_le_lt_mono (only parsing). -Notation Zplus_le_compat := Z.add_le_mono (only parsing). -Notation Zplus_lt_compat := Z.add_lt_mono (only parsing). +Notation Zplus_lt_le_compat := Z.add_lt_le_mono (compat "8.3"). +Notation Zplus_le_lt_compat := Z.add_le_lt_mono (compat "8.3"). +Notation Zplus_le_compat := Z.add_le_mono (compat "8.3"). +Notation Zplus_lt_compat := Z.add_lt_mono (compat "8.3"). Lemma Zplus_gt_compat_l n m p : n > m -> p + n > p + m. Proof. @@ -410,7 +412,7 @@ Qed. (** Compatibility of addition wrt to being positive *) -Notation Zplus_le_0_compat := Z.add_nonneg_nonneg (only parsing). +Notation Zplus_le_0_compat := Z.add_nonneg_nonneg (compat "8.3"). (** Simplification of addition wrt to order *) @@ -568,9 +570,9 @@ Qed. (** Compatibility of multiplication by a positive wrt to being positive *) -Notation Zmult_le_0_compat := Z.mul_nonneg_nonneg (only parsing). -Notation Zmult_lt_0_compat := Z.mul_pos_pos (only parsing). -Notation Zmult_lt_O_compat := Z.mul_pos_pos (only parsing). +Notation Zmult_le_0_compat := Z.mul_nonneg_nonneg (compat "8.3"). +Notation Zmult_lt_0_compat := Z.mul_pos_pos (compat "8.3"). +Notation Zmult_lt_O_compat := Z.mul_pos_pos (compat "8.3"). Lemma Zmult_gt_0_compat n m : n > 0 -> m > 0 -> n * m > 0. Proof. @@ -622,9 +624,9 @@ Qed. (** * Equivalence between inequalities *) -Notation Zle_plus_swap := Z.le_add_le_sub_r (only parsing). -Notation Zlt_plus_swap := Z.lt_add_lt_sub_r (only parsing). -Notation Zlt_minus_simpl_swap := Z.lt_sub_pos (only parsing). +Notation Zle_plus_swap := Z.le_add_le_sub_r (compat "8.3"). +Notation Zlt_plus_swap := Z.lt_add_lt_sub_r (compat "8.3"). +Notation Zlt_minus_simpl_swap := Z.lt_sub_pos (compat "8.3"). Lemma Zeq_plus_swap n m p : n + p = m <-> n = m - p. Proof. diff --git a/theories/ZArith/Zpow_alt.v b/theories/ZArith/Zpow_alt.v index a90eedb4..f3eb63a8 100644 --- a/theories/ZArith/Zpow_alt.v +++ b/theories/ZArith/Zpow_alt.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -79,5 +79,5 @@ Qed. Lemma Zpower_alt_Ppow p q : (Zpos p)^^(Zpos q) = Zpos (p^q). Proof. - now rewrite Zpower_equiv, Z.pow_Zpos. + now rewrite Zpower_equiv, Pos2Z.inj_pow. Qed. diff --git a/theories/ZArith/Zpow_def.v b/theories/ZArith/Zpow_def.v index 6f1ebc06..a1c60bf2 100644 --- a/theories/ZArith/Zpow_def.v +++ b/theories/ZArith/Zpow_def.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -14,12 +14,12 @@ Local Open Scope Z_scope. (** Nota : this file is mostly deprecated. The definition of [Z.pow] and its usual properties are now provided by module [BinInt.Z]. *) -Notation Zpower_pos := Z.pow_pos (only parsing). -Notation Zpower := Z.pow (only parsing). -Notation Zpower_0_r := Z.pow_0_r (only parsing). -Notation Zpower_succ_r := Z.pow_succ_r (only parsing). -Notation Zpower_neg_r := Z.pow_neg_r (only parsing). -Notation Zpower_Ppow := Z.pow_Zpos (only parsing). +Notation Zpower_pos := Z.pow_pos (compat "8.3"). +Notation Zpower := Z.pow (compat "8.3"). +Notation Zpower_0_r := Z.pow_0_r (compat "8.3"). +Notation Zpower_succ_r := Z.pow_succ_r (compat "8.3"). +Notation Zpower_neg_r := Z.pow_neg_r (compat "8.3"). +Notation Zpower_Ppow := Pos2Z.inj_pow (compat "8.3"). Lemma Zpower_theory : power_theory 1 Z.mul (@eq Z) Z.of_N Z.pow. Proof. diff --git a/theories/ZArith/Zpow_facts.v b/theories/ZArith/Zpow_facts.v index 27e3def4..8ff641a3 100644 --- a/theories/ZArith/Zpow_facts.v +++ b/theories/ZArith/Zpow_facts.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -29,17 +29,17 @@ Proof. now apply (Z.pow_0_l (Zpos p)). Qed. Lemma Zpower_pos_pos x p : 0 < x -> 0 < Z.pow_pos x p. Proof. intros. now apply (Z.pow_pos_nonneg x (Zpos p)). Qed. -Notation Zpower_1_r := Z.pow_1_r (only parsing). -Notation Zpower_1_l := Z.pow_1_l (only parsing). -Notation Zpower_0_l := Z.pow_0_l' (only parsing). -Notation Zpower_0_r := Z.pow_0_r (only parsing). -Notation Zpower_2 := Z.pow_2_r (only parsing). -Notation Zpower_gt_0 := Z.pow_pos_nonneg (only parsing). -Notation Zpower_ge_0 := Z.pow_nonneg (only parsing). -Notation Zpower_Zabs := Z.abs_pow (only parsing). -Notation Zpower_Zsucc := Z.pow_succ_r (only parsing). -Notation Zpower_mult := Z.pow_mul_r (only parsing). -Notation Zpower_le_monotone2 := Z.pow_le_mono_r (only parsing). +Notation Zpower_1_r := Z.pow_1_r (compat "8.3"). +Notation Zpower_1_l := Z.pow_1_l (compat "8.3"). +Notation Zpower_0_l := Z.pow_0_l' (compat "8.3"). +Notation Zpower_0_r := Z.pow_0_r (compat "8.3"). +Notation Zpower_2 := Z.pow_2_r (compat "8.3"). +Notation Zpower_gt_0 := Z.pow_pos_nonneg (compat "8.3"). +Notation Zpower_ge_0 := Z.pow_nonneg (compat "8.3"). +Notation Zpower_Zabs := Z.abs_pow (compat "8.3"). +Notation Zpower_Zsucc := Z.pow_succ_r (compat "8.3"). +Notation Zpower_mult := Z.pow_mul_r (compat "8.3"). +Notation Zpower_le_monotone2 := Z.pow_le_mono_r (compat "8.3"). Theorem Zpower_le_monotone a b c : 0 < a -> 0 <= b <= c -> a^b <= a^c. @@ -85,15 +85,15 @@ Proof. assert (Hn := Nat2Z.is_nonneg n). destruct p; simpl Pos.size_nat. - specialize IHn with p. - rewrite Z.pos_xI, Nat2Z.inj_succ, Z.pow_succ_r; omega. + rewrite Pos2Z.inj_xI, Nat2Z.inj_succ, Z.pow_succ_r; omega. - specialize IHn with p. - rewrite Z.pos_xO, Nat2Z.inj_succ, Z.pow_succ_r; omega. + rewrite Pos2Z.inj_xO, Nat2Z.inj_succ, Z.pow_succ_r; omega. - split; auto with zarith. intros _. apply Z.pow_gt_1. easy. now rewrite Nat2Z.inj_succ, Z.lt_succ_r. Qed. -(** * Zpower and modulo *) +(** * Z.pow and modulo *) Theorem Zpower_mod p q n : 0 < n -> (p^q) mod n = ((p mod n)^q) mod n. @@ -106,7 +106,7 @@ Proof. - rewrite !Z.pow_neg_r; auto with zarith. Qed. -(** A direct way to compute Zpower modulo **) +(** A direct way to compute Z.pow modulo **) Fixpoint Zpow_mod_pos (a: Z)(m: positive)(n : Z) : Z := match m with @@ -231,9 +231,9 @@ Proof. exists n; destruct H; rewrite Z.mul_0_r in H; auto. Qed. -(** * Zsquare: a direct definition of [z^2] *) +(** * Z.square: a direct definition of [z^2] *) -Notation Psquare := Pos.square (only parsing). -Notation Zsquare := Z.square (only parsing). -Notation Psquare_correct := Pos.square_spec (only parsing). -Notation Zsquare_correct := Z.square_spec (only parsing). +Notation Psquare := Pos.square (compat "8.3"). +Notation Zsquare := Z.square (compat "8.3"). +Notation Psquare_correct := Pos.square_spec (compat "8.3"). +Notation Zsquare_correct := Z.square_spec (compat "8.3"). diff --git a/theories/ZArith/Zpower.v b/theories/ZArith/Zpower.v index 5052d01a..0d9b08d6 100644 --- a/theories/ZArith/Zpower.v +++ b/theories/ZArith/Zpower.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -78,7 +78,7 @@ Proof. Qed. Hint Immediate Zpower_nat_is_exp Zpower_pos_is_exp : zarith. -Hint Unfold Zpower_pos Zpower_nat: zarith. +Hint Unfold Z.pow_pos Zpower_nat: zarith. Theorem Zpower_exp x n m : n >= 0 -> m >= 0 -> x ^ (n + m) = x ^ n * x ^ m. @@ -181,7 +181,7 @@ Section Powers_of_2. Qed. Theorem shift_pos_correct p x : - Zpos (shift_pos p x) = Zpower_pos 2 p * Zpos x. + Zpos (shift_pos p x) = Z.pow_pos 2 p * Zpos x. Proof. now rewrite shift_pos_nat, Zpower_pos_nat, shift_nat_correct. Qed. @@ -266,13 +266,13 @@ Section power_div_with_rest. apply Pos.iter_invariant; [|omega]. intros ((q,r),d) (H,H'). unfold Zdiv_rest_aux. destruct q as [ |[q|q| ]|[q|q| ]]; try omega. - - rewrite Z.pos_xI, Z.mul_add_distr_r in H. + - rewrite Pos2Z.inj_xI, Z.mul_add_distr_r in H. rewrite Z.mul_shuffle3, Z.mul_assoc. omega. - - rewrite Z.pos_xO in H. + - rewrite Pos2Z.inj_xO in H. rewrite Z.mul_shuffle3, Z.mul_assoc. omega. - - rewrite Z.neg_xI, Z.mul_sub_distr_r in H. + - rewrite Pos2Z.neg_xI, Z.mul_sub_distr_r in H. rewrite Z.mul_sub_distr_r, Z.mul_shuffle3, Z.mul_assoc. omega. - - rewrite Z.neg_xO in H. + - rewrite Pos2Z.neg_xO in H. rewrite Z.mul_shuffle3, Z.mul_assoc. omega. Qed. diff --git a/theories/ZArith/Zquot.v b/theories/ZArith/Zquot.v index 9a95669f..c02f0ae6 100644 --- a/theories/ZArith/Zquot.v +++ b/theories/ZArith/Zquot.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -11,51 +11,95 @@ Require Import Nnat ZArith_base ROmega ZArithRing Zdiv Morphisms. Local Open Scope Z_scope. (** This file provides results about the Round-Toward-Zero Euclidean - division [Zquotrem], whose projections are [Zquot] and [Zrem]. - Definition of this division can be found in file [BinIntDef]. + division [Z.quotrem], whose projections are [Z.quot] (noted ÷) + and [Z.rem]. - This division and the one defined in Zdiv agree only on positive - numbers. Otherwise, Zdiv performs Round-Toward-Bottom (a.k.a Floor). + This division and [Z.div] agree only on positive numbers. + Otherwise, [Z.div] performs Round-Toward-Bottom (a.k.a Floor). - The current approach is compatible with the division of usual + This [Z.quot] is compatible with the division of usual programming languages such as Ocaml. In addition, it has nicer properties with respect to opposite and other usual operations. + + The definition of this division is now in file [BinIntDef], + while most of the results about here are now in the main module + [BinInt.Z], thanks to the generic "Numbers" layer. Remain here: + + - some compatibility notation for old names. + + - some extra results with less preconditions (in particular + exploiting the arbitrary value of division by 0). *) -(** * Relation between division on N and on Z. *) +Notation Ndiv_Zquot := N2Z.inj_quot (compat "8.3"). +Notation Nmod_Zrem := N2Z.inj_rem (compat "8.3"). +Notation Z_quot_rem_eq := Z.quot_rem' (compat "8.3"). +Notation Zrem_lt := Z.rem_bound_abs (compat "8.3"). +Notation Zquot_unique := Z.quot_unique (compat "8.3"). +Notation Zrem_unique := Z.rem_unique (compat "8.3"). +Notation Zrem_1_r := Z.rem_1_r (compat "8.3"). +Notation Zquot_1_r := Z.quot_1_r (compat "8.3"). +Notation Zrem_1_l := Z.rem_1_l (compat "8.3"). +Notation Zquot_1_l := Z.quot_1_l (compat "8.3"). +Notation Z_quot_same := Z.quot_same (compat "8.3"). +Notation Z_quot_mult := Z.quot_mul (compat "8.3"). +Notation Zquot_small := Z.quot_small (compat "8.3"). +Notation Zrem_small := Z.rem_small (compat "8.3"). +Notation Zquot2_quot := Zquot2_quot (compat "8.3"). + +(** Particular values taken for [a÷0] and [(Z.rem a 0)]. + We avise to not rely on these arbitrary values. *) + +Lemma Zquot_0_r a : a ÷ 0 = 0. +Proof. now destruct a. Qed. + +Lemma Zrem_0_r a : Z.rem a 0 = a. +Proof. now destruct a. Qed. + +(** The following results are expressed without the [b<>0] condition + whenever possible. *) + +Lemma Zrem_0_l a : Z.rem 0 a = 0. +Proof. now destruct a. Qed. + +Lemma Zquot_0_l a : 0÷a = 0. +Proof. now destruct a. Qed. + +Hint Resolve Zrem_0_l Zrem_0_r Zquot_0_l Zquot_0_r Z.quot_1_r Z.rem_1_r + : zarith. -Lemma Ndiv_Zquot : forall a b:N, - Z_of_N (a/b) = (Z_of_N a ÷ Z_of_N b). -Proof. - intros. - destruct a; destruct b; simpl; auto. - unfold N.div, Z.quot; simpl. destruct N.pos_div_eucl; auto. -Qed. +Ltac zero_or_not a := + destruct (Z.eq_decidable a 0) as [->|?]; + [rewrite ?Zquot_0_l, ?Zrem_0_l, ?Zquot_0_r, ?Zrem_0_r; + auto with zarith|]. -Lemma Nmod_Zrem : forall a b:N, - Z.of_N (a mod b) = Z.rem (Z.of_N a) (Z.of_N b). -Proof. - intros. - destruct a; destruct b; simpl; auto. - unfold N.modulo, Z.rem; simpl; destruct N.pos_div_eucl; auto. -Qed. +Lemma Z_rem_same a : Z.rem a a = 0. +Proof. zero_or_not a. now apply Z.rem_same. Qed. -(** * Characterization of this euclidean division. *) +Lemma Z_rem_mult a b : Z.rem (a*b) b = 0. +Proof. zero_or_not b. now apply Z.rem_mul. Qed. -(** First, the usual equation [a=q*b+r]. Notice that [a mod 0] - has been chosen to be [a], so this equation holds even for [b=0]. -*) +(** * Division and Opposite *) -Notation Z_quot_rem_eq := Z.quot_rem' (only parsing). +(* The precise equalities that are invalid with "historic" Zdiv. *) -(** Then, the inequalities constraining the remainder: - The remainder is bounded by the divisor, in term of absolute values *) +Theorem Zquot_opp_l a b : (-a)÷b = -(a÷b). +Proof. zero_or_not b. now apply Z.quot_opp_l. Qed. -Theorem Zrem_lt : forall a b:Z, b<>0 -> - Z.abs (Z.rem a b) < Z.abs b. -Proof. - apply Z.rem_bound_abs. -Qed. +Theorem Zquot_opp_r a b : a÷(-b) = -(a÷b). +Proof. zero_or_not b. now apply Z.quot_opp_r. Qed. + +Theorem Zrem_opp_l a b : Z.rem (-a) b = -(Z.rem a b). +Proof. zero_or_not b. now apply Z.rem_opp_l. Qed. + +Theorem Zrem_opp_r a b : Z.rem a (-b) = Z.rem a b. +Proof. zero_or_not b. now apply Z.rem_opp_r. Qed. + +Theorem Zquot_opp_opp a b : (-a)÷(-b) = a÷b. +Proof. zero_or_not b. now apply Z.quot_opp_opp. Qed. + +Theorem Zrem_opp_opp a b : Z.rem (-a) (-b) = -(Z.rem a b). +Proof. zero_or_not b. now apply Z.rem_opp_opp. Qed. (** The sign of the remainder is the one of [a]. Due to the possible nullity of [a], a general result is to be stated in the following form: @@ -63,41 +107,33 @@ Qed. Theorem Zrem_sgn a b : 0 <= Z.sgn (Z.rem a b) * Z.sgn a. Proof. - destruct b as [ |b|b]; destruct a as [ |a|a]; simpl; auto with zarith; - unfold Z.rem, Z.quotrem; destruct N.pos_div_eucl; - simpl; destruct n0; simpl; auto with zarith. + zero_or_not b. + - apply Z.square_nonneg. + - zero_or_not (Z.rem a b). + rewrite Z.rem_sign_nz; trivial. apply Z.square_nonneg. Qed. (** This can also be said in a simplier way: *) Theorem Zrem_sgn2 a b : 0 <= (Z.rem a b) * a. Proof. - rewrite <-Z.sgn_nonneg, Z.sgn_mul; apply Zrem_sgn. + zero_or_not b. + - apply Z.square_nonneg. + - now apply Z.rem_sign_mul. Qed. -(** Reformulation of [Zquot_lt] and [Zrem_sgn] in 2 - then 4 particular cases. *) +(** Reformulation of [Z.rem_bound_abs] in 2 then 4 particular cases. *) Theorem Zrem_lt_pos a b : 0<=a -> b<>0 -> 0 <= Z.rem a b < Z.abs b. Proof. - intros. - assert (0 <= Z.rem a b). - generalize (Zrem_sgn a b). - destruct (Zle_lt_or_eq 0 a H). - rewrite <- Zsgn_pos in H1; rewrite H1. romega with *. - subst a; simpl; auto. - generalize (Zrem_lt a b H0); romega with *. + intros; generalize (Z.rem_nonneg a b) (Z.rem_bound_abs a b); + romega with *. Qed. Theorem Zrem_lt_neg a b : a<=0 -> b<>0 -> -Z.abs b < Z.rem a b <= 0. Proof. - intros. - assert (Z.rem a b <= 0). - generalize (Zrem_sgn a b). - destruct (Zle_lt_or_eq a 0 H). - rewrite <- Zsgn_neg in H1; rewrite H1; romega with *. - subst a; simpl; auto. - generalize (Zrem_lt a b H0); romega with *. + intros; generalize (Z.rem_nonpos a b) (Z.rem_bound_abs a b); + romega with *. Qed. Theorem Zrem_lt_pos_pos a b : 0<=a -> 0<b -> 0 <= Z.rem a b < b. @@ -120,45 +156,6 @@ Proof. intros; generalize (Zrem_lt_neg a b); romega with *. Qed. -(** * Division and Opposite *) - -(* The precise equalities that are invalid with "historic" Zdiv. *) - -Theorem Zquot_opp_l a b : (-a)÷b = -(a÷b). -Proof. - destruct a; destruct b; simpl; auto; - unfold Z.quot, Z.quotrem; destruct N.pos_div_eucl; simpl; auto with zarith. -Qed. - -Theorem Zquot_opp_r a b : a÷(-b) = -(a÷b). -Proof. - destruct a; destruct b; simpl; auto; - unfold Z.quot, Z.quotrem; destruct N.pos_div_eucl; simpl; auto with zarith. -Qed. - -Theorem Zrem_opp_l a b : Z.rem (-a) b = -(Z.rem a b). -Proof. - destruct a; destruct b; simpl; auto; - unfold Z.rem, Z.quotrem; destruct N.pos_div_eucl; simpl; auto with zarith. -Qed. - -Theorem Zrem_opp_r a b : Z.rem a (-b) = Z.rem a b. -Proof. - destruct a; destruct b; simpl; auto; - unfold Z.rem, Z.quotrem; destruct N.pos_div_eucl; simpl; auto with zarith. -Qed. - -Theorem Zquot_opp_opp a b : (-a)÷(-b) = a÷b. -Proof. - destruct a; destruct b; simpl; auto; - unfold Z.quot, Z.quotrem; destruct N.pos_div_eucl; simpl; auto with zarith. -Qed. - -Theorem Zrem_opp_opp a b : Z.rem (-a) (-b) = -(Z.rem a b). -Proof. - destruct a; destruct b; simpl; auto; - unfold Z.rem, Z.quotrem; destruct N.pos_div_eucl; simpl; auto with zarith. -Qed. (** * Unicity results *) @@ -172,170 +169,93 @@ Lemma Remainder_equiv : forall a b r, Remainder a b r <-> Remainder_alt a b r. Proof. unfold Remainder, Remainder_alt; intuition. - romega with *. - romega with *. - rewrite <-(Zmult_opp_opp). - apply Zmult_le_0_compat; romega. - assert (0 <= Z.sgn r * Z.sgn a) by (rewrite <-Z.sgn_mul, Z.sgn_nonneg; auto). - destruct r; simpl Z.sgn in *; romega with *. + - romega with *. + - romega with *. + - rewrite <-(Z.mul_opp_opp). apply Z.mul_nonneg_nonneg; romega. + - assert (0 <= Z.sgn r * Z.sgn a). + { rewrite <-Z.sgn_mul, Z.sgn_nonneg; auto. } + destruct r; simpl Z.sgn in *; romega with *. Qed. -Theorem Zquot_mod_unique_full: - forall a b q r, Remainder a b r -> - a = b*q + r -> q = a÷b /\ r = Z.rem a b. +Theorem Zquot_mod_unique_full a b q r : + Remainder a b r -> a = b*q + r -> q = a÷b /\ r = Z.rem a b. Proof. destruct 1 as [(H,H0)|(H,H0)]; intros. apply Zdiv_mod_unique with b; auto. apply Zrem_lt_pos; auto. romega with *. - rewrite <- H1; apply Z_quot_rem_eq. + rewrite <- H1; apply Z.quot_rem'. - rewrite <- (Zopp_involutive a). + rewrite <- (Z.opp_involutive a). rewrite Zquot_opp_l, Zrem_opp_l. generalize (Zdiv_mod_unique b (-q) (-a÷b) (-r) (Z.rem (-a) b)). generalize (Zrem_lt_pos (-a) b). - rewrite <-Z_quot_rem_eq, <-Zopp_mult_distr_r, <-Zopp_plus_distr, <-H1. + rewrite <-Z.quot_rem', Z.mul_opp_r, <-Z.opp_add_distr, <-H1. romega with *. Qed. -Theorem Zquot_unique_full: - forall a b q r, Remainder a b r -> - a = b*q + r -> q = a÷b. +Theorem Zquot_unique_full a b q r : + Remainder a b r -> a = b*q + r -> q = a÷b. Proof. intros; destruct (Zquot_mod_unique_full a b q r); auto. Qed. -Theorem Zquot_unique: - forall a b q r, 0 <= a -> 0 <= r < b -> - a = b*q + r -> q = a÷b. -Proof. exact Z.quot_unique. Qed. - -Theorem Zrem_unique_full: - forall a b q r, Remainder a b r -> - a = b*q + r -> r = Z.rem a b. +Theorem Zrem_unique_full a b q r : + Remainder a b r -> a = b*q + r -> r = Z.rem a b. Proof. intros; destruct (Zquot_mod_unique_full a b q r); auto. Qed. -Theorem Zrem_unique: - forall a b q r, 0 <= a -> 0 <= r < b -> - a = b*q + r -> r = Z.rem a b. -Proof. exact Z.rem_unique. Qed. - -(** * Basic values of divisions and modulo. *) - -Lemma Zrem_0_l: forall a, Z.rem 0 a = 0. -Proof. - destruct a; simpl; auto. -Qed. - -Lemma Zrem_0_r: forall a, Z.rem a 0 = a. -Proof. - destruct a; simpl; auto. -Qed. - -Lemma Zquot_0_l: forall a, 0÷a = 0. -Proof. - destruct a; simpl; auto. -Qed. - -Lemma Zquot_0_r: forall a, a÷0 = 0. -Proof. - destruct a; simpl; auto. -Qed. - -Lemma Zrem_1_r: forall a, Z.rem a 1 = 0. -Proof. exact Z.rem_1_r. Qed. - -Lemma Zquot_1_r: forall a, a÷1 = a. -Proof. exact Z.quot_1_r. Qed. - -Hint Resolve Zrem_0_l Zrem_0_r Zquot_0_l Zquot_0_r Zquot_1_r Zrem_1_r - : zarith. - -Lemma Zquot_1_l: forall a, 1 < a -> 1÷a = 0. -Proof. exact Z.quot_1_l. Qed. - -Lemma Zrem_1_l: forall a, 1 < a -> Z.rem 1 a = 1. -Proof. exact Z.rem_1_l. Qed. - -Lemma Z_quot_same : forall a:Z, a<>0 -> a÷a = 1. -Proof. exact Z.quot_same. Qed. - -Ltac zero_or_not a := - destruct (Z.eq_dec a 0); - [subst; rewrite ?Zrem_0_l, ?Zquot_0_l, ?Zrem_0_r, ?Zquot_0_r; - auto with zarith|]. - -Lemma Z_rem_same : forall a, Z.rem a a = 0. -Proof. intros. zero_or_not a. apply Z.rem_same; auto. Qed. - -Lemma Z_rem_mult : forall a b, Z.rem (a*b) b = 0. -Proof. intros. zero_or_not b. apply Z.rem_mul; auto. Qed. - -Lemma Z_quot_mult : forall a b:Z, b <> 0 -> (a*b)÷b = a. -Proof. exact Z.quot_mul. Qed. - (** * Order results about Zrem and Zquot *) (* Division of positive numbers is positive. *) -Lemma Z_quot_pos: forall a b, 0 <= a -> 0 <= b -> 0 <= a÷b. +Lemma Z_quot_pos a b : 0 <= a -> 0 <= b -> 0 <= a÷b. Proof. intros. zero_or_not b. apply Z.quot_pos; auto with zarith. Qed. (** As soon as the divisor is greater or equal than 2, the division is strictly decreasing. *) -Lemma Z_quot_lt : forall a b:Z, 0 < a -> 2 <= b -> a÷b < a. +Lemma Z_quot_lt a b : 0 < a -> 2 <= b -> a÷b < a. Proof. intros. apply Z.quot_lt; auto with zarith. Qed. -(** A division of a small number by a bigger one yields zero. *) +(** [<=] is compatible with a positive division. *) -Theorem Zquot_small: forall a b, 0 <= a < b -> a÷b = 0. -Proof. exact Z.quot_small. Qed. - -(** Same situation, in term of modulo: *) - -Theorem Zrem_small: forall a n, 0 <= a < n -> Z.rem a n = a. -Proof. exact Z.rem_small. Qed. - -(** [Zge] is compatible with a positive division. *) - -Lemma Z_quot_monotone : forall a b c, 0<=c -> a<=b -> a÷c <= b÷c. +Lemma Z_quot_monotone a b c : 0<=c -> a<=b -> a÷c <= b÷c. Proof. intros. zero_or_not c. apply Z.quot_le_mono; auto with zarith. Qed. -(** With our choice of division, rounding of (a÷b) is always done toward zero: *) +(** With our choice of division, rounding of (a÷b) is always done toward 0: *) -Lemma Z_mult_quot_le : forall a b:Z, 0 <= a -> 0 <= b*(a÷b) <= a. +Lemma Z_mult_quot_le a b : 0 <= a -> 0 <= b*(a÷b) <= a. Proof. intros. zero_or_not b. apply Z.mul_quot_le; auto with zarith. Qed. -Lemma Z_mult_quot_ge : forall a b:Z, a <= 0 -> a <= b*(a÷b) <= 0. +Lemma Z_mult_quot_ge a b : a <= 0 -> a <= b*(a÷b) <= 0. Proof. intros. zero_or_not b. apply Z.mul_quot_ge; auto with zarith. Qed. (** The previous inequalities between [b*(a÷b)] and [a] are exact iff the modulo is zero. *) -Lemma Z_quot_exact_full : forall a b:Z, a = b*(a÷b) <-> Z.rem a b = 0. +Lemma Z_quot_exact_full a b : a = b*(a÷b) <-> Z.rem a b = 0. Proof. intros. zero_or_not b. intuition. apply Z.quot_exact; auto. Qed. (** A modulo cannot grow beyond its starting point. *) -Theorem Zrem_le: forall a b, 0 <= a -> 0 <= b -> Z.rem a b <= a. +Theorem Zrem_le a b : 0 <= a -> 0 <= b -> Z.rem a b <= a. Proof. intros. zero_or_not b. apply Z.rem_le; auto with zarith. Qed. (** Some additionnal inequalities about Zdiv. *) Theorem Zquot_le_upper_bound: forall a b q, 0 < b -> a <= q*b -> a÷b <= q. -Proof. intros a b q; rewrite Zmult_comm; apply Z.quot_le_upper_bound. Qed. +Proof. intros a b q; rewrite Z.mul_comm; apply Z.quot_le_upper_bound. Qed. Theorem Zquot_lt_upper_bound: forall a b q, 0 <= a -> 0 < b -> a < q*b -> a÷b < q. -Proof. intros a b q; rewrite Zmult_comm; apply Z.quot_lt_upper_bound. Qed. +Proof. intros a b q; rewrite Z.mul_comm; apply Z.quot_lt_upper_bound. Qed. Theorem Zquot_le_lower_bound: forall a b q, 0 < b -> q*b <= a -> q <= a÷b. -Proof. intros a b q; rewrite Zmult_comm; apply Z.quot_le_lower_bound. Qed. +Proof. intros a b q; rewrite Z.mul_comm; apply Z.quot_le_lower_bound. Qed. Theorem Zquot_sgn: forall a b, 0 <= Z.sgn (a÷b) * Z.sgn a * Z.sgn b. @@ -374,22 +294,22 @@ Proof. intros. zero_or_not b. apply Z.quot_mul_cancel_r; auto. Qed. Lemma Zquot_mult_cancel_l : forall a b c:Z, c<>0 -> (c*a)÷(c*b) = a÷b. Proof. - intros. rewrite (Zmult_comm c b). zero_or_not b. - rewrite (Zmult_comm b c). apply Z.quot_mul_cancel_l; auto. + intros. rewrite (Z.mul_comm c b). zero_or_not b. + rewrite (Z.mul_comm b c). apply Z.quot_mul_cancel_l; auto. Qed. Lemma Zmult_rem_distr_l: forall a b c, Z.rem (c*a) (c*b) = c * (Z.rem a b). Proof. - intros. zero_or_not c. rewrite (Zmult_comm c b). zero_or_not b. - rewrite (Zmult_comm b c). apply Z.mul_rem_distr_l; auto. + intros. zero_or_not c. rewrite (Z.mul_comm c b). zero_or_not b. + rewrite (Z.mul_comm b c). apply Z.mul_rem_distr_l; auto. Qed. Lemma Zmult_rem_distr_r: forall a b c, Z.rem (a*c) (b*c) = (Z.rem a b) * c. Proof. - intros. zero_or_not b. rewrite (Zmult_comm b c). zero_or_not c. - rewrite (Zmult_comm c b). apply Z.mul_rem_distr_r; auto. + intros. zero_or_not b. rewrite (Z.mul_comm b c). zero_or_not c. + rewrite (Z.mul_comm c b). apply Z.mul_rem_distr_r; auto. Qed. (** Operations modulo. *) @@ -424,7 +344,7 @@ Lemma Zplus_rem_idemp_r: forall a b n, Z.rem (b + Z.rem a n) n = Z.rem (b + a) n. Proof. intros. zero_or_not n. apply Z.add_rem_idemp_r; auto. - rewrite Zmult_comm; auto. + rewrite Z.mul_comm; auto. Qed. Lemma Zmult_rem_idemp_l: forall a b n, Z.rem (Z.rem a n * b) n = Z.rem (a * b) n. @@ -437,8 +357,8 @@ Proof. intros. zero_or_not n. apply Z.mul_rem_idemp_r; auto. Qed. Lemma Zquot_Zquot : forall a b c, (a÷b)÷c = a÷(b*c). Proof. - intros. zero_or_not b. rewrite Zmult_comm. zero_or_not c. - rewrite Zmult_comm. apply Z.quot_quot; auto. + intros. zero_or_not b. rewrite Z.mul_comm. zero_or_not c. + rewrite Z.mul_comm. apply Z.quot_quot; auto. Qed. (** A last inequality: *) @@ -468,28 +388,26 @@ Proof. right. destruct p; simpl; split; now auto with zarith. Qed. -Notation Zquot2_quot := Zquot2_quot (only parsing). - Lemma Zrem_odd : forall a, Z.rem a 2 = if Z.odd a then Z.sgn a else 0. Proof. intros. symmetry. - apply Zrem_unique_full with (Zquot2 a). + apply Zrem_unique_full with (Z.quot2 a). apply Zquot2_odd_remainder. apply Zquot2_odd_eqn. Qed. Lemma Zrem_even : forall a, Z.rem a 2 = if Z.even a then 0 else Z.sgn a. Proof. - intros a. rewrite Zrem_odd, Zodd_even_bool. now destruct Zeven_bool. + intros a. rewrite Zrem_odd, Zodd_even_bool. now destruct Z.even. Qed. -Lemma Zeven_rem : forall a, Z.even a = Zeq_bool (Z.rem a 2) 0. +Lemma Zeven_rem : forall a, Z.even a = Z.eqb (Z.rem a 2) 0. Proof. intros a. rewrite Zrem_even. destruct a as [ |p|p]; trivial; now destruct p. Qed. -Lemma Zodd_rem : forall a, Z.odd a = negb (Zeq_bool (Z.rem a 2) 0). +Lemma Zodd_rem : forall a, Z.odd a = negb (Z.eqb (Z.rem a 2) 0). Proof. intros a. rewrite Zrem_odd. destruct a as [ |p|p]; trivial; now destruct p. @@ -505,18 +423,17 @@ Proof. intros. apply Zdiv_mod_unique with b. apply Zrem_lt_pos; auto with zarith. - rewrite Zabs_eq; auto with *; apply Z_mod_lt; auto with *. + rewrite Z.abs_eq; auto with *; apply Z_mod_lt; auto with *. rewrite <- Z_div_mod_eq; auto with *. - symmetry; apply Z_quot_rem_eq; auto with *. + symmetry; apply Z.quot_rem; auto with *. Qed. Theorem Zquot_Zdiv_pos : forall a b, 0 <= a -> 0 <= b -> a÷b = a/b. Proof. - intros a b Ha Hb. - destruct (Zle_lt_or_eq _ _ Hb). - generalize (Zquotrem_Zdiv_eucl_pos a b Ha H); intuition. - subst; rewrite Zquot_0_r, Zdiv_0_r; reflexivity. + intros a b Ha Hb. Z.le_elim Hb. + - generalize (Zquotrem_Zdiv_eucl_pos a b Ha Hb); intuition. + - subst; now rewrite Zquot_0_r, Zdiv_0_r. Qed. Theorem Zrem_Zmod_pos : forall a b, 0 <= a -> 0 < b -> diff --git a/theories/ZArith/Zsqrt_compat.v b/theories/ZArith/Zsqrt_compat.v index 4584c3f8..a6c83241 100644 --- a/theories/ZArith/Zsqrt_compat.v +++ b/theories/ZArith/Zsqrt_compat.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -9,7 +9,7 @@ Require Import ZArithRing. Require Import Omega. Require Export ZArith_base. -Open Local Scope Z_scope. +Local Open Scope Z_scope. (** THIS FILE IS DEPRECATED @@ -32,12 +32,12 @@ Ltac compute_POS := | |- context [(Zpos (xI ?X1))] => match constr:X1 with | context [1%positive] => fail 1 - | _ => rewrite (BinInt.Zpos_xI X1) + | _ => rewrite (Pos2Z.inj_xI X1) end | |- context [(Zpos (xO ?X1))] => match constr:X1 with | context [1%positive] => fail 1 - | _ => rewrite (BinInt.Zpos_xO X1) + | _ => rewrite (Pos2Z.inj_xO X1) end end. @@ -115,7 +115,7 @@ Definition Zsqrt : fun h => match sqrtrempos p with | c_sqrt s r Heq Hint => - existS + existT (fun s:Z => {r : Z | Zpos p = s * s + r /\ s * s <= Zpos p < (s + 1) * (s + 1)}) @@ -131,10 +131,10 @@ Definition Zsqrt : {s : Z & {r : Z | Zneg p = s * s + r /\ s * s <= Zneg p < (s + 1) * (s + 1)}} - (h (refl_equal Datatypes.Gt)) + (h (eq_refl Datatypes.Gt)) | Z0 => fun h => - existS + existT (fun s:Z => {r : Z | 0 = s * s + r /\ s * s <= 0 < (s + 1) * (s + 1)}) 0 (exist @@ -149,8 +149,8 @@ Defined. Definition Zsqrt_plain (x:Z) : Z := match x with | Zpos p => - match Zsqrt (Zpos p) (Zorder.Zle_0_pos p) with - | existS s _ => s + match Zsqrt (Zpos p) (Pos2Z.is_nonneg p) with + | existT s _ => s end | Zneg p => 0 | Z0 => 0 @@ -164,12 +164,11 @@ Theorem Zsqrt_interval : 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. + intros [|p|p] Hp. + - now compute. + - unfold Zsqrt_plain. + now destruct Zsqrt as (s & r & Heq & Hint). + - now elim Hp. Qed. (** Positivity *) @@ -177,9 +176,9 @@ Qed. Theorem Zsqrt_plain_is_pos: forall n, 0 <= n -> 0 <= Zsqrt_plain n. Proof. intros n m; case (Zsqrt_interval n); auto with zarith. - intros H1 H2; case (Zle_or_lt 0 (Zsqrt_plain n)); auto. - intros H3; contradict H2; auto; apply Zle_not_lt. - apply Zle_trans with ( 2 := H1 ). + intros H1 H2; case (Z.le_gt_cases 0 (Zsqrt_plain n)); auto. + intros H3; contradict H2; auto; apply Z.le_ngt. + apply Z.le_trans with ( 2 := H1 ). replace ((Zsqrt_plain n + 1) * (Zsqrt_plain n + 1)) with (Zsqrt_plain n * Zsqrt_plain n + (2 * Zsqrt_plain n + 1)); auto with zarith. @@ -194,13 +193,13 @@ Proof. generalize (Zsqrt_plain_is_pos (a * a)); auto with zarith; intros Haa. case (Zsqrt_interval (a * a)); auto with zarith. intros H1 H2. - case (Zle_or_lt a (Zsqrt_plain (a * a))); intros H3; auto. - case Zle_lt_or_eq with (1:=H3); auto; clear H3; intros H3. - contradict H1; auto; apply Zlt_not_le; auto with zarith. - apply Zle_lt_trans with (a * Zsqrt_plain (a * a)); auto with zarith. - apply Zmult_lt_compat_r; auto with zarith. - contradict H2; auto; apply Zle_not_lt; auto with zarith. - apply Zmult_le_compat; auto with zarith. + case (Z.le_gt_cases a (Zsqrt_plain (a * a))); intros H3. + - Z.le_elim H3; auto. + contradict H1; auto; apply Z.lt_nge; auto with zarith. + apply Z.le_lt_trans with (a * Zsqrt_plain (a * a)); auto with zarith. + apply Z.mul_lt_mono_pos_r; auto with zarith. + - contradict H2; auto; apply Z.le_ngt; auto with zarith. + apply Z.mul_le_mono_nonneg; auto with zarith. Qed. (** [Zsqrt_plain] is increasing *) @@ -208,16 +207,16 @@ Qed. Theorem Zsqrt_le: forall p q, 0 <= p <= q -> Zsqrt_plain p <= Zsqrt_plain q. Proof. - intros p q [H1 H2]; case Zle_lt_or_eq with (1:=H2); clear H2; intros H2; - [ | subst q; auto with zarith]. - case (Zle_or_lt (Zsqrt_plain p) (Zsqrt_plain q)); auto; intros H3. + intros p q [H1 H2]. + Z.le_elim H2; [ | subst q; auto with zarith]. + case (Z.le_gt_cases (Zsqrt_plain p) (Zsqrt_plain q)); auto; intros H3. assert (Hp: (0 <= Zsqrt_plain q)). - apply Zsqrt_plain_is_pos; auto with zarith. + { apply Zsqrt_plain_is_pos; auto with zarith. } absurd (q <= p); auto with zarith. - apply Zle_trans with ((Zsqrt_plain q + 1) * (Zsqrt_plain q + 1)). + apply Z.le_trans with ((Zsqrt_plain q + 1) * (Zsqrt_plain q + 1)). case (Zsqrt_interval q); auto with zarith. - apply Zle_trans with (Zsqrt_plain p * Zsqrt_plain p); auto with zarith. - apply Zmult_le_compat; auto with zarith. + apply Z.le_trans with (Zsqrt_plain p * Zsqrt_plain p); auto with zarith. + apply Z.mul_le_mono_nonneg; auto with zarith. case (Zsqrt_interval p); auto with zarith. Qed. diff --git a/theories/ZArith/Zwf.v b/theories/ZArith/Zwf.v index 30802f82..e07fc715 100644 --- a/theories/ZArith/Zwf.v +++ b/theories/ZArith/Zwf.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -9,7 +9,7 @@ Require Import ZArith_base. Require Export Wf_nat. Require Import Omega. -Open Local Scope Z_scope. +Local Open Scope Z_scope. (** Well-founded relations on Z. *) @@ -29,28 +29,28 @@ Section wf_proof. (** 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). + Let f (z:Z) := Z.abs_nat (z - c). Lemma Zwf_well_founded : well_founded (Zwf c). - red in |- *; intros. + red; 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. + apply Acc_intro; unfold Zwf; 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. + case (Z.le_gt_cases 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. + unfold f. + apply Zabs2Nat.inj_lt; omega. apply (H (S (f a))); auto. Qed. @@ -75,18 +75,15 @@ Section wf_proof_up. (** 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) := Z.abs_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 |- *. + unfold Zwf_up, f. 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. + apply Zabs2Nat.inj_lt; try (apply Z.le_0_sub; intuition). + now apply Z.sub_lt_mono_l. Qed. End wf_proof_up. diff --git a/theories/ZArith/auxiliary.v b/theories/ZArith/auxiliary.v index 742f4bde..af7d5a2e 100644 --- a/theories/ZArith/auxiliary.v +++ b/theories/ZArith/auxiliary.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) |